How to implement mutually recursive effects?

[abailly]

I would like to implement 2 effects, say A and B, which would be calling each other. This lead me to the following code which I don't find very satisfactory:

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}

module Symbiont.TransactionEngine.Circular where

import           Data.Text    (length)
import           Eff
import           Eff.Internal
import           Protolude    hiding (length)

data A a where
  F1 :: A Text

data B a where
  G1 :: B Text

data C a where
  C1 :: C ()

c1 :: (Member C r) => Eff r ()
c1 = send C1

f1 :: (Member A r) => Eff r Text
f1 = send F1

g1 :: (Member B r) => Eff r Text
g1 = send G1

printText :: (Member IO r) => Text -> Eff r ()
printText = send @IO . putStrLn

getText ::  (Member IO r) => Eff r Text
getText = send getLine

runAB :: (Member A r, Member B r, Member IO r) => Eff r a -> Eff r a
runAB = runB . runA

runA :: forall a r . (Member A r, Member B r, Member IO r)
     => Eff r a -> Eff r a
runA = interpose pure eval
  where
    eval :: forall b v . A b -> Arr r b v -> Eff r v
    eval F1 k = (do
      t <- getText
      printText $ "f1 " <> t
      g1) >>= k

runB :: forall a r . (Member A r, Member B r, Member IO r)
     => Eff r a -> Eff r a
runB = interpose pure eval
  where
    eval :: forall b v . B b -> Arr r b v -> Eff r v
    eval G1 k = (do
      t <- getText
      printText $ "g1 " <> t
      f1) >>= k

runB' :: forall a r . (Member IO r) =>
         Eff (B ': r) a -> Eff r a
runB' = handleRelay pure eval
  where
    eval :: forall b v . B b -> Arr r b v -> Eff r v
    eval G1     k  = printText "B'" >> k "foo"

runA' :: forall a r . (Member IO r) =>
         Eff (A ': r) a -> Eff r a
runA' = handleRelay pure eval
  where
    eval :: forall b v . A b -> Arr r b v -> Eff r v
    eval F1     k  = printText "A'" >> k "foo"

runCirc :: Eff '[B, A, IO] a -> IO a
runCirc = runM . runA' . runB' . runAB

main = forever $ runCirc f1

In particular, I don't like having to define runA' and runB' nor having to use forever. It seems to me I should be able to tie the knot of a recursive implementation with runA and runB but it keeps eluding me.

[isovector]

What's your actual use case for effects that call one another? I'm wondering if there might be some other, simpler way of decomposing the problem.

[abailly]

Thanks for your answer @isovector ! The actual use case is a bit hard to explain in details but the idea is that we have some effect in the middle of a stack that interacts with an external system (a distributed log) to process transactions. And the return value can contain more transactions to process from a previous point in the stack, hence the mutual dependency between two effects.

I can imagine something like returning a value denoting a "continuation", or even returning an Eff but I was really wondering if there would not be a possibility to "tie the knot" in a sequence of effects, something like a mfix maybe?

[jwiegley]

I ran into the need for something like mfix today too. Any further thoughts on this problem?