git.iko.soy/effectful
on master help sign in
Add HasCallStack to operations and re-export utils from GHC.Stack
commit8cd8c32f49ed59e1d721334bb2b03ab2536e2b61 authorAndrzej Rybczak <andrzej@rybczak.net> dateTue 13 Jul 2021, 13:29 (5 years ago) parent1b8a56b
6 files changed+55−18
compare with master
unifiedsplit
src/Effectful/Error.hs+6 src/Effectful/Error/Dynamic.hs+6−7 src/Effectful/Handler.hs+3 src/Effectful/State/Dynamic.hs+27−7 src/Effectful/Writer/Dynamic.hs+13−3 tests/ErrorTests.hs−1
src/Effectful/Error.hs+6
@@ -25,6 +25,12 @@ module Effectful.Error
2525 , throwError
2626 , catchError
2727 , tryError
28+
29+ -- * Re-exports
30+ , HasCallStack
31+ , CallStack
32+ , getCallStack
33+ , prettyCallStack
2834 ) where
2935
3036import Control.Exception
src/Effectful/Error/Dynamic.hs+6−7
@@ -7,7 +7,6 @@ module Effectful.Error.Dynamic
77 ) where
88
99import Data.Typeable
10−import GHC.Stack
1110
1211import Effectful.Handler
1312import Effectful.Monad
@@ -15,12 +14,12 @@ import qualified Effectful.Error as E
1514
1615data Error e :: Effect where
1716 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
1918
2019runError
2120 :: Typeable e
2221 => Eff (Error e : es) a
23− -> Eff es (Either (CallStack, e) a)
22+ -> Eff es (Either (E.CallStack, e) a)
2423runError = reinterpretM E.runError $ \env -> \case
2524 ThrowError e -> E.throwError e
2625 CatchError m h -> localSeqUnlift env $ \unlift -> do
@@ -33,14 +32,14 @@ throwError
3332throwError = send . ThrowError
3433
3534catchError
36− :: Error e :> es
35+ :: (HasCallStack, Error e :> es)
3736 => Eff es a
38− -> (CallStack -> e -> Eff es a)
37+ -> (E.CallStack -> e -> Eff es a)
3938 -> Eff es a
4039catchError m = send . CatchError m
4140
4241tryError
43− :: Error e :> es
42+ :: (HasCallStack, Error e :> es)
4443 => Eff es a
45− -> Eff es (Either (CallStack, e) a)
44+ -> Eff es (Either (E.CallStack, e) a)
4645tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)
src/Effectful/Handler.hs+3
@@ -28,6 +28,9 @@ module Effectful.Handler
2828 -- *** Bidirectional lifts
2929 , localLiftUnlift
3030 , localLiftUnliftIO
31+
32+ -- * Re-exports
33+ , HasCallStack
3134 ) where
3235
3336import Control.Monad.IO.Unlift
src/Effectful/State/Dynamic.hs+27−7
@@ -94,23 +94,43 @@ sharedState env = \case
9494----------------------------------------
9595-- Operations
9696
97−get :: State s :> es => Eff es s
97+get
98+ :: (HasCallStack, State s :> es)
99+ => Eff es s
98100get = send Get
99101
100−gets :: State s :> es => (s -> a) -> Eff es a
102+gets
103+ :: (HasCallStack, State s :> es)
104+ => (s -> a)
105+ -> Eff es a
101106gets f = f <$> get
102107
103−put :: State s :> es => s -> Eff es ()
108+put
109+ :: (HasCallStack, State s :> es)
110+ => s
111+ -> Eff es ()
104112put = send . Put
105113
106−state :: (State s :> es) => (s -> (a, s)) -> Eff es a
114+state
115+ :: (HasCallStack, State s :> es)
116+ => (s -> (a, s))
117+ -> Eff es a
107118state = send . State
108119
109−modify :: State s :> es => (s -> s) -> Eff es ()
120+modify
121+ :: (HasCallStack, State s :> es)
122+ => (s -> s)
123+ -> Eff es ()
110124modify f = state (\s -> ((), f s))
111125
112−stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
126+stateM
127+ :: (HasCallStack, State s :> es)
128+ => (s -> Eff es (a, s))
129+ -> Eff es a
113130stateM = send . StateM
114131
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 ()
116136modifyM f = stateM (\s -> ((), ) <$> f s)
src/Effectful/Writer/Dynamic.hs+13−3
@@ -63,13 +63,23 @@ sharedWriter env = \case
6363----------------------------------------
6464-- Operations
6565
66−tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
66+tell
67+ :: (HasCallStack, Writer w :> es, Monoid w)
68+ => w
69+ -> Eff es ()
6770tell = send . Tell
6871
69−listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
72+listen
73+ :: (HasCallStack, Writer w :> es, Monoid w)
74+ => Eff es a
75+ -> Eff es (a, w)
7076listen = send . Listen
7177
72−listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
78+listens
79+ :: (HasCallStack, Writer w :> es, Monoid w)
80+ => (w -> b)
81+ -> Eff es a
82+ -> Eff es (a, b)
7383listens f m = do
7484 (a, w) <- listen m
7585 pure (a, f w)
tests/ErrorTests.hs−1
@@ -3,7 +3,6 @@ module ErrorTests (errorTests) where
33import Control.Monad.IO.Class
44import Test.Tasty
55import Test.Tasty.HUnit
6−import GHC.Stack (getCallStack)
76
87import Effectful
98import Effectful.Error