Coroutines using effectful

Coroutine.hs

#!/usr/bin/env cabal
{- cabal:
build-depends: base, effectful-core
-}

-- Usage: cabal run Coroutine.hs

{-# LANGUAGE
  DataKinds,
  FlexibleContexts,
  LambdaCase,
  ScopedTypeVariables,
  TypeApplications,
  TypeFamilies, TypeOperators, GADTs #-}

import Data.Foldable (traverse_)
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.State.Static.Local

data Coroutine a b :: Effect where
  Call :: a -> Coroutine a b m b
type instance DispatchOf (Coroutine a b) = Dynamic

call :: forall a b es. Coroutine a b :> es => a -> Eff es b
call a = send (Call a)

yield :: forall a es. Coroutine a () :> es => a -> Eff es ()
yield = call

forEach :: forall a b es r. Eff (Coroutine a b ': es) r -> (a -> Eff es b) -> Eff es r
forEach caller call = handle caller
  where
    handle = interpret $ \_ -> \case
      Call a -> call a

inFoldable :: (Foldable t, Coroutine a () :> es) => t a -> Eff es ()
inFoldable = traverse_ yield  -- can't use unannotated `call`; type inference fail

yieldToList :: forall a es r. Eff (Coroutine a () ': es) r -> Eff es ([a], r)
yieldToList yielder = handle yielder
  where
    handle = reinterpret @(Coroutine a ()) collect $ \_ -> \case
      Call x -> modify (x :)
    collect = fmap (\(r, xs) -> (reverse xs, r)) . runState []

main :: IO ()
main = do
  -- (1) inFoldable uses the closest matching handler (forEach)
  print $
    runPureEff $
    yieldToList @Int $
    forEach @Int (inFoldable [0..9 :: Int]) $ \i ->
      yield @Int (fromIntegral i) >> yield @Int (fromIntegral (i + 10))
  -- (1b) equivalent to (1) with explicit masking to make the choice of handler unambiguous
  print $
    runPureEff $
    yieldToList @Int $
    forEach @Int (strictly (inFoldable [0..9 :: Int])) $ \i ->
      yield @Int (fromIntegral i) >> yield @Int (fromIntegral (i + 10))
  -- (2) just changing types makes inFoldable use the outer handler (yieldToList)
  print $
    runPureEff $
    yieldToList @Integer $
    forEach @Int (inFoldable [0..9 :: Integer]) $ \i ->
      yield @Integer (fromIntegral i) >> yield @Integer (fromIntegral (i + 10))
  -- (2b) equivalent to (2) with explicit masking instead of making effects distinct
  print $
    runPureEff $
    yieldToList @Int $
    forEach @Int (mask (inFoldable [0..9 :: Int])) $ \i ->
      yield @Int (fromIntegral i) >> yield @Int (fromIntegral (i + 10))

-- don't use the first effect
mask :: Eff es a -> Eff (e ': es) a
mask = inject

-- don't use later effects
strictly :: Eff '[e] a -> Eff (e ': es) a
strictly = inject