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

fused-effects-exceptions.cabal

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

src/Control/Carrier/Catch.hs

@@ -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))

src/Control/Carrier/Resource.hs

@@ -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))

src/Control/Carrier/State/IORef.hs

@@ -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
+  ( -- * Strict state carrier
-  module Control.Effect.State
+    runState
-  -- * Strict state carrier
+  , evalState
-, runState
+  , execState
-, evalState
+  , StateC(..)
-, execState
+  -- * State effect
-, StateC(..)
+  , module Control.Effect.State
-  -- * Re-exports
+  ) where
-, Carrier
-, run
-) 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
+instance (MonadIO m, Algebra sig m, Effect sig) => Algebra (State s :+: sig) (StateC s m) where
-  askUnliftIO = StateC . ReaderC $ \r -> withUnliftIO $ \u -> pure (UnliftIO (\(StateC (ReaderC x)) -> unliftIO u (x r)))
+  alg (L act) = do
-  {-# 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
     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)))
+  alg (R other) = StateC (handleCoercible other)
-  {-# INLINE eff #-}
+  {-# INLINE alg #-}

src/Control/Effect/Catch.hs

@@ -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)

src/Control/Effect/Resource.hs

@@ -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)