git.iko.soy/effectful
on master help sign in
Add HasCallStack to operations and re-export utils from GHC.Stack
8cd8c32Andrzej Rybczak
src/Effectful/Error.hs+6
compare with master
unifiedsplit
@@ -25,6 +25,12 @@ module Effectful.Error
25 , throwError
25 , throwError
26 , catchError
26 , catchError
27 , tryError
27 , tryError
28+
29+ -- * Re-exports
30+ , HasCallStack
31+ , CallStack
32+ , getCallStack
33+ , prettyCallStack
28 ) where
34 ) where
29
35
30import Control.Exception
36import Control.Exception
src/Effectful/Error/Dynamic.hs+6−7
@@ -7,7 +7,6 @@ module Effectful.Error.Dynamic
7 ) where
7 ) where
8
8
9import Data.Typeable
9import Data.Typeable
10−import GHC.Stack
11
10
12import Effectful.Handler
11import Effectful.Handler
13import Effectful.Monad
12import Effectful.Monad
@@ -15,12 +14,12 @@ import qualified Effectful.Error as E
15
14
16data Error e :: Effect where
15data Error e :: Effect where
17 ThrowError :: e -> Error e m a
16 ThrowError :: e -> Error e m a
18− CatchError :: m a -> (CallStack -> e -> m a) -> Error e m a
17+ CatchError :: m a -> (E.CallStack -> e -> m a) -> Error e m a
19
18
20runError
19runError
21 :: Typeable e
20 :: Typeable e
22 => Eff (Error e : es) a
21 => Eff (Error e : es) a
23− -> Eff es (Either (CallStack, e) a)
22+ -> Eff es (Either (E.CallStack, e) a)
24runError = reinterpretM E.runError $ \env -> \case
23runError = reinterpretM E.runError $ \env -> \case
25 ThrowError e -> E.throwError e
24 ThrowError e -> E.throwError e
26 CatchError m h -> localSeqUnlift env $ \unlift -> do
25 CatchError m h -> localSeqUnlift env $ \unlift -> do
@@ -33,14 +32,14 @@ throwError
33throwError = send . ThrowError
32throwError = send . ThrowError
34
33
35catchError
34catchError
36− :: Error e :> es
35+ :: (HasCallStack, Error e :> es)
37 => Eff es a
36 => Eff es a
38− -> (CallStack -> e -> Eff es a)
37+ -> (E.CallStack -> e -> Eff es a)
39 -> Eff es a
38 -> Eff es a
40catchError m = send . CatchError m
39catchError m = send . CatchError m
41
40
42tryError
41tryError
43− :: Error e :> es
42+ :: (HasCallStack, Error e :> es)
44 => Eff es a
43 => Eff es a
45− -> Eff es (Either (CallStack, e) a)
44+ -> Eff es (Either (E.CallStack, e) a)
46tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)
45tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)
src/Effectful/Handler.hs+3
@@ -28,6 +28,9 @@ module Effectful.Handler
28 -- *** Bidirectional lifts
28 -- *** Bidirectional lifts
29 , localLiftUnlift
29 , localLiftUnlift
30 , localLiftUnliftIO
30 , localLiftUnliftIO
31+
32+ -- * Re-exports
33+ , HasCallStack
31 ) where
34 ) where
32
35
33import Control.Monad.IO.Unlift
36import Control.Monad.IO.Unlift
src/Effectful/State/Dynamic.hs+27−7
@@ -94,23 +94,43 @@ sharedState env = \case
94----------------------------------------
94----------------------------------------
95-- Operations
95-- Operations
96
96
97+get
98+ :: (HasCallStack, State s :> es)
97−get :: State s :> es => Eff es s
99+ => Eff es s
98get = send Get
100get = send Get
99
101
102+gets
103+ :: (HasCallStack, State s :> es)
104+ => (s -> a)
100−gets :: State s :> es => (s -> a) -> Eff es a
105+ -> Eff es a
101gets f = f <$> get
106gets f = f <$> get
102
107
108+put
109+ :: (HasCallStack, State s :> es)
110+ => s
103−put :: State s :> es => s -> Eff es ()
111+ -> Eff es ()
104put = send . Put
112put = send . Put
105
113
114+state
115+ :: (HasCallStack, State s :> es)
116+ => (s -> (a, s))
106−state :: (State s :> es) => (s -> (a, s)) -> Eff es a
117+ -> Eff es a
107state = send . State
118state = send . State
108
119
109−modify :: State s :> es => (s -> s) -> Eff es ()
120+modify
121+ :: (HasCallStack, State s :> es)
122+ => (s -> s)
123+ -> Eff es ()
110modify f = state (\s -> ((), f s))
124modify f = state (\s -> ((), f s))
111
125
126+stateM
127+ :: (HasCallStack, State s :> es)
112−stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
128+ => (s -> Eff es (a, s))
129+ -> Eff es a
113stateM = send . StateM
130stateM = send . StateM
114
131
115−modifyM :: State s :> es => (s -> Eff es s) -> Eff es ()
132+modifyM
133+ :: (HasCallStack, State s :> es)
134+ => (s -> Eff es s)
135+ -> Eff es ()
116modifyM f = stateM (\s -> ((), ) <$> f s)
136modifyM f = stateM (\s -> ((), ) <$> f s)
src/Effectful/Writer/Dynamic.hs+13−3
@@ -63,13 +63,23 @@ sharedWriter env = \case
63----------------------------------------
63----------------------------------------
64-- Operations
64-- Operations
65
65
66+tell
66−tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
67+ :: (HasCallStack, Writer w :> es, Monoid w)
68+ => w
69+ -> Eff es ()
67tell = send . Tell
70tell = send . Tell
68
71
72+listen
69−listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
73+ :: (HasCallStack, Writer w :> es, Monoid w)
74+ => Eff es a
75+ -> Eff es (a, w)
70listen = send . Listen
76listen = send . Listen
71
77
78+listens
72−listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
79+ :: (HasCallStack, Writer w :> es, Monoid w)
80+ => (w -> b)
81+ -> Eff es a
82+ -> Eff es (a, b)
73listens f m = do
83listens f m = do
74 (a, w) <- listen m
84 (a, w) <- listen m
75 pure (a, f w)
85 pure (a, f w)
tests/ErrorTests.hs−1
@@ -3,7 +3,6 @@ module ErrorTests (errorTests) where
3import Control.Monad.IO.Class
3import Control.Monad.IO.Class
4import Test.Tasty
4import Test.Tasty
5import Test.Tasty.HUnit
5import Test.Tasty.HUnit
6−import GHC.Stack (getCallStack)
7
6
8import Effectful
7import Effectful
9import Effectful.Error
8import Effectful.Error