c25e672 · effectful · git.iko.soy

git.iko.soy/effectful

Merge (re)interpret and (re)interpretM

Fixes #26.

commitc25e672d6f02d47415951e9ddb90b6b5350b5125 authorAndrzej Rybczak <andrzej@rybczak.net> dateSun 25 Jul 2021, 12:17 (5 years ago) parentf4a8def

10 files changed+27−59

compare with master

unifiedsplit

bench/Concurrency.hs+4−4 bench/FileSizes.hs+2−2 src/Effectful.hs−4 src/Effectful/Error/Dynamic.hs+1−1 src/Effectful/Handler.hs+6−35 src/Effectful/Reader/Dynamic.hs+1−1 src/Effectful/State/Dynamic.hs+6−6 src/Effectful/Writer/Dynamic.hs+4−4 tests/ErrorTests.hs+2−1 tests/StateTests.hs+1−1

bench/Concurrency.hs+4−4

@@ -60,28 +60,28 @@ data Fork :: Effect where

6060

6161-- | Uses 'localUnliftIO' and 'withLiftMapIO'.

6262runFork1 :: IOE :> es => Eff (Fork : es) a -> Eff es a

63−runFork1 = interpretM $ \env -> \case

63+runFork1 = interpret $ \env -> \case

6464 ForkWithUnmask m -> withLiftMapIO $ \liftMap -> do

6565 localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do

6666 asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask

6767

6868-- | Uses 'localUnlift' and 'withLiftMap'.

6969runFork2 :: IOE :> es => Eff (Fork : es) a -> Eff es a

70−runFork2 = reinterpretM A.runAsyncE $ \env -> \case

70+runFork2 = reinterpret A.runAsyncE $ \env -> \case

7171 ForkWithUnmask m -> withLiftMap $ \liftMap -> do

7272 localUnlift env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do

7373 A.asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask

7474

7575-- | Uses 'localLiftUnliftIO'.

7676runFork3 :: IOE :> es => Eff (Fork : es) a -> Eff es a

77−runFork3 = interpretM $ \env -> \case

77+runFork3 = interpret $ \env -> \case

7878 ForkWithUnmask m -> do

7979 localLiftUnliftIO env (ConcUnlift Persistent $ Limited 1) $ \lift unlift -> do

8080 asyncWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift

8181

8282-- | Uses 'localLiftUnlift'.

8383runFork4 :: IOE :> es => Eff (Fork : es) a -> Eff es a

84−runFork4 = reinterpretM A.runAsyncE $ \env -> \case

84+runFork4 = reinterpret A.runAsyncE $ \env -> \case

8585 ForkWithUnmask m -> do

8686 localLiftUnlift env (ConcUnlift Persistent $ Limited 1) $ \lift unlift -> do

8787 A.asyncWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift

bench/FileSizes.hs+2−2

@@ -81,7 +81,7 @@ effectful_tryFileSize :: Effectful_File E.:> es => FilePath -> E.Eff es (Maybe I

8181effectful_tryFileSize = E.send . Effectful_tryFileSize

8282

8383effectful_runFile :: E.IOE E.:> es => E.Eff (Effectful_File : es) a -> E.Eff es a

84−effectful_runFile = E.interpret \case

84+effectful_runFile = E.interpret \_ -> \case

8585 Effectful_tryFileSize path -> liftIO $ tryGetFileSize path

8686

8787data Effectful_Logging :: E.Effect where

@@ -93,7 +93,7 @@ effectful_logMsg = E.send . Effectful_logMsg

9393effectful_runLogging

9494 :: E.Eff (Effectful_Logging : es) a

9595 -> E.Eff es (a, [String])

96−effectful_runLogging = E.reinterpret (E.runState []) \case

96+effectful_runLogging = E.reinterpret (E.runState []) \_ -> \case

9797 Effectful_logMsg msg -> E.modify (msg :)

9898

9999----------

src/Effectful.hs−4

@@ -30,11 +30,7 @@ module Effectful

3030

3131 -- ** Basic handlers

3232 , interpret

33− , interpretM

34−

35− -- ** Derived handlers

3633 , reinterpret

37− , reinterpretM

3834

3935 -- ** Handling local 'Eff' operations

4036 , LocalEnv

src/Effectful/Error/Dynamic.hs+1−1

@@ -20,7 +20,7 @@ runError

2020 :: Typeable e

2121 => Eff (Error e : es) a

2222 -> Eff es (Either (E.CallStack, e) a)

23−runError = reinterpretM E.runError $ \env -> \case

23+runError = reinterpret E.runError $ \env -> \case

2424 ThrowError e -> E.throwError e

2525 CatchError m h -> localSeqUnlift env $ \unlift -> do

2626 E.catchError (unlift m) (\cs -> unlift . h cs)

src/Effectful/Handler.hs+6−35

@@ -3,14 +3,8 @@ module Effectful.Handler

33 send

55 -- * Handling effects

6−

7− -- ** Basic handlers

86 , interpret

9− , interpretM

10−

11− -- ** Derived handlers

127 , reinterpret

13− , reinterpretM

148

159 -- ** Handling local 'Eff' operations

1610 , LocalEnv

@@ -81,57 +75,34 @@ send op = unsafeEff $ \es -> do

8175----------------------------------------

8276-- Interpretation

8377

84−-- | Interpret a first order effect.

85−interpret

86− :: (forall r m. HasCallStack => e m r -> Eff es r)

87− -- ^ The effect handler.

88− -> Eff (e : es) a

89− -> Eff es a

90−interpret handler m = unsafeEff $ \es -> do

91− les <- forkEnv es

92− runHandler es (Handler les $ \_ -> handler) m

93−

94−-- | Interpret a higher order effect.

78+-- | Interpret an effect.

9579--

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

9781-- from the 'localUnlift' family.

98−interpretM

82+interpret

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

10084 -- ^ The effect handler.

10185 -> Eff (e : es) a

10286 -> Eff es a

103−interpretM handler m = unsafeEff $ \es -> do

87+interpret handler m = unsafeEff $ \es -> do

10488 les <- forkEnv es

10589 runHandler es (Handler les handler) m

10690

10791----------------------------------------

10892-- Reinterpretation

10993

110−-- | Interpret a first order effect using other effects.

111−reinterpret

112− :: (Eff handlerEs a -> Eff es b)

113− -- ^ Introduction of effects encapsulated within the handler.

114− -> (forall r m. HasCallStack => e m r -> Eff handlerEs r)

115− -- ^ The effect handler.

116− -> Eff (e : es) a

117− -> Eff es b

118−reinterpret runHandlerEs handler m = unsafeEff $ \es -> do

119− les0 <- forkEnv es

120− (`unEff` les0) . runHandlerEs . unsafeEff $ \les -> do

121− runHandler es (Handler les $ \_ -> handler) m

122−

123−-- | Interpret a higher order effect using other effects.

94+-- | Interpret an effect using other effects.

12495--

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

12697-- from the 'localUnlift' family.

127−reinterpretM

98+reinterpret

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

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

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

131102 -- ^ The effect handler.

132103 -> Eff (e : es) a

133104 -> Eff es b

134−reinterpretM runHandlerEs handler m = unsafeEff $ \es -> do

105+reinterpret runHandlerEs handler m = unsafeEff $ \es -> do

135106 les0 <- forkEnv es

136107 (`unEff` les0) . runHandlerEs . unsafeEff $ \les -> do

137108 runHandler es (Handler les handler) m

src/Effectful/Reader/Dynamic.hs+1−1

@@ -15,7 +15,7 @@ data Reader r :: Effect where

1515 Local :: (r -> r) -> m a -> Reader r m a

1616

1717runReader :: r -> Eff (Reader r : es) a -> Eff es a

18−runReader r = reinterpretM (R.runReader r) $ \env -> \case

18+runReader r = reinterpret (R.runReader r) $ \env -> \case

1919 Ask -> R.ask

2020 Local f m -> localSeqUnlift env $ \unlift -> R.local f (unlift m)

2121

src/Effectful/State/Dynamic.hs+6−6

@@ -49,13 +49,13 @@ data State s :: Effect where

4949-- Local

5050

5151runLocalState :: s -> Eff (State s : es) a -> Eff es (a, s)

52−runLocalState s0 = reinterpretM (L.runState s0) localState

52+runLocalState s0 = reinterpret (L.runState s0) localState

5353

5454evalLocalState :: s -> Eff (State s : es) a -> Eff es a

55−evalLocalState s0 = reinterpretM (L.evalState s0) localState

55+evalLocalState s0 = reinterpret (L.evalState s0) localState

5656

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

58−execLocalState s0 = reinterpretM (L.execState s0) localState

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

5959

6060localState

6161 :: L.State s :> es

@@ -72,13 +72,13 @@ localState env = \case

7272-- Shared

7373

7474runSharedState :: s -> Eff (State s : es) a -> Eff es (a, s)

75−runSharedState s0 = reinterpretM (S.runState s0) sharedState

75+runSharedState s0 = reinterpret (S.runState s0) sharedState

7676

7777evalSharedState :: s -> Eff (State s : es) a -> Eff es a

78−evalSharedState s0 = reinterpretM (S.evalState s0) sharedState

78+evalSharedState s0 = reinterpret (S.evalState s0) sharedState

7979

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

81−execSharedState s0 = reinterpretM (S.execState s0) sharedState

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

8282

8383sharedState

8484 :: S.State s :> es

src/Effectful/Writer/Dynamic.hs+4−4

@@ -28,10 +28,10 @@ data Writer w :: Effect where

2828-- Local

2929

3030runLocalWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)

31−runLocalWriter = reinterpretM L.runWriter localWriter

31+runLocalWriter = reinterpret L.runWriter localWriter

3232

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

34−execLocalWriter = reinterpretM L.execWriter localWriter

34+execLocalWriter = reinterpret L.execWriter localWriter

3535

3636localWriter

3737 :: (L.Writer w :> es, Monoid w)

@@ -46,10 +46,10 @@ localWriter env = \case

4646-- Shared

4747

4848runSharedWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)

49−runSharedWriter = reinterpretM S.runWriter sharedWriter

49+runSharedWriter = reinterpret S.runWriter sharedWriter

5050

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

52−execSharedWriter = reinterpretM S.execWriter sharedWriter

52+execSharedWriter = reinterpret S.execWriter sharedWriter

5353

5454sharedWriter

5555 :: (S.Writer w :> es, Monoid w)

tests/ErrorTests.hs+2−1

@@ -31,4 +31,5 @@ nestedErr :: (HasCallStack, NestedErr :> es) => Eff es ()

3131nestedErr = send NestedErr

3232

3333runNestedErr :: Error String :> es => Eff (NestedErr : es) a -> Eff es a

34−runNestedErr = interpret $ \NestedErr -> throwError "nested error"

34+runNestedErr = interpret $ \_ -> \case

35+ NestedErr -> throwError "nested error"

tests/StateTests.hs+1−1

@@ -113,7 +113,7 @@ putInt = send . PutInt

113113runHasInt :: Int -> Eff (HasInt : es) a -> Eff es a

114114runHasInt n =

115115 -- reinterpret with redundant local effects

116− reinterpret (evalState () . evalState n . evalState True) $ \case

116+ reinterpret (evalState () . evalState n . evalState True) $ \_ -> \case

117117 GetInt -> get

118118 PutInt i -> put i

119119