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:
Overview
Examples
VerboseAddition.hs
{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeOperators #-} module Control.Monad.Eff.Examples.VerboseAddition where import Control.Monad.Eff import Control.Monad.Eff.Lift import Prelude hiding (log) -- | The Log Effect data Log v where Log :: String -> Log () log :: Member Log r => String -> Eff r () log = send . Log -- | The Log Interpreter, Pure runLogger :: Eff (Log ': r) a -> Eff r (a, [String]) runLogger = handleRelay (\x -> return (x, [])) (\(Log s) k -> k () >>= \(x, ss) -> return (x, s:ss)) -- | The Log Interpreter, Impure runIOLogger :: MemberU2 Lift (Lift IO) r => Eff (Log ': r) a -> Eff r a runIOLogger = handleRelay return (\(Log s) k -> lift (putStrLn s) >>= k) -- | The program we want to be able to write verboseAddition :: Member Log r => Eff r Int verboseAddition = do log "I'm starting with 1..." x <- return 1 log "and I'm adding 2..." y <- return 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.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.