Add HasCallStack to operations and re-export utils from GHC.Stack

src/Effectful/Error.hs

@@ -25,6 +25,12 @@ module Effectful.Error
  , throwError
  , catchError
  , tryError
+
+ -- * Re-exports
+ , HasCallStack
+ , CallStack
+ , getCallStack
+ , prettyCallStack
  ) where
 
 import Control.Exception

src/Effectful/Error/Dynamic.hs

@@ -7,7 +7,6 @@ module Effectful.Error.Dynamic
   ) where
 
 import Data.Typeable
-import GHC.Stack
 
 import Effectful.Handler
 import Effectful.Monad
@@ -15,12 +14,12 @@ import qualified Effectful.Error as E
 
 data Error e :: Effect where
   ThrowError :: e -> Error e m a
-  CatchError :: m a -> (CallStack -> e -> m a) -> Error e m a
+  CatchError :: m a -> (E.CallStack -> e -> m a) -> Error e m a
 
 runError
   :: Typeable e
   => Eff (Error e : es) a
-  -> Eff es (Either (CallStack, e) a)
+  -> Eff es (Either (E.CallStack, e) a)
 runError = reinterpretM E.runError $ \env -> \case
   ThrowError e   -> E.throwError e
   CatchError m h -> localSeqUnlift env $ \unlift -> do
@@ -33,14 +32,14 @@ throwError
 throwError = send . ThrowError
 
 catchError
-  :: Error e :> es
+  :: (HasCallStack, Error e :> es)
   => Eff es a
-  -> (CallStack -> e -> Eff es a)
+  -> (E.CallStack -> e -> Eff es a)
   -> Eff es a
 catchError m = send . CatchError m
 
 tryError
-  :: Error e :> es
+  :: (HasCallStack, Error e :> es)
   => Eff es a
-  -> Eff es (Either (CallStack, e) a)
+  -> Eff es (Either (E.CallStack, e) a)
 tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)

src/Effectful/Handler.hs

@@ -28,6 +28,9 @@ module Effectful.Handler
   -- *** Bidirectional lifts
   , localLiftUnlift
   , localLiftUnliftIO
+
+  -- * Re-exports
+  , HasCallStack
   ) where
 
 import Control.Monad.IO.Unlift

src/Effectful/State/Dynamic.hs

@@ -94,23 +94,43 @@ sharedState env = \case
 ----------------------------------------
 -- Operations
 
-get :: State s :> es => Eff es s
+get
+  :: (HasCallStack, State s :> es)
+  => Eff es s
 get = send Get
 
-gets :: State s :> es => (s -> a) -> Eff es a
+gets
+  :: (HasCallStack, State s :> es)
+  => (s -> a)
+  -> Eff es a
 gets f = f <$> get
 
-put :: State s :> es => s -> Eff es ()
+put
+  :: (HasCallStack, State s :> es)
+  => s
+  -> Eff es ()
 put = send . Put
 
-state :: (State s :> es) => (s -> (a, s)) -> Eff es a
+state
+  :: (HasCallStack, State s :> es)
+  => (s -> (a, s))
+  -> Eff es a
 state = send . State
 
-modify :: State s :> es => (s -> s) -> Eff es ()
+modify
+  :: (HasCallStack, State s :> es)
+  => (s -> s)
+  -> Eff es ()
 modify f = state (\s -> ((), f s))
 
-stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
+stateM
+  :: (HasCallStack, State s :> es)
+  => (s -> Eff es (a, s))
+  -> Eff es a
 stateM = send . StateM
 
-modifyM :: State s :> es => (s -> Eff es s) -> Eff es ()
+modifyM
+  :: (HasCallStack, State s :> es)
+  => (s -> Eff es s)
+  -> Eff es ()
 modifyM f = stateM (\s -> ((), ) <$> f s)

src/Effectful/Writer/Dynamic.hs

@@ -63,13 +63,23 @@ sharedWriter env = \case
 ----------------------------------------
 -- Operations
 
-tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
+tell
+  :: (HasCallStack, Writer w :> es, Monoid w)
+  => w
+  -> Eff es ()
 tell = send . Tell
 
-listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
+listen
+  :: (HasCallStack, Writer w :> es, Monoid w)
+  => Eff es a
+  -> Eff es (a, w)
 listen = send . Listen
 
-listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
+listens
+  :: (HasCallStack, Writer w :> es, Monoid w)
+  => (w -> b)
+  -> Eff es a
+  -> Eff es (a, b)
 listens f m = do
   (a, w) <- listen m
   pure (a, f w)

tests/ErrorTests.hs

@@ -3,7 +3,6 @@ module ErrorTests (errorTests) where
 import Control.Monad.IO.Class
 import Test.Tasty
 import Test.Tasty.HUnit
-import GHC.Stack (getCallStack)
 
 import Effectful
 import Effectful.Error