r
/
fused-effects-exceptions
mirror of https://github.com/jrpotter/fused-effects-exceptions
1
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Excise basically the whole project in favor of Control.Effect.Exc.

main
Patrick Thomson 2019-10-29 12:27:02 -04:00
parent a39a61861d
commit d672693b27
6 changed files with 17 additions and 292 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
fused-effects-exceptions.cabal
View File

@ -19,16 +19,11 @@ tested-with: GHC == 8.6.4
library
hs-source-dirs: src
default-language: Haskell2010
exposed-modules: Control.Carrier.Catch
Control.Carrier.Resource
Control.Carrier.State.IORef
Control.Effect.Catch
Control.Effect.Resource
exposed-modules: Control.Carrier.State.IORef
Control.Effect.Exception
build-depends: base >= 4.7 && < 5
, fused-effects
, safe-exceptions >= 0.1 && <1
, transformers
, unliftio-core >= 0.1.2 && <1
, fused-effects >= 1.0.0.0
, transformers >= 0.4 && < 0.6
source-repository head
type: git

45
src/Control/Carrier/Catch.hs
View File

@ -1,45 +0,0 @@
{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}
-- | A carrier for a 'Catch' effect.
module Control.Carrier.Catch
( -- * Catch effect
module Control.Effect.Catch
-- * Catch carrier
, runCatch
, CatchC (..)
-- * Re-exports
, Carrier
, run
) where
import Control.Applicative (Alternative(..))
import Control.Carrier
import Control.Effect.Catch
import qualified Control.Exception as Exc
import Control.Monad (MonadPlus(..))
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Class
-- | Evaluate a 'Catch' effect, using 'MonadUnliftIO' to infer a correct unlifting function.
--
-- | @since 1.0.0.0
runCatch :: MonadUnliftIO m => CatchC m a -> m a
runCatch = runCatchC
newtype CatchC m a = CatchC { runCatchC :: m a }
deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)
instance MonadTrans CatchC where
lift = CatchC
instance MonadUnliftIO m => MonadUnliftIO (CatchC m) where
withRunInIO f = CatchC (withRunInIO (\ runInIO -> f (runInIO . runCatchC)))
instance (Carrier sig m, MonadUnliftIO m) => Carrier (Catch :+: sig) (CatchC m) where
eff (L (CatchIO act cleanup k)) = do
handler <- askUnliftIO
liftIO (Exc.catch (unliftIO handler act) (unliftIO handler . cleanup)) >>= k
eff (R other) = CatchC (eff (handleCoercible other))

66
src/Control/Carrier/Resource.hs
View File

@ -1,66 +0,0 @@
{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}
-- | Provides a carrier for a 'Resource' effect. This carrier is implemented atop 'Control.Exception.catch' from "Control.Exception" and is thus safe in the presence of asynchronous exceptions.
module Control.Carrier.Resource
( -- * Resource effect
module Control.Effect.Resource
-- * Resource carrier
, runResource
, ResourceC(..)
-- * Re-exports
, Carrier
, run
) where
import Control.Applicative (Alternative(..))
import Control.Carrier
import Control.Effect.Resource
import qualified Control.Exception as Exc
import Control.Monad (MonadPlus(..))
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Class
-- | Executes a 'Resource' effect. Because this runs using 'MonadUnliftIO',
-- invocations of 'runResource' must happen at the "bottom" of a stack of
-- effect invocations, i.e. before the use of any monads that lack such
-- instances, such as 'StateC':
--
-- @
-- runM
-- . runResource
-- . runState @Int 1
-- $ myComputation
-- @
--
-- @since 1.0.0.0
runResource :: ResourceC m a -> m a
runResource = runResourceC
newtype ResourceC m a = ResourceC { runResourceC :: m a }
deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)
instance MonadTrans ResourceC where
lift = ResourceC
instance MonadUnliftIO m => MonadUnliftIO (ResourceC m) where
withRunInIO f = ResourceC (withRunInIO (\ runInIO -> f (runInIO . runResourceC)))
instance (Carrier sig m, MonadUnliftIO m) => Carrier (Resource :+: sig) (ResourceC m) where
eff (L (Resource acquire release use k)) = do
handler <- askUnliftIO
a <- liftIO (Exc.bracket
(unliftIO handler acquire)
(unliftIO handler . release)
(unliftIO handler . use))
k a
eff (L (OnError acquire release use k)) = do
handler <- askUnliftIO
a <- liftIO (Exc.bracketOnError
(unliftIO handler acquire)
(unliftIO handler . release)
(unliftIO handler . use))
k a
eff (R other) = ResourceC (eff (handleCoercible other))

28
src/Control/Carrier/State/IORef.hs
View File

@ -5,27 +5,23 @@
Note that the parameter order in 'runState', 'evalState', and 'execState' is reversed compared the equivalent functions provided by @transformers@. This is an intentional decision made to enable the composition of effect handlers with '.' without invoking 'flip'.
-}
module Control.Carrier.State.IORef
( -- * State effect
module Control.Effect.State
-- * Strict state carrier
, runState
( -- * Strict state carrier
runState
, evalState
, execState
, StateC(..)
-- * Re-exports
, Carrier
, run
-- * State effect
, module Control.Effect.State
) where
import Control.Applicative (Alternative (..))
import Control.Carrier
import Control.Algebra
import Control.Carrier.Reader
import Control.Effect.State
import Control.Monad (MonadPlus (..))
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Class
import Data.IORef
@ -66,17 +62,11 @@ execState s = fmap fst . runState s
newtype StateC s m a = StateC { runStateC :: ReaderC (IORef s) m a }
deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)
instance MonadUnliftIO m => MonadUnliftIO (StateC s m) where
askUnliftIO = StateC . ReaderC $ \r -> withUnliftIO $ \u -> pure (UnliftIO (\(StateC (ReaderC x)) -> unliftIO u (x r)))
{-# INLINE askUnliftIO #-}
withRunInIO inner = StateC . ReaderC $ \r -> withRunInIO $ \go -> inner (go . runReader r . runStateC)
{-# INLINE withRunInIO #-}
instance (MonadIO m, Carrier sig m, Effect sig) => Carrier (State s :+: sig) (StateC s m) where
eff (L act) = do
instance (MonadIO m, Algebra sig m, Effect sig) => Algebra (State s :+: sig) (StateC s m) where
alg (L act) = do
ref <- StateC ask
case act of
Put s k -> liftIO (writeIORef ref s) *> k
Get k -> liftIO (readIORef ref) >>= k
eff (R other) = StateC (eff (R (handleCoercible other)))
{-# INLINE eff #-}
alg (R other) = StateC (handleCoercible other)
{-# INLINE alg #-}

62
src/Control/Effect/Catch.hs
View File

@ -1,62 +0,0 @@
{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving,
MultiParamTypeClasses, RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
-- | An effect that enables catching exceptions thrown from
-- impure computations such as 'IO'.
--
-- Use of the 'Control.Effect.Error' effect from @Control.Effect.Error@ may lead to
-- simpler code, as well as avoiding the dynamically-typed nature of
-- 'Control.Exception'. This is best used when integrating with third-party
-- libraries that operate in 'IO'. If you are using 'catch' for resource
-- management, consider using 'Control.Effect.Resource' instead.
module Control.Effect.Catch
( Catch (..)
, catch
, catchSync
) where
import Control.Carrier
import Control.Effect.Reader
import Control.Effect.Sum
import qualified Control.Exception as Exc
import Control.Exception.Safe (isSyncException)
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
-- | @since 0.1.0.0
data Catch m k
= forall output e . Exc.Exception e => CatchIO (m output) (e -> m output) (output -> m k)
deriving instance Functor m => Functor (Catch m)
instance HFunctor Catch where
hmap f (CatchIO go cleanup k) = CatchIO (f go) (f . cleanup) (f . k)
instance Effect Catch where
handle state handler (CatchIO go cleanup k)
= CatchIO (handler (go <$ state)) (\se -> handler (cleanup se <$ state)) (handler . fmap k)
-- | Like 'Control.Effect.Error.catchError', but delegating to 'Control.Exception.catch' under the hood, which allows catching errors that might occur when lifting 'IO' computations.
--
-- Unhandled errors are rethrown. Use 'Exc.SomeException' if you want to catch all errors.
--
-- | @since 0.1.0.0
catch :: (Member Catch sig, Carrier sig m, Exc.Exception e)
=> m a
-> (e -> m a)
-> m a
catch go cleanup = send (CatchIO go cleanup pure)
-- | Like 'catch', but the handler only engages on synchronous exceptions. Async exceptions are rethrown.
--
-- | @since 0.1.0.0
catchSync :: (Member Catch sig, Carrier sig m, Exc.Exception e, MonadIO m)
=> m a
-> (e -> m a)
-> m a
catchSync f g = f `catch` \e ->
if isSyncException e
then g e
-- intentionally rethrowing an async exception synchronously,
-- since we want to preserve async behavior
else liftIO (Exc.throw e)

87
src/Control/Effect/Resource.hs
View File

@ -1,87 +0,0 @@
{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, StandaloneDeriving #-}
{- | An effect that provides a "bracket"-style function to acquire, use, and automatically release resources, in the manner of the @resourcet@ package. The 'Control.Carrier.Resource.ResourceC' carrier ensures that resources are properly released in the presence of asynchronous exceptions.
Predefined carriers:
* "Control.Carrier.Resource".
-}
module Control.Effect.Resource
( -- * Resource effect
Resource(..)
, bracket
, bracketOnError
, finally
, onException
-- * Re-exports
, Carrier
, Has
, run
) where
import Control.Carrier
-- | @since 1.0.0.0
data Resource m k
= forall resource any output . Resource (m resource) (resource -> m any) (resource -> m output) (output -> m k)
| forall resource any output . OnError (m resource) (resource -> m any) (resource -> m output) (output -> m k)
deriving instance Functor m => Functor (Resource m)
instance HFunctor Resource where
hmap f (Resource acquire release use k) = Resource (f acquire) (f . release) (f . use) (f . k)
hmap f (OnError acquire release use k) = OnError (f acquire) (f . release) (f . use) (f . k)
instance Effect Resource where
handle state handler (Resource acquire release use k) = Resource (handler (acquire <$ state)) (handler . fmap release) (handler . fmap use) (handler . fmap k)
handle state handler (OnError acquire release use k) = OnError (handler (acquire <$ state)) (handler . fmap release) (handler . fmap use) (handler . fmap k)
-- | Provides a safe idiom to acquire and release resources safely.
--
-- When acquiring and operating on a resource (such as opening and
-- reading file handle with 'openFile' or writing to a blob of memory
-- with 'malloc'), any exception thrown during the operation may mean
-- that the resource is not properly released. @bracket acquire release op@
-- ensures that @release@ is run on the value returned from @acquire@ even
-- if @op@ throws an exception.
--
-- Carriers for 'bracket' must ensure that it is safe in the presence of
-- asynchronous exceptions.
--
-- @since 1.0.0.0
bracket :: Has Resource sig m
=> m resource -- ^ computation to run first ("acquire resource")
-> (resource -> m any) -- ^ computation to run last ("release resource")
-> (resource -> m a) -- ^ computation to run in-between
-> m a
bracket acquire release use = send (Resource acquire release use pure)
-- | Like 'bracket', but only performs the final action if there was an
-- exception raised by the in-between computation.
--
-- @since 1.0.0.0
bracketOnError :: Has Resource sig m
=> m resource -- ^ computation to run first ("acquire resource")
-> (resource -> m any) -- ^ computation to run last ("release resource")
-> (resource -> m a) -- ^ computation to run in-between
-> m a
bracketOnError acquire release use = send (OnError acquire release use pure)
-- | Like 'bracket', but for the simple case of one computation to run afterward.
--
-- @since 1.0.0.0
finally :: Has Resource sig m
=> m a -- ^ computation to run first
-> m b -- ^ computation to run afterward (even if an exception was raised)
-> m a
finally act end = bracket (pure ()) (const end) (const act)
-- | Like 'bracketOnError', but for the simple case of one computation to run afterward.
--
-- @since 1.0.0.0
onException :: Has Resource sig m
=> m a -- ^ computation to run first
-> m b -- ^ computation to run afterward if an exception was raised
-> m a
onException act end = bracketOnError (pure ()) (const end) (const act)