lexi-lambda/freer-simple
1
1
Fork 0
mirror of https://github.com/lexi-lambda/freer-simple.git synced 2024-09-11 08:05:51 +03:00
Code Issues Projects Releases Wiki Activity

Rename translateM to interpretM and use it in the Console example

Browse Source
This commit is contained in:
Alexis King 2017-07-06 14:10:03 -07:00
parent 0bbe540c78
commit 83a37ee3a8
2 changed files with 18 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
examples/src/Console.hs
View File

@ -29,7 +29,7 @@ import Data.Tuple (fst, snd)
import System.Exit (exitSuccess)
import System.IO (IO, getLine, putStrLn)
import Control.Monad.Freer (Eff, Member, interpret, reinterpret3, send, run, runM)
import Control.Monad.Freer (Eff, LastMember, Member, interpretM, reinterpret3, run, runM, send)
import Control.Monad.Freer.Exception (Exc, runError, throwError)
import Control.Monad.Freer.State (State, get, put, runState)
import Control.Monad.Freer.Writer (Writer, runWriter, tell)
@ -56,12 +56,10 @@ exitSuccess' = send ExitSuccess
-- Effectful Interpreter Simple --
-------------------------------------------------------------------------------
runConsole :: Eff '[Console, IO] a -> IO a
runConsole req = runM (interpret go req)
where
go :: Console a -> Eff '[IO] a
go (PutStrLn msg) = send (putStrLn msg)
go GetLine = send getLine
go ExitSuccess = send exitSuccess
runConsole = runM . interpretM (\case
PutStrLn msg -> putStrLn msg
GetLine -> getLine
ExitSuccess -> exitSuccess)
-------------------------------------------------------------------------------
-- Pure Interpreter Simple --
@ -80,14 +78,12 @@ runConsolePure inputs req = snd . fst $
-------------------------------------------------------------------------------
-- Effectful Interpreter for Deeper Stack --
-------------------------------------------------------------------------------
runConsoleM :: forall effs a. Member IO effs
runConsoleM :: forall effs a. LastMember IO effs
=> Eff (Console ': effs) a -> Eff effs a
runConsoleM = interpret go
where
go :: forall b. Console b -> Eff effs b
go (PutStrLn msg) = send (putStrLn msg)
go GetLine = send getLine
go ExitSuccess = send exitSuccess
runConsoleM = interpretM $ \case
PutStrLn msg -> putStrLn msg
GetLine -> getLine
ExitSuccess -> exitSuccess
-------------------------------------------------------------------------------
-- Pure Interpreter for Deeper Stack --

15
src/Control/Monad/Freer.hs
View File

@ -41,7 +41,7 @@ module Control.Monad.Freer
, reinterpret3
, reinterpretN
, translate
, translateM
, interpretM
) where
import Control.Applicative (pure)
@ -120,15 +120,16 @@ reinterpretN f = replaceRelayN @gs pure (\e -> (f e >>=))
translate :: (f ~> g) -> Eff (f ': effs) ~> Eff (g ': effs)
translate f = reinterpret (send . f)
-- | Like 'translate', this function runs an effect by translating it into
-- | Like 'interpret', this function runs an effect without introducting another
-- one. Like 'translate', this function runs an effect by translating it into
-- another effect in isolation, without access to the other effects in @effs@.
-- Unlike 'translate', this runs the effect in a final monad in @effs@, intended
-- to be run with 'runM'.
-- Unlike either of those functions, however, this runs the effect in a final
-- monad in @effs@, intended to be run with 'runM'.
--
-- @
-- 'translateM' f = 'interpret' ('sendM' . f)
-- 'interpretM' f = 'interpret' ('sendM' . f)
-- @
translateM
interpretM
:: (Monad m, LastMember m effs)
=> (eff ~> m) -> Eff (eff ': effs) ~> Eff effs
translateM f = interpret (sendM . f)
interpretM f = interpret (sendM . f)