c25e672 · effectful · git.iko.soy

bench/Concurrency.hs+4−4

compare with master

unifiedsplit

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

60

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

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

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

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

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

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

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

67

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

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

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

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

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

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

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

74

75-- | Uses 'localLiftUnliftIO'.

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

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

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

78 ForkWithUnmask m -> do

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

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

81

82-- | Uses 'localLiftUnlift'.

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

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

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

85 ForkWithUnmask m -> do

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

87 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

81effectful_tryFileSize = E.send . Effectful_tryFileSize

82

83effectful_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

85 Effectful_tryFileSize path -> liftIO $ tryGetFileSize path

86

87data Effectful_Logging :: E.Effect where

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

93effectful_runLogging

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

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

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

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

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

98

99----------

src/Effectful.hs−4

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

30

31 -- ** Basic handlers

32 , interpret

33− , interpretM

34−

35− -- ** Derived handlers

36 , reinterpret

33 , reinterpret

37− , reinterpretM

38

34

39 -- ** Handling local 'Eff' operations

35 -- ** Handling local 'Eff' operations

40 , LocalEnv

36 , LocalEnv

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

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

20 :: Typeable e

21 => Eff (Error e : es) a

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

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

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

24 ThrowError e -> E.throwError e

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

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

src/Effectful/Handler.hs+6−35

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

3 send

4

5 -- * Handling effects

6−

7− -- ** Basic handlers

8 , interpret

6 , interpret

9− , interpretM

10−

11− -- ** Derived handlers

12 , reinterpret

7 , reinterpret

13− , reinterpretM

14

8

15 -- ** Handling local 'Eff' operations

9 -- ** Handling local 'Eff' operations

16 , LocalEnv

10 , LocalEnv

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

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

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

82-- Interpretation

76-- Interpretation

83

77

84−-- | Interpret a first order effect.

78+-- | Interpret an 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.

95--

79--

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

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

97-- from the 'localUnlift' family.

81-- from the 'localUnlift' family.

98−interpretM

82+interpret

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

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

100 -- ^ The effect handler.

84 -- ^ The effect handler.

101 -> Eff (e : es) a

85 -> Eff (e : es) a

102 -> Eff es a

86 -> Eff es a

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

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

104 les <- forkEnv es

88 les <- forkEnv es

105 runHandler es (Handler les handler) m

89 runHandler es (Handler les handler) m

106

90

107----------------------------------------

91----------------------------------------

108-- Reinterpretation

92-- Reinterpretation

109

93

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.

124--

95--

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

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

126-- from the 'localUnlift' family.

97-- from the 'localUnlift' family.

127−reinterpretM

98+reinterpret

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

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

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

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

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

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

131 -- ^ The effect handler.

102 -- ^ The effect handler.

132 -> Eff (e : es) a

103 -> Eff (e : es) a

133 -> Eff es b

104 -> Eff es b

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

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

135 les0 <- forkEnv es

106 les0 <- forkEnv es

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

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

137 runHandler es (Handler les handler) m

108 runHandler es (Handler les handler) m

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

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

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

16

17runReader :: 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

19 Ask -> R.ask

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

21

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

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

49-- Local

50

51runLocalState :: 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

53

54evalLocalState :: 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

56

57execLocalState :: 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

59

60localState

61 :: L.State s :> es

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

72-- Shared

73

74runSharedState :: 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

76

77evalSharedState :: 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

79

80execSharedState :: 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

82

83sharedState

84 :: S.State s :> es

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

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

28-- Local

29

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

31−runLocalWriter = reinterpretM L.runWriter localWriter

31+runLocalWriter = reinterpret L.runWriter localWriter

32

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

34−execLocalWriter = reinterpretM L.execWriter localWriter

34+execLocalWriter = reinterpret L.execWriter localWriter

35

36localWriter

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

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

46-- Shared

47

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

49−runSharedWriter = reinterpretM S.runWriter sharedWriter

49+runSharedWriter = reinterpret S.runWriter sharedWriter

50

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

52−execSharedWriter = reinterpretM S.execWriter sharedWriter

52+execSharedWriter = reinterpret S.execWriter sharedWriter

53

54sharedWriter

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

tests/ErrorTests.hs+2−1

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

31nestedErr = send NestedErr

32

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

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

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

35+ NestedErr -> throwError "nested error"

tests/StateTests.hs+1−1

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

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

114runHasInt n =

115 -- reinterpret with redundant local effects

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

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

117 GetInt -> get

118 PutInt i -> put i

119