Excise basically the whole project in favor of Control.Effect.Exc.
Patrick Thomson
parent
a39a61861d
commit
d672693b27
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
@ -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))
|
||||
|
|
@ -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
|
||||
, evalState
|
||||
, execState
|
||||
, StateC(..)
|
||||
-- * Re-exports
|
||||
, Carrier
|
||||
, run
|
||||
) where
|
||||
( -- * Strict state carrier
|
||||
runState
|
||||
, evalState
|
||||
, execState
|
||||
, StateC(..)
|
||||
-- * 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 #-}
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
@ -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)
|
||||
Loading…
Reference in New Issue