Skip to content

Commit

Permalink
Add HasCallStack constraints for easier debugging
Browse files Browse the repository at this point in the history
Bechmarks are pretty much unaffected because most of these functions are small
and GHC inlines them.
  • Loading branch information
arybczak committed Sep 10, 2024
1 parent 1fcb071 commit bac27db
Show file tree
Hide file tree
Showing 23 changed files with 204 additions and 162 deletions.
1 change: 1 addition & 0 deletions effectful-core/CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@
* Fix a bug in `stateM` and `modifyM` of thread local `State` effect that
might've caused dropped state updates
([#237](https://github.com/haskell-effectful/effectful/issues/237)).
* Add `HasCallStack` constraints for easier debugging.
* **Breaking changes**:
- `localSeqLend`, `localLend`, `localSeqBorrow` and `localBorrow` now take a
list of effects instead of a single one.
Expand Down
40 changes: 20 additions & 20 deletions effectful-core/src/Effectful/Dispatch/Dynamic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -428,7 +428,7 @@ import Effectful.Internal.Utils
-- /Note:/ 'interpret' can be turned into a 'reinterpret' with the use of
-- 'inject'.
interpret
:: DispatchOf e ~ Dynamic
:: (HasCallStack, DispatchOf e ~ Dynamic)
=> EffectHandler e es
-- ^ The effect handler.
-> Eff (e : es) a
Expand All @@ -442,7 +442,7 @@ interpret handler m = unsafeEff $ \es -> do
--
-- @since 2.4.0.0
interpretWith
:: DispatchOf e ~ Dynamic
:: (HasCallStack, DispatchOf e ~ Dynamic)
=> Eff (e : es) a
-> EffectHandler e es
-- ^ The effect handler.
Expand All @@ -453,7 +453,7 @@ interpretWith m handler = interpret handler m
--
-- @'interpret' ≡ 'reinterpret' 'id'@
reinterpret
:: DispatchOf e ~ Dynamic
:: (HasCallStack, DispatchOf e ~ Dynamic)
=> (Eff handlerEs a -> Eff es b)
-- ^ Introduction of effects encapsulated within the handler.
-> EffectHandler e handlerEs
Expand All @@ -470,7 +470,7 @@ reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
--
-- @since 2.4.0.0
reinterpretWith
:: DispatchOf e ~ Dynamic
:: (HasCallStack, DispatchOf e ~ Dynamic)
=> (Eff handlerEs a -> Eff es b)
-- ^ Introduction of effects encapsulated within the handler.
-> Eff (e : es) a
Expand Down Expand Up @@ -508,7 +508,7 @@ reinterpretWith runHandlerEs m handler = reinterpret runHandlerEs handler m
-- op
--
interpose
:: forall e es a. (DispatchOf e ~ Dynamic, e :> es)
:: forall e es a. (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
=> EffectHandler e es
-- ^ The effect handler.
-> Eff es a
Expand Down Expand Up @@ -537,7 +537,7 @@ interpose handler m = unsafeEff $ \es -> do
--
-- @since 2.4.0.0
interposeWith
:: (DispatchOf e ~ Dynamic, e :> es)
:: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
=> Eff es a
-> EffectHandler e es
-- ^ The effect handler.
Expand All @@ -549,7 +549,7 @@ interposeWith m handler = interpose handler m
--
-- @'interpose' ≡ 'impose' 'id'@
impose
:: forall e es handlerEs a b. (DispatchOf e ~ Dynamic, e :> es)
:: forall e es handlerEs a b. (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
=> (Eff handlerEs a -> Eff es b)
-- ^ Introduction of effects encapsulated within the handler.
-> EffectHandler e handlerEs
Expand Down Expand Up @@ -582,7 +582,7 @@ impose runHandlerEs handler m = unsafeEff $ \es -> do
--
-- @since 2.4.0.0
imposeWith
:: (DispatchOf e ~ Dynamic, e :> es)
:: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
=> (Eff handlerEs a -> Eff es b)
-- ^ Introduction of effects encapsulated within the handler.
-> Eff es a
Expand All @@ -607,7 +607,7 @@ type EffectHandler_ (e :: Effect) (es :: [Effect])
--
-- @since 2.4.0.0
interpret_
:: DispatchOf e ~ Dynamic
:: (HasCallStack, DispatchOf e ~ Dynamic)
=> EffectHandler_ e es
-- ^ The effect handler.
-> Eff (e : es) a
Expand All @@ -618,7 +618,7 @@ interpret_ handler = interpret (const handler)
--
-- @since 2.4.0.0
interpretWith_
:: DispatchOf e ~ Dynamic
:: (HasCallStack, DispatchOf e ~ Dynamic)
=> Eff (e : es) a
-> EffectHandler_ e es
-- ^ The effect handler.
Expand All @@ -629,7 +629,7 @@ interpretWith_ m handler = interpretWith m (const handler)
--
-- @since 2.4.0.0
reinterpret_
:: DispatchOf e ~ Dynamic
:: (HasCallStack, DispatchOf e ~ Dynamic)
=> (Eff handlerEs a -> Eff es b)
-- ^ Introduction of effects encapsulated within the handler.
-> EffectHandler_ e handlerEs
Expand All @@ -642,7 +642,7 @@ reinterpret_ runHandlerEs handler = reinterpret runHandlerEs (const handler)
--
-- @since 2.4.0.0
reinterpretWith_
:: DispatchOf e ~ Dynamic
:: (HasCallStack, DispatchOf e ~ Dynamic)
=> (Eff handlerEs a -> Eff es b)
-- ^ Introduction of effects encapsulated within the handler.
-> Eff (e : es) a
Expand All @@ -655,7 +655,7 @@ reinterpretWith_ runHandlerEs m handler = reinterpretWith runHandlerEs m (const
--
-- @since 2.4.0.0
interpose_
:: (DispatchOf e ~ Dynamic, e :> es)
:: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
=> EffectHandler_ e es
-- ^ The effect handler.
-> Eff es a
Expand All @@ -666,7 +666,7 @@ interpose_ handler = interpose (const handler)
--
-- @since 2.4.0.0
interposeWith_
:: (DispatchOf e ~ Dynamic, e :> es)
:: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
=> Eff es a
-> EffectHandler_ e es
-- ^ The effect handler.
Expand All @@ -677,7 +677,7 @@ interposeWith_ m handler = interposeWith m (const handler)
--
-- @since 2.4.0.0
impose_
:: (DispatchOf e ~ Dynamic, e :> es)
:: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
=> (Eff handlerEs a -> Eff es b)
-- ^ Introduction of effects encapsulated within the handler.
-> EffectHandler_ e handlerEs
Expand All @@ -690,7 +690,7 @@ impose_ runHandlerEs handler = impose runHandlerEs (const handler)
--
-- @since 2.4.0.0
imposeWith_
:: (DispatchOf e ~ Dynamic, e :> es)
:: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
=> (Eff handlerEs a -> Eff es b)
-- ^ Introduction of effects encapsulated within the handler.
-> Eff es a
Expand Down Expand Up @@ -960,7 +960,7 @@ localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
-- @since 2.4.0.0
localSeqLend
:: forall lentEs es handlerEs localEs a
. (KnownSubset lentEs es, SharedSuffix es handlerEs)
. (HasCallStack, KnownSubset lentEs es, SharedSuffix es handlerEs)
=> LocalEnv localEs handlerEs
-> ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r) -> Eff es a)
-- ^ Continuation with the lent handler in scope.
Expand All @@ -977,7 +977,7 @@ localSeqLend (LocalEnv les) k = unsafeEff $ \es -> do
-- @since 2.4.0.0
localLend
:: forall lentEs es handlerEs localEs a
. (KnownSubset lentEs es, SharedSuffix es handlerEs)
. (HasCallStack, KnownSubset lentEs es, SharedSuffix es handlerEs)
=> LocalEnv localEs handlerEs
-> UnliftStrategy
-> ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r) -> Eff es a)
Expand All @@ -997,7 +997,7 @@ localLend (LocalEnv les) strategy k = case strategy of
-- @since 2.4.0.0
localSeqBorrow
:: forall borrowedEs es handlerEs localEs a
. (KnownSubset borrowedEs localEs, SharedSuffix es handlerEs)
. (HasCallStack, KnownSubset borrowedEs localEs, SharedSuffix es handlerEs)
=> LocalEnv localEs handlerEs
-> ((forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a)
-- ^ Continuation with the borrowed handler in scope.
Expand All @@ -1015,7 +1015,7 @@ localSeqBorrow (LocalEnv les) k = unsafeEff $ \es -> do
-- @since 2.4.0.0
localBorrow
:: forall borrowedEs es handlerEs localEs a
. (KnownSubset borrowedEs localEs, SharedSuffix es handlerEs)
. (HasCallStack, KnownSubset borrowedEs localEs, SharedSuffix es handlerEs)
=> LocalEnv localEs handlerEs
-> UnliftStrategy
-> ((forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a)
Expand Down
12 changes: 8 additions & 4 deletions effectful-core/src/Effectful/Error/Dynamic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,8 @@ type instance DispatchOf (Error e) = Dynamic

-- | Handle errors of type @e@ (via "Effectful.Error.Static").
runError
:: Eff (Error e : es) a
:: HasCallStack
=> Eff (Error e : es) a
-> Eff es (Either (E.CallStack, e) a)
runError = reinterpret E.runError $ \env -> \case
ThrowErrorWith display e -> E.throwErrorWith display e
Expand All @@ -56,7 +57,8 @@ runError = reinterpret E.runError $ \env -> \case
--
-- @since 2.3.0.0
runErrorWith
:: (E.CallStack -> e -> Eff es a)
:: HasCallStack
=> (E.CallStack -> e -> Eff es a)
-- ^ The error handler.
-> Eff (Error e : es) a
-> Eff es a
Expand All @@ -69,14 +71,16 @@ runErrorWith handler m = runError m >>= \case
--
-- @since 2.3.0.0
runErrorNoCallStack
:: Eff (Error e : es) a
:: HasCallStack
=> Eff (Error e : es) a
-> Eff es (Either e a)
runErrorNoCallStack = fmap (either (Left . snd) Right) . runError

-- | Handle errors of type @e@ (via "Effectful.Error.Static") with a specific
-- error handler. In case of an error discard the 'CallStack'.
runErrorNoCallStackWith
:: (e -> Eff es a)
:: HasCallStack
=> (e -> Eff es a)
-- ^ The error handler.
-> Eff (Error e : es) a
-> Eff es a
Expand Down
18 changes: 11 additions & 7 deletions effectful-core/src/Effectful/Error/Static.hs
Original file line number Diff line number Diff line change
Expand Up @@ -118,7 +118,8 @@ newtype instance StaticRep (Error e) = Error ErrorId
-- | Handle errors of type @e@.
runError
:: forall e es a
. Eff (Error e : es) a
. HasCallStack
=> Eff (Error e : es) a
-> Eff es (Either (CallStack, e) a)
runError m = unsafeEff $ \es0 -> mask $ \unmask -> do
eid <- newErrorId
Expand All @@ -136,7 +137,8 @@ runError m = unsafeEff $ \es0 -> mask $ \unmask -> do
--
-- @since 2.3.0.0
runErrorWith
:: (CallStack -> e -> Eff es a)
:: HasCallStack
=> (CallStack -> e -> Eff es a)
-- ^ The error handler.
-> Eff (Error e : es) a
-> Eff es a
Expand All @@ -149,14 +151,16 @@ runErrorWith handler m = runError m >>= \case
-- @since 2.3.0.0
runErrorNoCallStack
:: forall e es a
. Eff (Error e : es) a
. HasCallStack
=> Eff (Error e : es) a
-> Eff es (Either e a)
runErrorNoCallStack = fmap (either (Left . snd) Right) . runError

-- | Handle errors of type @e@ with a specific error handler. In case of an
-- error discard the 'CallStack'.
runErrorNoCallStackWith
:: (e -> Eff es a)
:: HasCallStack
=> (e -> Eff es a)
-- ^ The error handler.
-> Eff (Error e : es) a
-> Eff es a
Expand Down Expand Up @@ -199,7 +203,7 @@ throwError_ = withFrozenCallStack throwErrorWith (const "<opaque>")

-- | Handle an error of type @e@.
catchError
:: forall e es a. Error e :> es
:: forall e es a. (HasCallStack, Error e :> es)
=> Eff es a
-- ^ The inner computation.
-> (CallStack -> e -> Eff es a)
Expand All @@ -213,7 +217,7 @@ catchError m handler = unsafeEff $ \es -> do
-- | The same as @'flip' 'catchError'@, which is useful in situations where the
-- code for the handler is shorter.
handleError
:: forall e es a. Error e :> es
:: forall e es a. (HasCallStack, Error e :> es)
=> (CallStack -> e -> Eff es a)
-- ^ A handler for errors in the inner computation.
-> Eff es a
Expand All @@ -224,7 +228,7 @@ handleError = flip catchError
-- | Similar to 'catchError', but returns an 'Either' result which is a 'Right'
-- if no error was thrown and a 'Left' otherwise.
tryError
:: forall e es a. Error e :> es
:: forall e es a. (HasCallStack, Error e :> es)
=> Eff es a
-- ^ The inner computation.
-> Eff es (Either (CallStack, e) a)
Expand Down
4 changes: 2 additions & 2 deletions effectful-core/src/Effectful/Fail.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,11 +14,11 @@ import Effectful.Error.Static
import Effectful.Internal.Monad (Fail(..))

-- | Run the 'Fail' effect via 'Error'.
runFail :: Eff (Fail : es) a -> Eff es (Either String a)
runFail :: HasCallStack => Eff (Fail : es) a -> Eff es (Either String a)
runFail = reinterpret_ runErrorNoCallStack $ \case
Fail msg -> throwError msg

-- | Run the 'Fail' effect via the 'MonadFail' instance for 'IO'.
runFailIO :: IOE :> es => Eff (Fail : es) a -> Eff es a
runFailIO :: (HasCallStack, IOE :> es) => Eff (Fail : es) a -> Eff es a
runFailIO = interpret_ $ \case
Fail msg -> liftIO $ fail msg
Loading

0 comments on commit bac27db

Please sign in to comment.