Created
August 4, 2023 10:47
-
-
Save kephas/f401c1b475418ee8a944827d2fca958a to your computer and use it in GitHub Desktop.
Effectful code with different orders of effects in effectful code
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#! /usr/bin/env nix-shell | |
#! nix-shell -i runghc -p "haskellPackages.ghcWithPackages (p: [p.effectful p.effectful-th])" | |
{-# LANGUAGE BlockArguments #-} | |
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE GHC2021 #-} | |
{-# LANGUAGE LambdaCase #-} | |
{-# LANGUAGE TemplateHaskell #-} | |
{-# LANGUAGE TypeFamilies #-} | |
import Data.Function | |
import Effectful | |
import Effectful.Dispatch.Dynamic (interpret) | |
import Effectful.Reader.Static | |
import Effectful.TH | |
data EnvState = EnvState | |
{field1 :: Int} | |
data Foo a :: Effect where | |
DoFoo :: Show a => a -> Foo a m () | |
data Bar a :: Effect where | |
DoBar :: (Num a, Show a) => a -> Bar a m a | |
makeEffect ''Foo | |
makeEffect ''Bar | |
-- Interpreters | |
runFooIO :: IOE :> es => Eff (Foo a ': es) b -> Eff es b | |
runFooIO = interpret $ const \case | |
DoFoo a -> liftIO $ print a | |
runBarIO :: IOE :> es => Eff (Bar a ': es) b -> Eff es b | |
runBarIO = interpret $ const \case | |
DoBar a -> do | |
let a' = a + 1 | |
liftIO $ print a' | |
pure a' | |
-- Effectful code | |
fun1 :: (Reader EnvState :> es, Bar Int :> es, Foo Bool :> es) => Eff es Int | |
fun1 = do | |
EnvState{field1} <- ask | |
doFoo False | |
doBar field1 | |
fun2 :: (Foo Bool :> es, Bar Int :> es, Reader EnvState :> es) => Eff es Int | |
fun2 = do | |
EnvState{field1} <- ask | |
doFoo True | |
doBar $ field1 * 2 | |
-- Interpreter stack | |
runAll :: Eff '[Foo Bool, Bar Int, Reader EnvState, IOE] a -> IO a | |
runAll m = runEff $ runReader (EnvState 1) $ runBarIO $ runFooIO m | |
main :: IO () | |
main = do | |
x <- runAll fun1 | |
y <- runAll fun2 | |
print $ x + y |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment