fused-effects-resumable (empty) → 0.1.0.0
raw patch · 7 files changed
+252/−0 lines, 7 filesdep +basedep +deepseqdep +fused-effects
Dependencies added: base, deepseq, fused-effects, transformers
Files
- CHANGELOG.md +3/−0
- LICENSE +29/−0
- README.md +7/−0
- fused-effects-resumable.cabal +46/−0
- src/Control/Carrier/Resumable/Either.hs +75/−0
- src/Control/Carrier/Resumable/Resume.hs +53/−0
- src/Control/Effect/Resumable.hs +39/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# v0.1.0.0++Initial release.
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2019, Rob Rix and Patrick Thomson+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,7 @@+# fused-effects-resumable++[](https://hackage.haskell.org/package/fused-effects-resumable)+[](LICENSE)+[](https://github.com/fused-effects/fused-effects-resumable/actions)++This package provides resumable exceptions for the fused-effects ecosystem.
+ fused-effects-resumable.cabal view
@@ -0,0 +1,46 @@+cabal-version: 2.0+name: fused-effects-resumable+version: 0.1.0.0+synopsis: Resumable exceptions for the fused-effects ecosystem.+description: Provides an effect and carrier capable of resuming control flow from an exceptoin handler.+homepage: https://github.com/fused-effects/fused-effects-resumable+bug-reports: https://github.com/fused-effects/fused-effects-resumable/issues+license: BSD3+license-file: LICENSE+author: Rob Rix and Patrick Thomson+maintainer: patrickt@github.com+copyright: 2019 Rob Rix and Patrick Thomson+category: Control+build-type: Simple+extra-doc-files: README.md+ , CHANGELOG.md+tested-with: GHC == 8.6.4++source-repository head+ type: git+ location: https://github.com/fused-effects/fused-effects-resumable.git++library+ hs-source-dirs: src+ exposed-modules: Control.Carrier.Resumable.Either+ Control.Carrier.Resumable.Resume+ Control.Effect.Resumable+++ build-depends:+ base >= 4.9 && < 4.14+ , deepseq ^>= 1.4.3+ , fused-effects ^>= 1+ , transformers >= 0.4 && < 0.6++ ghc-options: -Wall+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wcompat+ -Widentities+ -Wredundant-constraints+ -fhide-source-paths+ -Wmissing-export-lists+ -Wpartial-fields++ default-language: Haskell2010
+ src/Control/Carrier/Resumable/Either.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{- | A carrier for 'Resumable' that disallows resumption of exceptions.++This can be useful when debugging or intercepting the behavior of a computation that invokes resumability.+-}+module Control.Carrier.Resumable.Either+( -- * Resumable carrier+ runResumable+, ResumableC(..)+, SomeError(..)+ -- * Resumable effect+, module Control.Effect.Resumable+) where++import Control.Applicative (Alternative(..))+import Control.Algebra+import Control.Carrier.Error.Either+import Control.DeepSeq+import Control.Effect.Resumable+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Data.Functor.Classes++-- | Run a 'Resumable' effect, returning uncaught errors in 'Left' and successful computations’ values in 'Right'.+--+-- @+-- 'runResumable' ('pure' a) = 'pure' ('Right' a)+-- @+-- @+-- 'runResumable' ('throwResumable' err) = 'pure' ('Left' err)+-- @+--+-- @since 0.1.0.0+runResumable :: ResumableC err m a -> m (Either (SomeError err) a)+runResumable = runError . runResumableC++-- | @since 0.1.0.0+newtype ResumableC err m a = ResumableC { runResumableC :: ErrorC (SomeError err) m a }+ deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus, MonadTrans)++instance (Algebra sig m, Effect sig) => Algebra (Resumable err :+: sig) (ResumableC err m) where+ alg (L (Resumable err _)) = ResumableC (throwError (SomeError err))+ alg (R other) = ResumableC (alg (R (handleCoercible other)))+ {-# INLINE alg #-}+++-- | An error at some existentially-quantified type index.+data SomeError err+ = forall a . SomeError (err a)++-- | Equality for 'SomeError' is determined by an 'Eq1' instance for the error type.+--+-- Note that since we can’t tell whether the type indices are equal, let alone what 'Eq' instance to use for them, the comparator passed to 'liftEq' always returns 'True'. Thus, 'SomeError' is best used with type-indexed GADTs for the error type.+instance Eq1 err => Eq (SomeError err) where+ SomeError exc1 == SomeError exc2 = liftEq (const (const True)) exc1 exc2++-- | Ordering for 'SomeError' is determined by an 'Ord1' instance for the error type.+--+-- Note that since we can’t tell whether the type indices are equal, let alone what 'Ord' instance to use for them, the comparator passed to 'liftCompare' always returns 'EQ'. Thus, 'SomeError' is best used with type-indexed GADTs for the error type.+instance Ord1 err => Ord (SomeError err) where+ SomeError exc1 `compare` SomeError exc2 = liftCompare (const (const EQ)) exc1 exc2++-- | Showing for 'SomeError' is determined by a 'Show1' instance for the error type.+--+-- Note that since we can’t tell what 'Show' instance to use for the type index, the functions passed to 'liftShowsPrec' always return the empty 'ShowS'. Thus, 'SomeError' is best used with type-indexed GADTs for the error type.+instance Show1 err => Show (SomeError err) where+ showsPrec d (SomeError err) = showsUnaryWith (liftShowsPrec (const (const id)) (const id)) "SomeError" d err+++-- | Evaluation of 'SomeError' to normal forms is determined by a 'NFData1' instance for the error type.+instance NFData1 err => NFData (SomeError err) where+ rnf (SomeError err) = liftRnf (\a -> seq a ()) err
+ src/Control/Carrier/Resumable/Resume.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}++-- | Provides a carrier for 'Resumable' that can, given a handler function, resume the computation that threw an exception.+module Control.Carrier.Resumable.Resume+( -- * Resumable carrier+ runResumable+, ResumableC(..)+ -- * Resumable effect+, module Control.Effect.Resumable+) where++import Control.Applicative (Alternative(..))+import Control.Algebra+import Control.Carrier.Reader+import Control.Effect.Resumable+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class++-- | Run a 'Resumable' effect, resuming uncaught errors with a given handler.+--+-- Note that this may be less efficient than defining a specialized carrier type and instance specifying the handler’s behaviour directly. Performance-critical code may wish to do that to maximize the opportunities for fusion and inlining.+--+-- @+-- 'runResumable' f ('pure' a) = 'pure' a+-- @+-- @+-- 'runResumable' f ('throwResumable' e) = f e+-- @+--+-- @since 0.1.0.0+runResumable+ :: (forall x . err x -> m x)+ -> ResumableC err m a+ -> m a+runResumable with = runReader (Handler with) . runResumableC++-- | @since 0.1.0.0+newtype ResumableC err m a = ResumableC { runResumableC :: ReaderC (Handler err m) m a }+ deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)++instance MonadTrans (ResumableC err) where+ lift = ResumableC . lift+ {-# INLINE lift #-}++newtype Handler err m = Handler { runHandler :: forall x . err x -> m x }++instance Algebra sig m => Algebra (Resumable err :+: sig) (ResumableC err m) where+ alg (L (Resumable err k)) = ResumableC (ReaderC (\ handler -> runHandler handler err)) >>= k+ alg (R other) = ResumableC (alg (R (handleCoercible other)))+ {-# INLINE alg #-}
+ src/Control/Effect/Resumable.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, StandaloneDeriving #-}+-- | An effect providing the ability to throw exceptions from a context. If an exception is+-- thrown, the calling context may choose to resume the computation. Type safety of the+-- resumed operation is preserved by parametricity achieved from the @-XGADTs@ extension.+--+-- Predefined carriers:+--+-- * "Control.Carrier.Resumable.Resume", which provides full resumption semantics.+-- * "Control.Carrier.Resumable.Either", which elides resumption support (like @Control.Effect.Error@).+module Control.Effect.Resumable+( -- * Resumable effect+ Resumable(..)+, throwResumable+ -- * Re-exports+, Has+, run+) where++import Control.Algebra++-- | Errors which can be resumed with values of some existentially-quantified type.+--+-- @since 0.1.0.0+data Resumable err m k+ = forall a . Resumable (err a) (a -> m k)++deriving instance Functor m => Functor (Resumable err m)++instance HFunctor (Resumable err) where+ hmap f (Resumable err k) = Resumable err (f . k)++instance Effect (Resumable err) where+ thread state handler (Resumable err k) = Resumable err (handler . (<$ state) . k)++-- | Throw an error which can be resumed with a value of its result type. Note that the type parameters in the @err a@ paramater and @m a@ parameter must match up; this indicates the type with which the error must be resumed.+--+-- @since 0.1.0.0+throwResumable :: Has (Resumable err) sig m => err a -> m a+throwResumable err = send (Resumable err pure)