More Extensible Effects

This package is an implementation of "Freer Monads, More Extensible Effects".

Much of the implementation is a repackaging and cleaning up of the reference materials provided here:

• Eff1.hs
• OpenUnion5.hs
• FTCQueue1.hs

Overview

• Control
  • Monad
    • Eff
      • Examples
        • Teletype
        • VerboseAddition
      • Exception
      • Internal
      • Lift
      • NdetEff
      • Reader
      • State
      • StateRW
      • Writer
• Data
  • FTCQueue
  • OpenUnion

Examples

Log Effect (24 Days of Hackage: extensible-effects)

VerboseAddition.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module Control.Monad.Eff.Examples.VerboseAddition where

import Control.Monad.Eff
import Control.Monad.Eff.Lift
import Prelude hiding (log)

data Log v where
  Log :: String -> Log ()

log :: Member Log r => String -> Eff r ()
log = send . Log

runLogger :: Eff (Log ': r) a -> Eff r (a, [String])
runLogger = handleRelay ret handle
  where
    ret :: a -> Eff r (a, [String])
    ret x = return (x, [])
    handle :: Handler Log r (a, [String])
    handle (Log s) k = do
      (x, ss) <- k ()
      return (x, s:ss)

runIOLogger :: forall r a. MemberU2 Lift (Lift IO) r => Eff (Log ': r) a -> Eff r a
runIOLogger = handleRelay ret handle
  where
    ret :: a -> Eff r a
    ret = return
    handle :: Handler Log r a
    handle (Log s) k = lift (putStrLn s) >>= k

example :: Member Log r => Eff r Int
example = do
  log "I'm starting with 1..."
  let x = 1

  log "and I'm adding 2..."
  let y = 2

  let r = x + y
  log $ "Looks like the result is " ++ show r
  return r

Now we can run the program in pure or impure way:

λ> run (runLogger verboseAddition)
(3,["I'm starting with 1...","and I'm adding 2...","Looks like the result is 3"])
λ> runLift (runIOLogger verboseAddition)
I'm starting with 1...
and I'm adding 2...
Looks like the result is 3
3

Teletype (Purify code using free monads)

Teletype.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module Control.Monad.Eff.Examples.Teletype where

import Control.Monad.Eff
import Control.Monad.Eff.Lift
import System.Exit (exitSuccess)

data Teletype x where
  GetLine     :: Teletype String
  PutStrLn    :: String -> Teletype ()
  ExitSuccess :: Teletype ()

putStrLn' :: Member Teletype r => String -> Eff r ()
putStrLn' = send . PutStrLn

getLine' :: Member Teletype r => Eff r String
getLine' = send GetLine

exitSuccess' :: Member Teletype r => Eff r ()
exitSuccess' = send ExitSuccess

runTeletype :: [String] -> Eff (Teletype ': r) a -> Eff r [String]
runTeletype ss = handleRelayS ss ret handle
  where
    ret :: [String] -> a -> Eff r [String]
    ret _ a = return []

    handle :: HandlerS [String] Teletype r [String]
    handle (s:stdin) GetLine      k = k stdin s
    handle _         GetLine      k = error "Insufficient input"
    handle stdin     (PutStrLn s) k = do
      stdout <- k stdin ()
      return (s:stdout)
    handle _         ExitSuccess  k = return []

runIOTeletype :: forall r a. MemberU2 Lift (Lift IO) r => Eff (Teletype ': r) a -> Eff r a
runIOTeletype = handleRelay ret handle
  where
    ret :: a -> Eff r a
    ret = return

    handle :: Handler Teletype r a
    handle GetLine      k = lift getLine      >>= k
    handle (PutStrLn s) k = lift (putStrLn s) >>= k
    handle ExitSuccess  k = lift exitSuccess  >>= k

example :: Member Teletype r => Eff r ()
example = do
  str <- getLine'
  putStrLn' ("put: " ++ str)
  str <- getLine'
  putStrLn' ("put: " ++ str)
  exitSuccess'
  putStrLn' "should not appear"

Run it purely:

λ> run $ runTeletype ["hello", "world", "and more"] example
["put: hello","put: world"]

λ> run $ runTeletype ["hello"] example
*** Exception: Insufficient input
CallStack (from HasCallStack):
  error, called at /work/src/Control/Monad/Eff/Examples/Teletype.hs:35:39 in main:Control.Monad.Eff.Examples.Teletype

Run it in IO:

λ> runLift $ runIOTeletype example
hello
put: hello
world
put: world
*** Exception: ExitSuccess

Usage Tips

Effect Intepreter

The most complex part of new effect definition is the 'runX' function. As you can see in the above examples, it's usually defined by handleRelay ret handle with your customized ret to return value and handle to handle continuation.

It's similar to what you do to implement an instance of Monad (ret for return, handle for >>=). You can read handleRelay ret handle as run this monad with instance defined by ret and handle.