-
Notifications
You must be signed in to change notification settings - Fork 28
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Improve Labeled and add labeled versions of base effects (#228)
* Improve Labeled and add labeled versions of base effects * Remove .VDQ modules for now * tests * doctest * more doctest * ci * run doctest with 9.10 * run polysemy with 9.10
- Loading branch information
Showing
27 changed files
with
638 additions
and
55 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,6 +1,6 @@ | ||
| branches: master | ||
|
|
||
| doctest: <9.9 | ||
| doctest: <9.11 | ||
| doctest-skip: effectful-plugin | ||
|
|
||
| tests: True | ||
|
|
||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,111 @@ | ||
| {-# LANGUAGE AllowAmbiguousTypes #-} | ||
| -- | Convenience functions for the 'Labeled' 'Error' effect. | ||
| -- | ||
| -- @since 2.4.0.0 | ||
| module Effectful.Labeled.Error | ||
| ( -- * Effect | ||
| Error(..) | ||
|
|
||
| -- ** Handlers | ||
| , runError | ||
| , runErrorWith | ||
| , runErrorNoCallStack | ||
| , runErrorNoCallStackWith | ||
|
|
||
| -- ** Operations | ||
| , throwError | ||
| , catchError | ||
| , handleError | ||
| , tryError | ||
|
|
||
| -- * Re-exports | ||
| , E.HasCallStack | ||
| , E.CallStack | ||
| , E.getCallStack | ||
| , E.prettyCallStack | ||
| ) where | ||
|
|
||
| import GHC.Stack (withFrozenCallStack) | ||
|
|
||
| import Effectful | ||
| import Effectful.Dispatch.Dynamic | ||
| import Effectful.Labeled | ||
| import Effectful.Error.Dynamic (Error(..)) | ||
| import Effectful.Error.Dynamic qualified as E | ||
|
|
||
| -- | Handle errors of type @e@ (via "Effectful.Error.Static"). | ||
| runError | ||
| :: forall label e es a | ||
| . Eff (Labeled label (Error e) : es) a | ||
| -> Eff es (Either (E.CallStack, e) a) | ||
| runError = runLabeled @label E.runError | ||
|
|
||
| -- | Handle errors of type @e@ (via "Effectful.Error.Static") with a specific | ||
| -- error handler. | ||
| runErrorWith | ||
| :: forall label e es a | ||
| . (E.CallStack -> e -> Eff es a) | ||
| -- ^ The error handler. | ||
| -> Eff (Labeled label (Error e) : es) a | ||
| -> Eff es a | ||
| runErrorWith = runLabeled @label . E.runErrorWith | ||
|
|
||
| -- | Handle errors of type @e@ (via "Effectful.Error.Static"). In case of an | ||
| -- error discard the 'E.CallStack'. | ||
| runErrorNoCallStack | ||
| :: forall label e es a | ||
| . Eff (Labeled label (Error e) : es) a | ||
| -> Eff es (Either e a) | ||
| runErrorNoCallStack = runLabeled @label E.runErrorNoCallStack | ||
|
|
||
| -- | Handle errors of type @e@ (via "Effectful.Error.Static") with a specific | ||
| -- error handler. In case of an error discard the 'CallStack'. | ||
| runErrorNoCallStackWith | ||
| :: forall label e es a | ||
| . (e -> Eff es a) | ||
| -- ^ The error handler. | ||
| -> Eff (Labeled label (Error e) : es) a | ||
| -> Eff es a | ||
| runErrorNoCallStackWith = runLabeled @label . E.runErrorNoCallStackWith | ||
|
|
||
| -- | Throw an error of type @e@. | ||
| throwError | ||
| :: forall label e es a | ||
| . (HasCallStack, Labeled label (Error e) :> es) | ||
| => e | ||
| -- ^ The error. | ||
| -> Eff es a | ||
| throwError e = withFrozenCallStack $ send (Labeled @label $ ThrowError e) | ||
|
|
||
| -- | Handle an error of type @e@. | ||
| catchError | ||
| :: forall label e es a | ||
| . (HasCallStack, Labeled label (Error e) :> es) | ||
| => Eff es a | ||
| -- ^ The inner computation. | ||
| -> (E.CallStack -> e -> Eff es a) | ||
| -- ^ A handler for errors in the inner computation. | ||
| -> Eff es a | ||
| catchError m = send . Labeled @label . CatchError m | ||
|
|
||
| -- | The same as @'flip' 'catchError'@, which is useful in situations where the | ||
| -- code for the handler is shorter. | ||
| handleError | ||
| :: forall label e es a | ||
| . (HasCallStack, Labeled label (Error e) :> es) | ||
| => (E.CallStack -> e -> Eff es a) | ||
| -- ^ A handler for errors in the inner computation. | ||
| -> Eff es a | ||
| -- ^ The inner computation. | ||
| -> Eff es a | ||
| handleError = flip (catchError @label) | ||
|
|
||
| -- | Similar to 'catchError', but returns an 'Either' result which is a 'Right' | ||
| -- if no error was thrown and a 'Left' otherwise. | ||
| tryError | ||
| :: forall label e es a | ||
| . (HasCallStack, Labeled label (Error e) :> es) | ||
| => Eff es a | ||
| -- ^ The inner computation. | ||
| -> Eff es (Either (E.CallStack, e) a) | ||
| tryError m = catchError @label (Right <$> m) (\es e -> pure $ Left (es, e)) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,66 @@ | ||
| {-# LANGUAGE AllowAmbiguousTypes #-} | ||
| -- | Convenience functions for the 'Labeled' 'Reader' effect. | ||
| -- | ||
| -- @since 2.4.0.0 | ||
| module Effectful.Labeled.Reader | ||
| ( -- * Effect | ||
| Reader(..) | ||
|
|
||
| -- ** Handlers | ||
| , runReader | ||
|
|
||
| -- ** Operations | ||
| , ask | ||
| , asks | ||
| , local | ||
| ) where | ||
|
|
||
| import Effectful | ||
| import Effectful.Dispatch.Dynamic | ||
| import Effectful.Labeled | ||
| import Effectful.Reader.Dynamic (Reader(..)) | ||
| import Effectful.Reader.Dynamic qualified as R | ||
|
|
||
| -- | Run the 'Reader' effect with the given initial environment (via | ||
| -- "Effectful.Reader.Static"). | ||
| runReader | ||
| :: forall label r es a | ||
| . r | ||
| -- ^ The initial environment. | ||
| -> Eff (Labeled label (Reader r) : es) a | ||
| -> Eff es a | ||
| runReader = runLabeled @label . R.runReader | ||
|
|
||
| ---------------------------------------- | ||
| -- Operations | ||
|
|
||
| -- | Fetch the value of the environment. | ||
| ask | ||
| :: forall label r es | ||
| . (HasCallStack, Labeled label (Reader r) :> es) | ||
| => Eff es r | ||
| ask = send $ Labeled @label Ask | ||
|
|
||
| -- | Retrieve a function of the current environment. | ||
| -- | ||
| -- @'asks' f ≡ f '<$>' 'ask'@ | ||
| asks | ||
| :: forall label r es a | ||
| . (HasCallStack, Labeled label (Reader r) :> es) | ||
| => (r -> a) | ||
| -- ^ The function to apply to the environment. | ||
| -> Eff es a | ||
| asks f = f <$> ask @label | ||
|
|
||
| -- | Execute a computation in a modified environment. | ||
| -- | ||
| -- @'runReader' r ('local' f m) ≡ 'runReader' (f r) m@ | ||
| -- | ||
| local | ||
| :: forall label r es a | ||
| . (HasCallStack, Labeled label (Reader r) :> es) | ||
| => (r -> r) | ||
| -- ^ The function to modify the environment. | ||
| -> Eff es a | ||
| -> Eff es a | ||
| local f = send . Labeled @label . Local f |
Oops, something went wrong.