Pure handler for statically dispatched effects using effectful?

Hey folks,

I’ve been getting into effectful recently and I’m struggling a little to understand when to use statically vs dynamically dispatched effects.

I’m making a statically dispatched logging effect using co-log and it generally works. The actual handlers seem fine and I wrote a test handler that writes to an IORef. So far so good.

I’m haunted by the fact that I don’t understand what the exact limits are. The docs say

Unlike dynamically dispatched effects, statically dispatched effects have a single, set interpretation that cannot be changed at runtime

As far as can see, the usual implementation is “pull the function out of the StaticRep and call it”. If I’m not mistaken, we can use localStaticRep to replace the representation, which in my case holds the actual log function, so I was hopeful that it might be pretty flexible regardless.
This is where I’ve hit the wall though. The representation of my effect is a LogAction IO Text, and this obviously won’t work in a pure context where I’d prefer something like (Writer (Seq Text) :> es) => LogAction (Eff es) Text, which would then be LogAction (tell . singleton). But that doesn’t fit the types. I’ve tried generalizing at different points, but that didn’t really go anywhere.

Is using varying effects the limit of what’s possible with static dispatch? I could of course just make it dynamic, but I’d like to understand it a bit better.
(Also, maybe there is a chance here to improve the docs a bit? I’m surely not the only one who doesn’t grok this right away.)


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
module Fairtalk.Log where

import Effectful (Effect, Eff, DispatchOf, Dispatch(Static), (:>), IOE)
import Effectful.Dispatch.Static (SideEffects(..), evalStaticRep, StaticRep, getStaticRep, unsafeEff_)
import Colog (LogAction (LogAction))
import Data.Sequence ((|>))

type LogE :: Effect
data LogE :: Effect

type instance DispatchOf LogE = 'Static 'WithSideEffects
newtype instance StaticRep LogE = LogE (LogAction IO Text)

log :: (LogE :> es) => Text -> Eff es ()
log msg = do
    LogE (LogAction logger) <- getStaticRep
    unsafeEff_ $ logger msg

runLog :: (IOE :> es) => Eff (LogE  : es) a -> Eff es a
runLog = runLog' (LogAction (liftIO . putTextLn))

runLog' :: (IOE :> es) => LogAction IO Text  -> Eff (LogE  : es) a -> Eff es a
runLog' logger = evalStaticRep (LogE logger)

runLogPureish :: forall a es. (IOE :> es) => Eff (LogE : es) a -> Eff es (a, Seq Text)
runLogPureish action = do
    log <- liftIO $ newIORef empty
    let logger= LogAction (\msg -> atomicModifyIORef' log (\s -> (s |> msg, ())))
    result <- runLog' logger action
    (result, ) <$> readIORef log

{-
 Code below is super broken.

 The DispatchOf LogE = Static WithSideEffects requires IOE here, which I don't want
 But even if we disable that, we can't do build a StaticRep for a pure logger, since IO is
 hardcoded into the type. If I abstract LogE over that, I need to make log super generic, and then
 effectful builds a type like this:
    (LogE' (Eff (LogE' (Eff es) : es)) :> es, IOE :> es) => Eff es ()
 And that doesn't seem to go anywhere.
 I've also toyed with existentials but gave that up pretty quickly.

 Is this the limit of static dispatch? Can we use different handlers but can't vary in the effects
 that they use?

> runLogPure :: forall a es. Eff (LogE : es) a -> Eff es (a, Seq Text)
> runLogPure action = do
>     let tellLog = tell . Seq.singleton
>     runWriter
>         $ evalStaticRep $ LogE (undefined :: LogAction IO Text)
>         $ action
-}

And the relevant library versions:

    relude-1.1.0.0
    effectful-2.2.2.0
    effectful-core-2.2.2.2
    co-log-0.5.0.0
    co-log-core-0.3.2.0

Edit: relevant How to use other effects in `Static` effects? · Issue #57 · haskell-effectful/effectful · GitHub

FYI, this is very similar to what you’re asking: Is there a way to write an interpreter for log-effectful? · haskell-effectful/effectful · Discussion #155 · GitHub.

1 Like

Thank you for the link, that was very useful.
From what I gather, it wasn’t pursued because people don’t see the point. Which is fair I guess.

Btw, I just remembered that someone already wrote bindings for co-log: Bindings for co-log by ambroslins · Pull Request #22 · haskell-effectful/effectful-contrib · GitHub - the PR seems to be dead, but if you plan to release the package, maybe it has some useful stuff you didn’t yet write.

Perhaps :slight_smile: Static dispatch makes sense for log-effectful, not sure about co-log since I’m not familiar with the library. Maybe dynamic dispatch would suit these bindings better, might be worth experimenting.

As fast as I understand, as long as we fix the monad that the log action runs in, we’ll be fine. And i agree with the sentiment that there’s probably rarely the need to run it without IO underneath.

I hadn’t really considered publishing a library tbh, mostly because it seems like a pretty simple effect. But the fact that I spend so much time on this is probably a sign that a package would be useful.

1 Like