How do I use localSeqUnlift with reinterpret?

[ocharles]

I'm trying to use localSeqUnlift here:

runTransactionsWithConnection ::
  forall es a.
  IOE :> es =>
  Hasql.Connection ->
  Eff (DB : es) a ->
  Eff es a
runTransactionsWithConnection connection m = do
  rngState <- newCryptoRNGState
  reinterpret (runFailIO . runCryptoRNG rngState . runStatementsWithConn connection) interpreter m
  where
    interpreter 
      :: (IOE :> handlerEs, Statement :> localEs, RNG :> localEs, Fail :> localEs) 
      => LocalEnv localEs handlerEs -> DB (Eff localEs) b -> Eff handlerEs b
    interpreter env (RunTransaction transaction) = localSeqUnliftIO env \runInIO -> do
      -- This is essentially
      -- Database.PostgreSQL.Simple.Transaction.withTransactionModeRetry',
      -- but we use recovering with a fullJitterBackoff RetryPolicy, rather
      -- than retrying transactions as fast as possible. We do this as
      -- serialization errors occur when multiple transactions try read/write
      -- common tables. Having these transactions race as fast as possible
      -- doesn't reduce the likelihood of another serialization error, hence
      -- adding a bit of delay.
      inTransactionSpan $
          monitorSerialisationFailures $
            recovering retryPolicy [retryOnSerializationError] \_ ->
              bracket_ monitorStart monitorEnd do
                either throwIO return =<< flip Hasql.run connection do
                  Hasql.statement () $
                    Hasql.Statement
                      "BEGIN TRANSACTION ISOLATION LEVEL SERIALIZABLE"
                      Hasql.noParams
                      Hasql.noResult
                      False

                res <- do
                  runInIO (inject (unTransaction transaction))
                    `onException` Prometheus.incCounter transactionsExceptionsTotal
                    `onException` liftIO rollback_

                either throwIO return =<< do
                  flip Hasql.run connection do
                    Hasql.statement () $
                      Hasql.Statement
                        "COMMIT"
                        Hasql.noParams
                        Hasql.noResult
                        False

                return res

But this gives me the error:

[3 of 4] Compiling CircuitHub.Persistence.PostgreSQL [Source file changed]

lib/CircuitHub/Persistence/PostgreSQL.hs:160:86: error:
    • Could not deduce (Statement :> localEs)
        arising from a use of ‘interpreter’
      from the context: IOE :> es
        bound by the type signature for:
                   runTransactionsWithConnection :: forall (es :: [effectful-core-2.2.2.2:Effectful.Internal.Effect.Effect])
                                                           a.
                                                    (IOE :> es) =>
                                                    Hasql.Connection -> Eff (DB : es) a -> Eff es a
        at lib/CircuitHub/Persistence/PostgreSQL.hs:(152,1)-(157,10)
      or from: (GHC.Stack.Types.HasCallStack, DB :> localEs)
        bound by a type expected by the context:
                   EffectHandler DB (Statement : RNG : Fail : es)
        at lib/CircuitHub/Persistence/PostgreSQL.hs:160:86-96
    • In the second argument of ‘reinterpret’, namely ‘interpreter’
      In a stmt of a 'do' block:
        reinterpret
          (runFailIO
             . runCryptoRNG rngState . runStatementsWithConn connection)
          interpreter m
      In the expression:
        do rngState <- newCryptoRNGState
           reinterpret
             (runFailIO
                . runCryptoRNG rngState . runStatementsWithConn connection)
             interpreter m
    |
160 |   reinterpret (runFailIO . runCryptoRNG rngState . runStatementsWithConn connection) interpreter m
    |                                                                                      ^^^^^^^^^^^                      ^^^^^^

What am I doing wrong? I have a feeling I might need to use withLiftMap?

My effect definitions are:

data DB :: Effect where
  RunTransaction :: Transaction a -> DB m a

newtype Transaction a = Transaction {unTransaction :: Eff '[Statement, RNG, Fail] a}
  deriving newtype (Functor, Applicative, Monad, MonadStatement, MonadCatch, MonadThrow, MonadFail, CryptoRNG, MonadRandom)


data Statement :: Effect where
  RunStatement :: Hasql.Statement () a -> Statement m a

[ocharles]

I note that changing localSeqUnliftIO to withRunInIO allows this to work. Hrm.

[arybczak]

Hmm, that looks complicated. Do you have a standalone piece of code I can compile?

One thing I can see is that the type signature

interpreter 
      :: (IOE :> handlerEs, Statement :> localEs, RNG :> localEs, Fail :> localEs) 
      => LocalEnv localEs handlerEs -> DB (Eff localEs) b -> Eff handlerEs b

Looks a bit suspect. Context of localEs is supplied from outside and by default will only have DB :> localEs 🤔 (see the EffectHandler type), so I don't quite get how it can work after your fix/workaround.

[arybczak]

Ah ok, I see it now.

I got rid of the irrelevant bits and this compiles:

import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Fail

data Statement :: Effect
runStatement :: Eff (Statement : es) a -> Eff es a
runStatement = undefined

data RNG :: Effect
runRNG :: Eff (RNG : es) a -> Eff es a
runRNG = undefined

data DB :: Effect where
  RunTransaction :: Eff [Statement, RNG, Fail] a -> DB m a
type instance DispatchOf DB = Dynamic

runDB :: IOE :> es => Eff (DB : es) a -> Eff es a
runDB = reinterpret (runFailIO . runRNG . runStatement) interpreter
  where
    interpreter
      :: ( IOE :> handlerEs
         , Statement :> handlerEs
         , RNG :> handlerEs
         , Fail :> handlerEs
         )
      => LocalEnv localEs handlerEs
      -> DB (Eff localEs) r
      -> Eff handlerEs r
    interpreter env (RunTransaction transaction) = do
      localSeqLift env $ \lift -> do
        localSeqUnliftIO env $ \runInIO -> do
          -- ...
          runInIO $ do
            -- now you're in localEs
            lift $ do
              -- now you're back to handlerEs and can run the transaction
              inject transaction

It's a bit of a peculiar case because you want to execute the transaction in the context of the effect handler, not the local context, but there is no localSeqLiftIO/localLiftIO, so you have to go around.

Please confirm that this works for you, I'll add localSeqLiftIO/localLiftIO then so it's not necessary to go back from IO to handlerEs in a roundabout way in the future.

[ocharles]

Ah, thanks for getting this working! This is exactly what I needed - thank you! 😄

[arybczak]

You're welcome 🙂 I overcomplicated a little though. No additional functions are needed, withSeqEffToIO is enough:

runDB :: IOE :> es => Eff (DB : es) a -> Eff es a
runDB = reinterpret (runFailIO . runRNG . runStatement) interpreter
  where
    interpreter
      :: ( IOE :> handlerEs
         , Statement :> handlerEs
         , RNG :> handlerEs
         , Fail :> handlerEs
         )
      => LocalEnv localEs handlerEs
      -> DB (Eff localEs) r
      -> Eff handlerEs r
    interpreter _ (RunTransaction transaction) = do
      withSeqEffToIO $ \runInIO -> do
          -- ...
          runInIO $ do
            -- now you're back to handlerEs directly
            inject transaction

So your comment from #159 (comment) is a solution in the end, though it's better to explicitly use the sequential version.

[ocharles]

Oh great, withSeqEffToIO is what I actually ended up using - so it sounds like I did find the right tool in the end!