{-# LANGUAGE DeriveFunctor, DerivingStrategies, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
module Control.Effect.Resumable
( -- * Resumable effect
  Resumable(..)
, throwResumable
, SomeError(..)
  -- * Resumable carriers
, runResumable
, ResumableC(..)
, runResumableWith
, ResumableWithC(..)
  -- * Re-exports
, Carrier
, Member
, run
) where

import Control.Applicative (Alternative(..))
import Control.DeepSeq
import Control.Effect.Carrier
import Control.Effect.Error
import Control.Effect.Reader
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

-- | Errors which can be resumed with values of some existentially-quantified type.
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 :: (forall x. m x -> n x) -> Resumable err m a -> Resumable err n a
hmap f :: forall x. m x -> n x
f (Resumable err :: err a
err k :: a -> m a
k) = err a -> (a -> n a) -> Resumable err n a
forall (err :: * -> *) (m :: * -> *) k a.
err a -> (a -> m k) -> Resumable err m k
Resumable err a
err (m a -> n a
forall x. m x -> n x
f (m a -> n a) -> (a -> m a) -> a -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
k)

instance Effect (Resumable err) where
  handle :: f ()
-> (forall x. f (m x) -> n (f x))
-> Resumable err m a
-> Resumable err n (f a)
handle state :: f ()
state handler :: forall x. f (m x) -> n (f x)
handler (Resumable err :: err a
err k :: a -> m a
k) = err a -> (a -> n (f a)) -> Resumable err n (f a)
forall (err :: * -> *) (m :: * -> *) k a.
err a -> (a -> m k) -> Resumable err m k
Resumable err a
err (f (m a) -> n (f a)
forall x. f (m x) -> n (f x)
handler (f (m a) -> n (f a)) -> (a -> f (m a)) -> a -> n (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m a -> f () -> f (m a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
state) (m a -> f (m a)) -> (a -> m a) -> a -> f (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
k)

-- | Throw an error which can be resumed with a value of its result type.
--
--   prop> run (runResumable (throwResumable (Identity a))) === Left (SomeError (Identity a))
throwResumable :: (Member (Resumable err) sig, Carrier sig m) => err a -> m a
throwResumable :: err a -> m a
throwResumable err :: err a
err = Resumable err m a -> m a
forall (effect :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(Member effect sig, Carrier sig m) =>
effect m a -> m a
send (err a -> (a -> m a) -> Resumable err m a
forall (err :: * -> *) (m :: * -> *) k a.
err a -> (a -> m k) -> Resumable err m k
Resumable err a
err a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)


-- | 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.
--
--   prop> SomeError (Identity a) === SomeError (Identity b)
--   prop> (SomeError (Const a) === SomeError (Const b)) == (a == b)
instance Eq1 err => Eq (SomeError err) where
  SomeError exc1 :: err a
exc1 == :: SomeError err -> SomeError err -> Bool
== SomeError exc2 :: err a
exc2 = (a -> a -> Bool) -> err a -> err a -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> Bool) -> a -> a -> Bool
forall a b. a -> b -> a
const (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)) err a
exc1 err a
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.
--
--   prop> (SomeError (Identity a) `compare` SomeError (Identity b)) === EQ
--   prop> (SomeError (Const a) `compare` SomeError (Const b)) === (a `compare` b)
instance Ord1 err => Ord (SomeError err) where
  SomeError exc1 :: err a
exc1 compare :: SomeError err -> SomeError err -> Ordering
`compare` SomeError exc2 :: err a
exc2 = (a -> a -> Ordering) -> err a -> err a -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> Ordering) -> a -> a -> Ordering
forall a b. a -> b -> a
const (Ordering -> a -> Ordering
forall a b. a -> b -> a
const Ordering
EQ)) err a
exc1 err a
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.
--
--   prop> show (SomeError (Identity a)) === "SomeError (Identity )"
--   prop> show (SomeError (Const a)) === ("SomeError (Const " ++ showsPrec 11 a ")")
instance Show1 err => Show (SomeError err) where
  showsPrec :: Int -> SomeError err -> ShowS
showsPrec d :: Int
d (SomeError err :: err a
err) = (Int -> err a -> ShowS) -> String -> Int -> err a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> err a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec ((a -> ShowS) -> Int -> a -> ShowS
forall a b. a -> b -> a
const (ShowS -> a -> ShowS
forall a b. a -> b -> a
const ShowS
forall a. a -> a
id)) (ShowS -> [a] -> ShowS
forall a b. a -> b -> a
const ShowS
forall a. a -> a
id)) "SomeError" Int
d err a
err


-- | Evaluation of 'SomeError' to normal forms is determined by a 'NFData1' instance for the error type.
--
--   prop> pure (rnf (SomeError (Identity (error "error"))) :: SomeError Identity) `shouldThrow` errorCall "error"
instance NFData1 err => NFData (SomeError err) where
  rnf :: SomeError err -> ()
rnf (SomeError err :: err a
err) = (a -> ()) -> err a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf (\a :: a
a -> a -> () -> ()
forall a b. a -> b -> b
seq a
a ()) err a
err


-- | Run a 'Resumable' effect, returning uncaught errors in 'Left' and successful computations’ values in 'Right'.
--
--   prop> run (runResumable (pure a)) === Right @(SomeError Identity) @Int a
runResumable :: ResumableC err m a -> m (Either (SomeError err) a)
runResumable :: ResumableC err m a -> m (Either (SomeError err) a)
runResumable = ErrorC (SomeError err) m a -> m (Either (SomeError err) a)
forall exc (m :: * -> *) a. ErrorC exc m a -> m (Either exc a)
runError (ErrorC (SomeError err) m a -> m (Either (SomeError err) a))
-> (ResumableC err m a -> ErrorC (SomeError err) m a)
-> ResumableC err m a
-> m (Either (SomeError err) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResumableC err m a -> ErrorC (SomeError err) m a
forall (err :: * -> *) (m :: * -> *) a.
ResumableC err m a -> ErrorC (SomeError err) m a
runResumableC

newtype ResumableC err m a = ResumableC { ResumableC err m a -> ErrorC (SomeError err) m a
runResumableC :: ErrorC (SomeError err) m a }
  deriving newtype (Applicative (ResumableC err m)
ResumableC err m a
Applicative (ResumableC err m) =>
(forall a. ResumableC err m a)
-> (forall a.
    ResumableC err m a -> ResumableC err m a -> ResumableC err m a)
-> (forall a. ResumableC err m a -> ResumableC err m [a])
-> (forall a. ResumableC err m a -> ResumableC err m [a])
-> Alternative (ResumableC err m)
ResumableC err m a -> ResumableC err m a -> ResumableC err m a
ResumableC err m a -> ResumableC err m [a]
ResumableC err m a -> ResumableC err m [a]
forall a. ResumableC err m a
forall a. ResumableC err m a -> ResumableC err m [a]
forall a.
ResumableC err m a -> ResumableC err m a -> ResumableC err m a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (err :: * -> *) (m :: * -> *).
Alternative m =>
Applicative (ResumableC err m)
forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableC err m a
forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableC err m a -> ResumableC err m [a]
forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableC err m a -> ResumableC err m a -> ResumableC err m a
many :: ResumableC err m a -> ResumableC err m [a]
$cmany :: forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableC err m a -> ResumableC err m [a]
some :: ResumableC err m a -> ResumableC err m [a]
$csome :: forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableC err m a -> ResumableC err m [a]
<|> :: ResumableC err m a -> ResumableC err m a -> ResumableC err m a
$c<|> :: forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableC err m a -> ResumableC err m a -> ResumableC err m a
empty :: ResumableC err m a
$cempty :: forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableC err m a
$cp1Alternative :: forall (err :: * -> *) (m :: * -> *).
Alternative m =>
Applicative (ResumableC err m)
Alternative, Functor (ResumableC err m)
a -> ResumableC err m a
Functor (ResumableC err m) =>
(forall a. a -> ResumableC err m a)
-> (forall a b.
    ResumableC err m (a -> b)
    -> ResumableC err m a -> ResumableC err m b)
-> (forall a b c.
    (a -> b -> c)
    -> ResumableC err m a -> ResumableC err m b -> ResumableC err m c)
-> (forall a b.
    ResumableC err m a -> ResumableC err m b -> ResumableC err m b)
-> (forall a b.
    ResumableC err m a -> ResumableC err m b -> ResumableC err m a)
-> Applicative (ResumableC err m)
ResumableC err m a -> ResumableC err m b -> ResumableC err m b
ResumableC err m a -> ResumableC err m b -> ResumableC err m a
ResumableC err m (a -> b)
-> ResumableC err m a -> ResumableC err m b
(a -> b -> c)
-> ResumableC err m a -> ResumableC err m b -> ResumableC err m c
forall a. a -> ResumableC err m a
forall a b.
ResumableC err m a -> ResumableC err m b -> ResumableC err m a
forall a b.
ResumableC err m a -> ResumableC err m b -> ResumableC err m b
forall a b.
ResumableC err m (a -> b)
-> ResumableC err m a -> ResumableC err m b
forall a b c.
(a -> b -> c)
-> ResumableC err m a -> ResumableC err m b -> ResumableC err m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (err :: * -> *) (m :: * -> *).
Applicative m =>
Functor (ResumableC err m)
forall (err :: * -> *) (m :: * -> *) a.
Applicative m =>
a -> ResumableC err m a
forall (err :: * -> *) (m :: * -> *) a b.
Applicative m =>
ResumableC err m a -> ResumableC err m b -> ResumableC err m a
forall (err :: * -> *) (m :: * -> *) a b.
Applicative m =>
ResumableC err m a -> ResumableC err m b -> ResumableC err m b
forall (err :: * -> *) (m :: * -> *) a b.
Applicative m =>
ResumableC err m (a -> b)
-> ResumableC err m a -> ResumableC err m b
forall (err :: * -> *) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ResumableC err m a -> ResumableC err m b -> ResumableC err m c
<* :: ResumableC err m a -> ResumableC err m b -> ResumableC err m a
$c<* :: forall (err :: * -> *) (m :: * -> *) a b.
Applicative m =>
ResumableC err m a -> ResumableC err m b -> ResumableC err m a
*> :: ResumableC err m a -> ResumableC err m b -> ResumableC err m b
$c*> :: forall (err :: * -> *) (m :: * -> *) a b.
Applicative m =>
ResumableC err m a -> ResumableC err m b -> ResumableC err m b
liftA2 :: (a -> b -> c)
-> ResumableC err m a -> ResumableC err m b -> ResumableC err m c
$cliftA2 :: forall (err :: * -> *) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ResumableC err m a -> ResumableC err m b -> ResumableC err m c
<*> :: ResumableC err m (a -> b)
-> ResumableC err m a -> ResumableC err m b
$c<*> :: forall (err :: * -> *) (m :: * -> *) a b.
Applicative m =>
ResumableC err m (a -> b)
-> ResumableC err m a -> ResumableC err m b
pure :: a -> ResumableC err m a
$cpure :: forall (err :: * -> *) (m :: * -> *) a.
Applicative m =>
a -> ResumableC err m a
$cp1Applicative :: forall (err :: * -> *) (m :: * -> *).
Applicative m =>
Functor (ResumableC err m)
Applicative, a -> ResumableC err m b -> ResumableC err m a
(a -> b) -> ResumableC err m a -> ResumableC err m b
(forall a b. (a -> b) -> ResumableC err m a -> ResumableC err m b)
-> (forall a b. a -> ResumableC err m b -> ResumableC err m a)
-> Functor (ResumableC err m)
forall a b. a -> ResumableC err m b -> ResumableC err m a
forall a b. (a -> b) -> ResumableC err m a -> ResumableC err m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (err :: * -> *) (m :: * -> *) a b.
Functor m =>
a -> ResumableC err m b -> ResumableC err m a
forall (err :: * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> ResumableC err m a -> ResumableC err m b
<$ :: a -> ResumableC err m b -> ResumableC err m a
$c<$ :: forall (err :: * -> *) (m :: * -> *) a b.
Functor m =>
a -> ResumableC err m b -> ResumableC err m a
fmap :: (a -> b) -> ResumableC err m a -> ResumableC err m b
$cfmap :: forall (err :: * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> ResumableC err m a -> ResumableC err m b
Functor, Applicative (ResumableC err m)
a -> ResumableC err m a
Applicative (ResumableC err m) =>
(forall a b.
 ResumableC err m a
 -> (a -> ResumableC err m b) -> ResumableC err m b)
-> (forall a b.
    ResumableC err m a -> ResumableC err m b -> ResumableC err m b)
-> (forall a. a -> ResumableC err m a)
-> Monad (ResumableC err m)
ResumableC err m a
-> (a -> ResumableC err m b) -> ResumableC err m b
ResumableC err m a -> ResumableC err m b -> ResumableC err m b
forall a. a -> ResumableC err m a
forall a b.
ResumableC err m a -> ResumableC err m b -> ResumableC err m b
forall a b.
ResumableC err m a
-> (a -> ResumableC err m b) -> ResumableC err m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (err :: * -> *) (m :: * -> *).
Monad m =>
Applicative (ResumableC err m)
forall (err :: * -> *) (m :: * -> *) a.
Monad m =>
a -> ResumableC err m a
forall (err :: * -> *) (m :: * -> *) a b.
Monad m =>
ResumableC err m a -> ResumableC err m b -> ResumableC err m b
forall (err :: * -> *) (m :: * -> *) a b.
Monad m =>
ResumableC err m a
-> (a -> ResumableC err m b) -> ResumableC err m b
return :: a -> ResumableC err m a
$creturn :: forall (err :: * -> *) (m :: * -> *) a.
Monad m =>
a -> ResumableC err m a
>> :: ResumableC err m a -> ResumableC err m b -> ResumableC err m b
$c>> :: forall (err :: * -> *) (m :: * -> *) a b.
Monad m =>
ResumableC err m a -> ResumableC err m b -> ResumableC err m b
>>= :: ResumableC err m a
-> (a -> ResumableC err m b) -> ResumableC err m b
$c>>= :: forall (err :: * -> *) (m :: * -> *) a b.
Monad m =>
ResumableC err m a
-> (a -> ResumableC err m b) -> ResumableC err m b
$cp1Monad :: forall (err :: * -> *) (m :: * -> *).
Monad m =>
Applicative (ResumableC err m)
Monad, Monad (ResumableC err m)
Monad (ResumableC err m) =>
(forall a. String -> ResumableC err m a)
-> MonadFail (ResumableC err m)
String -> ResumableC err m a
forall a. String -> ResumableC err m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
forall (err :: * -> *) (m :: * -> *).
MonadFail m =>
Monad (ResumableC err m)
forall (err :: * -> *) (m :: * -> *) a.
MonadFail m =>
String -> ResumableC err m a
fail :: String -> ResumableC err m a
$cfail :: forall (err :: * -> *) (m :: * -> *) a.
MonadFail m =>
String -> ResumableC err m a
$cp1MonadFail :: forall (err :: * -> *) (m :: * -> *).
MonadFail m =>
Monad (ResumableC err m)
Fail.MonadFail, Monad (ResumableC err m)
Monad (ResumableC err m) =>
(forall a. (a -> ResumableC err m a) -> ResumableC err m a)
-> MonadFix (ResumableC err m)
(a -> ResumableC err m a) -> ResumableC err m a
forall a. (a -> ResumableC err m a) -> ResumableC err m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
forall (err :: * -> *) (m :: * -> *).
MonadFix m =>
Monad (ResumableC err m)
forall (err :: * -> *) (m :: * -> *) a.
MonadFix m =>
(a -> ResumableC err m a) -> ResumableC err m a
mfix :: (a -> ResumableC err m a) -> ResumableC err m a
$cmfix :: forall (err :: * -> *) (m :: * -> *) a.
MonadFix m =>
(a -> ResumableC err m a) -> ResumableC err m a
$cp1MonadFix :: forall (err :: * -> *) (m :: * -> *).
MonadFix m =>
Monad (ResumableC err m)
MonadFix, Monad (ResumableC err m)
Monad (ResumableC err m) =>
(forall a. IO a -> ResumableC err m a)
-> MonadIO (ResumableC err m)
IO a -> ResumableC err m a
forall a. IO a -> ResumableC err m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (err :: * -> *) (m :: * -> *).
MonadIO m =>
Monad (ResumableC err m)
forall (err :: * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> ResumableC err m a
liftIO :: IO a -> ResumableC err m a
$cliftIO :: forall (err :: * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> ResumableC err m a
$cp1MonadIO :: forall (err :: * -> *) (m :: * -> *).
MonadIO m =>
Monad (ResumableC err m)
MonadIO, Monad (ResumableC err m)
Alternative (ResumableC err m)
ResumableC err m a
(Alternative (ResumableC err m), Monad (ResumableC err m)) =>
(forall a. ResumableC err m a)
-> (forall a.
    ResumableC err m a -> ResumableC err m a -> ResumableC err m a)
-> MonadPlus (ResumableC err m)
ResumableC err m a -> ResumableC err m a -> ResumableC err m a
forall a. ResumableC err m a
forall a.
ResumableC err m a -> ResumableC err m a -> ResumableC err m a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
forall (err :: * -> *) (m :: * -> *).
(Alternative m, Monad m) =>
Monad (ResumableC err m)
forall (err :: * -> *) (m :: * -> *).
(Alternative m, Monad m) =>
Alternative (ResumableC err m)
forall (err :: * -> *) (m :: * -> *) a.
(Alternative m, Monad m) =>
ResumableC err m a
forall (err :: * -> *) (m :: * -> *) a.
(Alternative m, Monad m) =>
ResumableC err m a -> ResumableC err m a -> ResumableC err m a
mplus :: ResumableC err m a -> ResumableC err m a -> ResumableC err m a
$cmplus :: forall (err :: * -> *) (m :: * -> *) a.
(Alternative m, Monad m) =>
ResumableC err m a -> ResumableC err m a -> ResumableC err m a
mzero :: ResumableC err m a
$cmzero :: forall (err :: * -> *) (m :: * -> *) a.
(Alternative m, Monad m) =>
ResumableC err m a
$cp2MonadPlus :: forall (err :: * -> *) (m :: * -> *).
(Alternative m, Monad m) =>
Monad (ResumableC err m)
$cp1MonadPlus :: forall (err :: * -> *) (m :: * -> *).
(Alternative m, Monad m) =>
Alternative (ResumableC err m)
MonadPlus, m a -> ResumableC err m a
(forall (m :: * -> *) a. Monad m => m a -> ResumableC err m a)
-> MonadTrans (ResumableC err)
forall (m :: * -> *) a. Monad m => m a -> ResumableC err m a
forall (err :: * -> *) (m :: * -> *) a.
Monad m =>
m a -> ResumableC err m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ResumableC err m a
$clift :: forall (err :: * -> *) (m :: * -> *) a.
Monad m =>
m a -> ResumableC err m a
MonadTrans)

instance (Carrier sig m, Effect sig) => Carrier (Resumable err :+: sig) (ResumableC err m) where
  eff :: (:+:) (Resumable err) sig (ResumableC err m) a
-> ResumableC err m a
eff (L (Resumable err :: err a
err _)) = ErrorC (SomeError err) m a -> ResumableC err m a
forall (err :: * -> *) (m :: * -> *) a.
ErrorC (SomeError err) m a -> ResumableC err m a
ResumableC (SomeError err -> ErrorC (SomeError err) m a
forall exc (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Member (Error exc) sig, Carrier sig m) =>
exc -> m a
throwError (err a -> SomeError err
forall (err :: * -> *) a. err a -> SomeError err
SomeError err a
err))
  eff (R other :: sig (ResumableC err m) a
other)             = ErrorC (SomeError err) m a -> ResumableC err m a
forall (err :: * -> *) (m :: * -> *) a.
ErrorC (SomeError err) m a -> ResumableC err m a
ResumableC ((:+:) (Error (SomeError err)) sig (ErrorC (SomeError err) m) a
-> ErrorC (SomeError err) m a
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Carrier sig m =>
sig m a -> m a
eff (sig (ErrorC (SomeError err) m) a
-> (:+:) (Error (SomeError err)) sig (ErrorC (SomeError err) m) a
forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) k.
g m k -> (:+:) f g m k
R (sig (ResumableC err m) a -> sig (ErrorC (SomeError err) m) a
forall (sig :: (* -> *) -> * -> *) (f :: * -> *) (g :: * -> *) a.
(HFunctor sig, Functor f, Coercible f g) =>
sig f a -> sig g a
handleCoercible sig (ResumableC err m) a
other)))
  {-# INLINE eff #-}


-- | 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.
--
--   >>> data Err a where Err :: Int -> Err Int
--
--   prop> run (runResumableWith (\ (Err b) -> pure (1 + b)) (pure a)) === a
--   prop> run (runResumableWith (\ (Err b) -> pure (1 + b)) (throwResumable (Err a))) === 1 + a
runResumableWith :: (forall x . err x -> m x)
                 -> ResumableWithC err m a
                 -> m a
runResumableWith :: (forall x. err x -> m x) -> ResumableWithC err m a -> m a
runResumableWith with :: forall x. err x -> m x
with = Handler err m -> ReaderC (Handler err m) m a -> m a
forall r (m :: * -> *) a. r -> ReaderC r m a -> m a
runReader ((forall x. err x -> m x) -> Handler err m
forall (err :: * -> *) (m :: * -> *).
(forall x. err x -> m x) -> Handler err m
Handler forall x. err x -> m x
with) (ReaderC (Handler err m) m a -> m a)
-> (ResumableWithC err m a -> ReaderC (Handler err m) m a)
-> ResumableWithC err m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResumableWithC err m a -> ReaderC (Handler err m) m a
forall (err :: * -> *) (m :: * -> *) a.
ResumableWithC err m a -> ReaderC (Handler err m) m a
runResumableWithC

newtype ResumableWithC err m a = ResumableWithC { ResumableWithC err m a -> ReaderC (Handler err m) m a
runResumableWithC :: ReaderC (Handler err m) m a }
  deriving newtype (Applicative (ResumableWithC err m)
ResumableWithC err m a
Applicative (ResumableWithC err m) =>
(forall a. ResumableWithC err m a)
-> (forall a.
    ResumableWithC err m a
    -> ResumableWithC err m a -> ResumableWithC err m a)
-> (forall a. ResumableWithC err m a -> ResumableWithC err m [a])
-> (forall a. ResumableWithC err m a -> ResumableWithC err m [a])
-> Alternative (ResumableWithC err m)
ResumableWithC err m a
-> ResumableWithC err m a -> ResumableWithC err m a
ResumableWithC err m a -> ResumableWithC err m [a]
ResumableWithC err m a -> ResumableWithC err m [a]
forall a. ResumableWithC err m a
forall a. ResumableWithC err m a -> ResumableWithC err m [a]
forall a.
ResumableWithC err m a
-> ResumableWithC err m a -> ResumableWithC err m a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (err :: * -> *) (m :: * -> *).
Alternative m =>
Applicative (ResumableWithC err m)
forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableWithC err m a
forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableWithC err m a -> ResumableWithC err m [a]
forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableWithC err m a
-> ResumableWithC err m a -> ResumableWithC err m a
many :: ResumableWithC err m a -> ResumableWithC err m [a]
$cmany :: forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableWithC err m a -> ResumableWithC err m [a]
some :: ResumableWithC err m a -> ResumableWithC err m [a]
$csome :: forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableWithC err m a -> ResumableWithC err m [a]
<|> :: ResumableWithC err m a
-> ResumableWithC err m a -> ResumableWithC err m a
$c<|> :: forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableWithC err m a
-> ResumableWithC err m a -> ResumableWithC err m a
empty :: ResumableWithC err m a
$cempty :: forall (err :: * -> *) (m :: * -> *) a.
Alternative m =>
ResumableWithC err m a
$cp1Alternative :: forall (err :: * -> *) (m :: * -> *).
Alternative m =>
Applicative (ResumableWithC err m)
Alternative, Functor (ResumableWithC err m)
a -> ResumableWithC err m a
Functor (ResumableWithC err m) =>
(forall a. a -> ResumableWithC err m a)
-> (forall a b.
    ResumableWithC err m (a -> b)
    -> ResumableWithC err m a -> ResumableWithC err m b)
-> (forall a b c.
    (a -> b -> c)
    -> ResumableWithC err m a
    -> ResumableWithC err m b
    -> ResumableWithC err m c)
-> (forall a b.
    ResumableWithC err m a
    -> ResumableWithC err m b -> ResumableWithC err m b)
-> (forall a b.
    ResumableWithC err m a
    -> ResumableWithC err m b -> ResumableWithC err m a)
-> Applicative (ResumableWithC err m)
ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m b
ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m a
ResumableWithC err m (a -> b)
-> ResumableWithC err m a -> ResumableWithC err m b
(a -> b -> c)
-> ResumableWithC err m a
-> ResumableWithC err m b
-> ResumableWithC err m c
forall a. a -> ResumableWithC err m a
forall a b.
ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m a
forall a b.
ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m b
forall a b.
ResumableWithC err m (a -> b)
-> ResumableWithC err m a -> ResumableWithC err m b
forall a b c.
(a -> b -> c)
-> ResumableWithC err m a
-> ResumableWithC err m b
-> ResumableWithC err m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (err :: * -> *) (m :: * -> *).
Applicative m =>
Functor (ResumableWithC err m)
forall (err :: * -> *) (m :: * -> *) a.
Applicative m =>
a -> ResumableWithC err m a
forall (err :: * -> *) (m :: * -> *) a b.
Applicative m =>
ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m a
forall (err :: * -> *) (m :: * -> *) a b.
Applicative m =>
ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m b
forall (err :: * -> *) (m :: * -> *) a b.
Applicative m =>
ResumableWithC err m (a -> b)
-> ResumableWithC err m a -> ResumableWithC err m b
forall (err :: * -> *) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ResumableWithC err m a
-> ResumableWithC err m b
-> ResumableWithC err m c
<* :: ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m a
$c<* :: forall (err :: * -> *) (m :: * -> *) a b.
Applicative m =>
ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m a
*> :: ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m b
$c*> :: forall (err :: * -> *) (m :: * -> *) a b.
Applicative m =>
ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m b
liftA2 :: (a -> b -> c)
-> ResumableWithC err m a
-> ResumableWithC err m b
-> ResumableWithC err m c
$cliftA2 :: forall (err :: * -> *) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ResumableWithC err m a
-> ResumableWithC err m b
-> ResumableWithC err m c
<*> :: ResumableWithC err m (a -> b)
-> ResumableWithC err m a -> ResumableWithC err m b
$c<*> :: forall (err :: * -> *) (m :: * -> *) a b.
Applicative m =>
ResumableWithC err m (a -> b)
-> ResumableWithC err m a -> ResumableWithC err m b
pure :: a -> ResumableWithC err m a
$cpure :: forall (err :: * -> *) (m :: * -> *) a.
Applicative m =>
a -> ResumableWithC err m a
$cp1Applicative :: forall (err :: * -> *) (m :: * -> *).
Applicative m =>
Functor (ResumableWithC err m)
Applicative, a -> ResumableWithC err m b -> ResumableWithC err m a
(a -> b) -> ResumableWithC err m a -> ResumableWithC err m b
(forall a b.
 (a -> b) -> ResumableWithC err m a -> ResumableWithC err m b)
-> (forall a b.
    a -> ResumableWithC err m b -> ResumableWithC err m a)
-> Functor (ResumableWithC err m)
forall a b. a -> ResumableWithC err m b -> ResumableWithC err m a
forall a b.
(a -> b) -> ResumableWithC err m a -> ResumableWithC err m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (err :: * -> *) (m :: * -> *) a b.
Functor m =>
a -> ResumableWithC err m b -> ResumableWithC err m a
forall (err :: * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> ResumableWithC err m a -> ResumableWithC err m b
<$ :: a -> ResumableWithC err m b -> ResumableWithC err m a
$c<$ :: forall (err :: * -> *) (m :: * -> *) a b.
Functor m =>
a -> ResumableWithC err m b -> ResumableWithC err m a
fmap :: (a -> b) -> ResumableWithC err m a -> ResumableWithC err m b
$cfmap :: forall (err :: * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> ResumableWithC err m a -> ResumableWithC err m b
Functor, Applicative (ResumableWithC err m)
a -> ResumableWithC err m a
Applicative (ResumableWithC err m) =>
(forall a b.
 ResumableWithC err m a
 -> (a -> ResumableWithC err m b) -> ResumableWithC err m b)
-> (forall a b.
    ResumableWithC err m a
    -> ResumableWithC err m b -> ResumableWithC err m b)
-> (forall a. a -> ResumableWithC err m a)
-> Monad (ResumableWithC err m)
ResumableWithC err m a
-> (a -> ResumableWithC err m b) -> ResumableWithC err m b
ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m b
forall a. a -> ResumableWithC err m a
forall a b.
ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m b
forall a b.
ResumableWithC err m a
-> (a -> ResumableWithC err m b) -> ResumableWithC err m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (err :: * -> *) (m :: * -> *).
Monad m =>
Applicative (ResumableWithC err m)
forall (err :: * -> *) (m :: * -> *) a.
Monad m =>
a -> ResumableWithC err m a
forall (err :: * -> *) (m :: * -> *) a b.
Monad m =>
ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m b
forall (err :: * -> *) (m :: * -> *) a b.
Monad m =>
ResumableWithC err m a
-> (a -> ResumableWithC err m b) -> ResumableWithC err m b
return :: a -> ResumableWithC err m a
$creturn :: forall (err :: * -> *) (m :: * -> *) a.
Monad m =>
a -> ResumableWithC err m a
>> :: ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m b
$c>> :: forall (err :: * -> *) (m :: * -> *) a b.
Monad m =>
ResumableWithC err m a
-> ResumableWithC err m b -> ResumableWithC err m b
>>= :: ResumableWithC err m a
-> (a -> ResumableWithC err m b) -> ResumableWithC err m b
$c>>= :: forall (err :: * -> *) (m :: * -> *) a b.
Monad m =>
ResumableWithC err m a
-> (a -> ResumableWithC err m b) -> ResumableWithC err m b
$cp1Monad :: forall (err :: * -> *) (m :: * -> *).
Monad m =>
Applicative (ResumableWithC err m)
Monad, Monad (ResumableWithC err m)
Monad (ResumableWithC err m) =>
(forall a. String -> ResumableWithC err m a)
-> MonadFail (ResumableWithC err m)
String -> ResumableWithC err m a
forall a. String -> ResumableWithC err m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
forall (err :: * -> *) (m :: * -> *).
MonadFail m =>
Monad (ResumableWithC err m)
forall (err :: * -> *) (m :: * -> *) a.
MonadFail m =>
String -> ResumableWithC err m a
fail :: String -> ResumableWithC err m a
$cfail :: forall (err :: * -> *) (m :: * -> *) a.
MonadFail m =>
String -> ResumableWithC err m a
$cp1MonadFail :: forall (err :: * -> *) (m :: * -> *).
MonadFail m =>
Monad (ResumableWithC err m)
Fail.MonadFail, Monad (ResumableWithC err m)
Monad (ResumableWithC err m) =>
(forall a. (a -> ResumableWithC err m a) -> ResumableWithC err m a)
-> MonadFix (ResumableWithC err m)
(a -> ResumableWithC err m a) -> ResumableWithC err m a
forall a. (a -> ResumableWithC err m a) -> ResumableWithC err m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
forall (err :: * -> *) (m :: * -> *).
MonadFix m =>
Monad (ResumableWithC err m)
forall (err :: * -> *) (m :: * -> *) a.
MonadFix m =>
(a -> ResumableWithC err m a) -> ResumableWithC err m a
mfix :: (a -> ResumableWithC err m a) -> ResumableWithC err m a
$cmfix :: forall (err :: * -> *) (m :: * -> *) a.
MonadFix m =>
(a -> ResumableWithC err m a) -> ResumableWithC err m a
$cp1MonadFix :: forall (err :: * -> *) (m :: * -> *).
MonadFix m =>
Monad (ResumableWithC err m)
MonadFix, Monad (ResumableWithC err m)
Monad (ResumableWithC err m) =>
(forall a. IO a -> ResumableWithC err m a)
-> MonadIO (ResumableWithC err m)
IO a -> ResumableWithC err m a
forall a. IO a -> ResumableWithC err m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (err :: * -> *) (m :: * -> *).
MonadIO m =>
Monad (ResumableWithC err m)
forall (err :: * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> ResumableWithC err m a
liftIO :: IO a -> ResumableWithC err m a
$cliftIO :: forall (err :: * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> ResumableWithC err m a
$cp1MonadIO :: forall (err :: * -> *) (m :: * -> *).
MonadIO m =>
Monad (ResumableWithC err m)
MonadIO, Monad (ResumableWithC err m)
Alternative (ResumableWithC err m)
ResumableWithC err m a
(Alternative (ResumableWithC err m),
 Monad (ResumableWithC err m)) =>
(forall a. ResumableWithC err m a)
-> (forall a.
    ResumableWithC err m a
    -> ResumableWithC err m a -> ResumableWithC err m a)
-> MonadPlus (ResumableWithC err m)
ResumableWithC err m a
-> ResumableWithC err m a -> ResumableWithC err m a
forall a. ResumableWithC err m a
forall a.
ResumableWithC err m a
-> ResumableWithC err m a -> ResumableWithC err m a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
forall (err :: * -> *) (m :: * -> *).
(Alternative m, Monad m) =>
Monad (ResumableWithC err m)
forall (err :: * -> *) (m :: * -> *).
(Alternative m, Monad m) =>
Alternative (ResumableWithC err m)
forall (err :: * -> *) (m :: * -> *) a.
(Alternative m, Monad m) =>
ResumableWithC err m a
forall (err :: * -> *) (m :: * -> *) a.
(Alternative m, Monad m) =>
ResumableWithC err m a
-> ResumableWithC err m a -> ResumableWithC err m a
mplus :: ResumableWithC err m a
-> ResumableWithC err m a -> ResumableWithC err m a
$cmplus :: forall (err :: * -> *) (m :: * -> *) a.
(Alternative m, Monad m) =>
ResumableWithC err m a
-> ResumableWithC err m a -> ResumableWithC err m a
mzero :: ResumableWithC err m a
$cmzero :: forall (err :: * -> *) (m :: * -> *) a.
(Alternative m, Monad m) =>
ResumableWithC err m a
$cp2MonadPlus :: forall (err :: * -> *) (m :: * -> *).
(Alternative m, Monad m) =>
Monad (ResumableWithC err m)
$cp1MonadPlus :: forall (err :: * -> *) (m :: * -> *).
(Alternative m, Monad m) =>
Alternative (ResumableWithC err m)
MonadPlus)

instance MonadTrans (ResumableWithC err) where
  lift :: m a -> ResumableWithC err m a
lift = ReaderC (Handler err m) m a -> ResumableWithC err m a
forall (err :: * -> *) (m :: * -> *) a.
ReaderC (Handler err m) m a -> ResumableWithC err m a
ResumableWithC (ReaderC (Handler err m) m a -> ResumableWithC err m a)
-> (m a -> ReaderC (Handler err m) m a)
-> m a
-> ResumableWithC err m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderC (Handler err m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
  {-# INLINE lift #-}

newtype Handler err m = Handler { Handler err m -> forall x. err x -> m x
runHandler :: forall x . err x -> m x }

instance Carrier sig m => Carrier (Resumable err :+: sig) (ResumableWithC err m) where
  eff :: (:+:) (Resumable err) sig (ResumableWithC err m) a
-> ResumableWithC err m a
eff (L (Resumable err :: err a
err k :: a -> ResumableWithC err m a
k)) = ReaderC (Handler err m) m a -> ResumableWithC err m a
forall (err :: * -> *) (m :: * -> *) a.
ReaderC (Handler err m) m a -> ResumableWithC err m a
ResumableWithC ((Handler err m -> m a) -> ReaderC (Handler err m) m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC (\ handler :: Handler err m
handler -> Handler err m -> err a -> m a
forall (err :: * -> *) (m :: * -> *).
Handler err m -> forall x. err x -> m x
runHandler Handler err m
handler err a
err)) ResumableWithC err m a
-> (a -> ResumableWithC err m a) -> ResumableWithC err m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ResumableWithC err m a
k
  eff (R other :: sig (ResumableWithC err m) a
other)             = ReaderC (Handler err m) m a -> ResumableWithC err m a
forall (err :: * -> *) (m :: * -> *) a.
ReaderC (Handler err m) m a -> ResumableWithC err m a
ResumableWithC ((:+:) (Reader (Handler err m)) sig (ReaderC (Handler err m) m) a
-> ReaderC (Handler err m) m a
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Carrier sig m =>
sig m a -> m a
eff (sig (ReaderC (Handler err m) m) a
-> (:+:) (Reader (Handler err m)) sig (ReaderC (Handler err m) m) a
forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) k.
g m k -> (:+:) f g m k
R (sig (ResumableWithC err m) a -> sig (ReaderC (Handler err m) m) a
forall (sig :: (* -> *) -> * -> *) (f :: * -> *) (g :: * -> *) a.
(HFunctor sig, Functor f, Coercible f g) =>
sig f a -> sig g a
handleCoercible sig (ResumableWithC err m) a
other)))
  {-# INLINE eff #-}


-- $setup
-- >>> :seti -XFlexibleContexts
-- >>> :seti -XGADTs
-- >>> :seti -XTypeApplications
-- >>> import Test.QuickCheck
-- >>> import Control.Effect.Pure
-- >>> import Data.Functor.Const
-- >>> import Data.Functor.Identity