a7bc404 · effectful · git.iko.soy

effectful-core/src/Effectful/Handler.hs+20−20

compare with master

unifiedsplit

@@ -3,6 +3,7 @@ module Effectful.Handler

3 send

4

5 -- * Handling effects

6+ , EffectHandler

6 , interpret

7 , interpret

7 , reinterpret

8 , reinterpret

8

9

@@ -43,13 +44,18 @@ import Effectful.Internal.Monad

43-- handler.

44-- handler.

44newtype LocalEnv es = LocalEnv (Env es)

45newtype LocalEnv es = LocalEnv (Env es)

45

46

46−data Handler (e :: Effect) = forall handlerEs. Handler

47+-- | Type signature of the effect handler.

47− { _env :: Env handlerEs

48+type EffectHandler e es

48− , _handle :: forall a localEs. HasCallStack

49+ = forall a localEs. HasCallStack

49− => LocalEnv localEs

50+ => LocalEnv localEs

51+ -- ^ The environment for handling local 'Eff' operations with functions from

52+ -- the 'localUnlift' family when given a higher order effect.

50− -> e (Eff localEs) a

53+ -> e (Eff localEs) a

54+ -- ^ The effect in the local environment.

51− -> Eff handlerEs a

55+ -> Eff es a

52− }

56+

57+data Handler :: Effect -> Type where

58+ Handler :: Env es -> EffectHandler e es -> Handler e

53

59

54runHandler :: Env es -> Handler e -> Eff (e : es) a -> IO a

60runHandler :: Env es -> Handler e -> Eff (e : es) a -> IO a

55runHandler es0 e m = do

61runHandler es0 e m = do

@@ -59,9 +65,9 @@ runHandler es0 e m = do

59 (\es -> unEff m es)

65 (\es -> unEff m es)

60 where

66 where

61 relinker :: Relinker Handler e

67 relinker :: Relinker Handler e

62− relinker = Relinker $ \relink Handler{..} -> do

68+ relinker = Relinker $ \relink (Handler env handle) -> do

63− env <- relink _env

69+ newEnv <- relink env

64− pure Handler { _env = env, .. }

70+ pure $ Handler newEnv handle

65

71

66----------------------------------------

72----------------------------------------

67-- Sending operations

73-- Sending operations

@@ -69,18 +75,15 @@ runHandler es0 e m = do

69-- | Send an operation of a given effect to its handler for execution.

75-- | Send an operation of a given effect to its handler for execution.

70send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a

76send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a

71send op = unsafeEff $ \es -> do

77send op = unsafeEff $ \es -> do

72− Handler{..} <- getEnv es

78+ Handler env handle <- getEnv es

73− unEff (_handle (LocalEnv es) op) _env

79+ unEff (handle (LocalEnv es) op) env

74

80

75----------------------------------------

81----------------------------------------

76-- Interpretation

82-- Interpretation

77

83

78-- | Interpret an effect.

84-- | Interpret an effect.

79−--

80−-- /Note:/ 'LocalEnv' is for handling local 'Eff' operations using a function

81−-- from the 'localUnlift' family.

82interpret

85interpret

83− :: (forall r localEs. HasCallStack => LocalEnv localEs -> e (Eff localEs) r -> Eff es r)

86+ :: EffectHandler e es

84 -- ^ The effect handler.

87 -- ^ The effect handler.

85 -> Eff (e : es) a

88 -> Eff (e : es) a

86 -> Eff es a

89 -> Eff es a

@@ -92,13 +95,10 @@ interpret handler m = unsafeEff $ \es -> do

92-- Reinterpretation

95-- Reinterpretation

93

96

94-- | Interpret an effect using other effects.

97-- | Interpret an effect using other effects.

95−--

96−-- /Note:/ 'LocalEnv' is for handling local 'Eff' operations using a function

97−-- from the 'localUnlift' family.

98reinterpret

99 :: (Eff handlerEs a -> Eff es b)

100 -- ^ Introduction of effects encapsulated within the handler.

101− -> (forall r localEs. HasCallStack => LocalEnv localEs -> e (Eff localEs) r -> Eff handlerEs r)

101+ -> EffectHandler e handlerEs

102 -- ^ The effect handler.

103 -> Eff (e : es) a

104 -> Eff es b

effectful-core/src/Effectful/Internal/Effect.hs+3

@@ -9,6 +9,9 @@ module Effectful.Internal.Effect

9 ( Effect

10 , (:>)(..)

11 , IdE(..)

12+

13+ -- * Re-exports

14+ , Type

12 ) where

15 ) where

13

16

14import Data.Kind

17import Data.Kind

effectful-core/src/Effectful/Internal/Env.hs−1

@@ -30,7 +30,6 @@ module Effectful.Internal.Env

30import Control.Monad

31import Control.Monad.Primitive

32import Data.IORef

33−import Data.Kind

34import Data.Primitive.SmallArray

33import Data.Primitive.SmallArray

35import GHC.Exts (Any)

34import GHC.Exts (Any)

36import GHC.Stack (HasCallStack)

35import GHC.Stack (HasCallStack)

effectful-core/src/Effectful/State/Dynamic.hs+2−10

@@ -57,11 +57,7 @@ evalLocalState s0 = reinterpret (L.evalState s0) localState

57execLocalState :: s -> Eff (State s : es) a -> Eff es s

58execLocalState s0 = reinterpret (L.execState s0) localState

59

60−localState

60+localState :: L.State s :> es => EffectHandler (State s) es

61− :: L.State s :> es

62− => LocalEnv localEs

63− -> State s (Eff localEs) a

64− -> Eff es a

65localState env = \case

61localState env = \case

66 Get -> L.get

62 Get -> L.get

67 Put s -> L.put s

63 Put s -> L.put s

@@ -80,11 +76,7 @@ evalSharedState s0 = reinterpret (S.evalState s0) sharedState

80execSharedState :: s -> Eff (State s : es) a -> Eff es s

76execSharedState :: s -> Eff (State s : es) a -> Eff es s

81execSharedState s0 = reinterpret (S.execState s0) sharedState

77execSharedState s0 = reinterpret (S.execState s0) sharedState

82

78

83−sharedState

79+sharedState :: S.State s :> es => EffectHandler (State s) es

84− :: S.State s :> es

85− => LocalEnv localEs

86− -> State s (Eff localEs) a

87− -> Eff es a

88sharedState env = \case

80sharedState env = \case

89 Get -> S.get

81 Get -> S.get

90 Put s -> S.put s

82 Put s -> S.put s

effectful-core/src/Effectful/Writer/Dynamic.hs+2−10

@@ -33,11 +33,7 @@ runLocalWriter = reinterpret L.runWriter localWriter

33execLocalWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w

34execLocalWriter = reinterpret L.execWriter localWriter

35

36−localWriter

37− :: (L.Writer w :> es, Monoid w)

36+localWriter :: (L.Writer w :> es, Monoid w) => EffectHandler (Writer w) es

38− => LocalEnv localEs

39− -> Writer w (Eff localEs) a

40− -> Eff es a

41localWriter env = \case

37localWriter env = \case

42 Tell w -> L.tell w

38 Tell w -> L.tell w

43 Listen m -> localSeqUnlift env $ \unlift -> L.listen (unlift m)

39 Listen m -> localSeqUnlift env $ \unlift -> L.listen (unlift m)

@@ -51,11 +47,7 @@ runSharedWriter = reinterpret S.runWriter sharedWriter

51execSharedWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w

47execSharedWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w

52execSharedWriter = reinterpret S.execWriter sharedWriter

48execSharedWriter = reinterpret S.execWriter sharedWriter

53

49

54−sharedWriter

55− :: (S.Writer w :> es, Monoid w)

50+sharedWriter :: (S.Writer w :> es, Monoid w) => EffectHandler (Writer w) es

56− => LocalEnv localEs

57− -> Writer w (Eff localEs) a

58− -> Eff es a

59sharedWriter env = \case

51sharedWriter env = \case

60 Tell w -> S.tell w

52 Tell w -> S.tell w

61 Listen m -> localSeqUnlift env $ \unlift -> S.listen (unlift m)

53 Listen m -> localSeqUnlift env $ \unlift -> S.listen (unlift m)

effectful/src/Effectful/Async.hs−1

@@ -76,7 +76,6 @@ import Control.Concurrent (threadDelay)

76import Control.Concurrent.Async (Async)

77import Control.Exception (Exception, SomeException)

78import Control.Monad (forever)

79−import Data.Kind

80import qualified Control.Concurrent.Async as A

79import qualified Control.Concurrent.Async as A

81import qualified UnliftIO.Async as U

80import qualified UnliftIO.Async as U

82import qualified UnliftIO.Internals.Async as I

81import qualified UnliftIO.Internals.Async as I