{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_HADDOCK not-home #-}
module Control.Effect.Carrier.Internal.Stepped where
import Data.Coerce
import Control.Applicative
import Control.Monad.Trans
import Control.Monad.Trans.Free.Church.Alternate
import Control.Effect.Internal
import Control.Effect.Internal.Utils
import Control.Effect.Internal.Membership
import Control.Effect.Internal.Derive
import Control.Effect.Internal.Union
data FOEff e x where
FOEff :: e q x -> FOEff e x
class (forall m n x. Coercible (e m x) (e n x))
=> FirstOrder (e :: Effect)
instance (forall m n x. Coercible (e m x) (e n x))
=> FirstOrder e
newtype SteppedC (e :: Effect) m a = SteppedC {
SteppedC e m a -> FreeT (FOEff e) m a
unSteppedC :: FreeT (FOEff e) m a
}
deriving ( a -> SteppedC e m b -> SteppedC e m a
(a -> b) -> SteppedC e m a -> SteppedC e m b
(forall a b. (a -> b) -> SteppedC e m a -> SteppedC e m b)
-> (forall a b. a -> SteppedC e m b -> SteppedC e m a)
-> Functor (SteppedC e m)
forall a b. a -> SteppedC e m b -> SteppedC e m a
forall a b. (a -> b) -> SteppedC e m a -> SteppedC e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (e :: Effect) (m :: * -> *) a b.
a -> SteppedC e m b -> SteppedC e m a
forall (e :: Effect) (m :: * -> *) a b.
(a -> b) -> SteppedC e m a -> SteppedC e m b
<$ :: a -> SteppedC e m b -> SteppedC e m a
$c<$ :: forall (e :: Effect) (m :: * -> *) a b.
a -> SteppedC e m b -> SteppedC e m a
fmap :: (a -> b) -> SteppedC e m a -> SteppedC e m b
$cfmap :: forall (e :: Effect) (m :: * -> *) a b.
(a -> b) -> SteppedC e m a -> SteppedC e m b
Functor, Functor (SteppedC e m)
a -> SteppedC e m a
Functor (SteppedC e m)
-> (forall a. a -> SteppedC e m a)
-> (forall a b.
SteppedC e m (a -> b) -> SteppedC e m a -> SteppedC e m b)
-> (forall a b c.
(a -> b -> c)
-> SteppedC e m a -> SteppedC e m b -> SteppedC e m c)
-> (forall a b. SteppedC e m a -> SteppedC e m b -> SteppedC e m b)
-> (forall a b. SteppedC e m a -> SteppedC e m b -> SteppedC e m a)
-> Applicative (SteppedC e m)
SteppedC e m a -> SteppedC e m b -> SteppedC e m b
SteppedC e m a -> SteppedC e m b -> SteppedC e m a
SteppedC e m (a -> b) -> SteppedC e m a -> SteppedC e m b
(a -> b -> c) -> SteppedC e m a -> SteppedC e m b -> SteppedC e m c
forall a. a -> SteppedC e m a
forall a b. SteppedC e m a -> SteppedC e m b -> SteppedC e m a
forall a b. SteppedC e m a -> SteppedC e m b -> SteppedC e m b
forall a b.
SteppedC e m (a -> b) -> SteppedC e m a -> SteppedC e m b
forall a b c.
(a -> b -> c) -> SteppedC e m a -> SteppedC e m b -> SteppedC e 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 (e :: Effect) (m :: * -> *). Functor (SteppedC e m)
forall (e :: Effect) (m :: * -> *) a. a -> SteppedC e m a
forall (e :: Effect) (m :: * -> *) a b.
SteppedC e m a -> SteppedC e m b -> SteppedC e m a
forall (e :: Effect) (m :: * -> *) a b.
SteppedC e m a -> SteppedC e m b -> SteppedC e m b
forall (e :: Effect) (m :: * -> *) a b.
SteppedC e m (a -> b) -> SteppedC e m a -> SteppedC e m b
forall (e :: Effect) (m :: * -> *) a b c.
(a -> b -> c) -> SteppedC e m a -> SteppedC e m b -> SteppedC e m c
<* :: SteppedC e m a -> SteppedC e m b -> SteppedC e m a
$c<* :: forall (e :: Effect) (m :: * -> *) a b.
SteppedC e m a -> SteppedC e m b -> SteppedC e m a
*> :: SteppedC e m a -> SteppedC e m b -> SteppedC e m b
$c*> :: forall (e :: Effect) (m :: * -> *) a b.
SteppedC e m a -> SteppedC e m b -> SteppedC e m b
liftA2 :: (a -> b -> c) -> SteppedC e m a -> SteppedC e m b -> SteppedC e m c
$cliftA2 :: forall (e :: Effect) (m :: * -> *) a b c.
(a -> b -> c) -> SteppedC e m a -> SteppedC e m b -> SteppedC e m c
<*> :: SteppedC e m (a -> b) -> SteppedC e m a -> SteppedC e m b
$c<*> :: forall (e :: Effect) (m :: * -> *) a b.
SteppedC e m (a -> b) -> SteppedC e m a -> SteppedC e m b
pure :: a -> SteppedC e m a
$cpure :: forall (e :: Effect) (m :: * -> *) a. a -> SteppedC e m a
$cp1Applicative :: forall (e :: Effect) (m :: * -> *). Functor (SteppedC e m)
Applicative, Applicative (SteppedC e m)
a -> SteppedC e m a
Applicative (SteppedC e m)
-> (forall a b.
SteppedC e m a -> (a -> SteppedC e m b) -> SteppedC e m b)
-> (forall a b. SteppedC e m a -> SteppedC e m b -> SteppedC e m b)
-> (forall a. a -> SteppedC e m a)
-> Monad (SteppedC e m)
SteppedC e m a -> (a -> SteppedC e m b) -> SteppedC e m b
SteppedC e m a -> SteppedC e m b -> SteppedC e m b
forall a. a -> SteppedC e m a
forall a b. SteppedC e m a -> SteppedC e m b -> SteppedC e m b
forall a b.
SteppedC e m a -> (a -> SteppedC e m b) -> SteppedC e 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 (e :: Effect) (m :: * -> *). Applicative (SteppedC e m)
forall (e :: Effect) (m :: * -> *) a. a -> SteppedC e m a
forall (e :: Effect) (m :: * -> *) a b.
SteppedC e m a -> SteppedC e m b -> SteppedC e m b
forall (e :: Effect) (m :: * -> *) a b.
SteppedC e m a -> (a -> SteppedC e m b) -> SteppedC e m b
return :: a -> SteppedC e m a
$creturn :: forall (e :: Effect) (m :: * -> *) a. a -> SteppedC e m a
>> :: SteppedC e m a -> SteppedC e m b -> SteppedC e m b
$c>> :: forall (e :: Effect) (m :: * -> *) a b.
SteppedC e m a -> SteppedC e m b -> SteppedC e m b
>>= :: SteppedC e m a -> (a -> SteppedC e m b) -> SteppedC e m b
$c>>= :: forall (e :: Effect) (m :: * -> *) a b.
SteppedC e m a -> (a -> SteppedC e m b) -> SteppedC e m b
$cp1Monad :: forall (e :: Effect) (m :: * -> *). Applicative (SteppedC e m)
Monad
, Monad (SteppedC e m)
Monad (SteppedC e m)
-> (forall a. String -> SteppedC e m a) -> MonadFail (SteppedC e m)
String -> SteppedC e m a
forall a. String -> SteppedC e m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall (e :: Effect) (m :: * -> *).
MonadFail m =>
Monad (SteppedC e m)
forall (e :: Effect) (m :: * -> *) a.
MonadFail m =>
String -> SteppedC e m a
fail :: String -> SteppedC e m a
$cfail :: forall (e :: Effect) (m :: * -> *) a.
MonadFail m =>
String -> SteppedC e m a
$cp1MonadFail :: forall (e :: Effect) (m :: * -> *).
MonadFail m =>
Monad (SteppedC e m)
MonadFail, Monad (SteppedC e m)
Monad (SteppedC e m)
-> (forall a. IO a -> SteppedC e m a) -> MonadIO (SteppedC e m)
IO a -> SteppedC e m a
forall a. IO a -> SteppedC e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (e :: Effect) (m :: * -> *).
MonadIO m =>
Monad (SteppedC e m)
forall (e :: Effect) (m :: * -> *) a.
MonadIO m =>
IO a -> SteppedC e m a
liftIO :: IO a -> SteppedC e m a
$cliftIO :: forall (e :: Effect) (m :: * -> *) a.
MonadIO m =>
IO a -> SteppedC e m a
$cp1MonadIO :: forall (e :: Effect) (m :: * -> *).
MonadIO m =>
Monad (SteppedC e m)
MonadIO, MonadBase b
, Monad (SteppedC e m)
e -> SteppedC e m a
Monad (SteppedC e m)
-> (forall e a. Exception e => e -> SteppedC e m a)
-> MonadThrow (SteppedC e m)
forall e a. Exception e => e -> SteppedC e m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (e :: Effect) (m :: * -> *).
MonadThrow m =>
Monad (SteppedC e m)
forall (e :: Effect) (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SteppedC e m a
throwM :: e -> SteppedC e m a
$cthrowM :: forall (e :: Effect) (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SteppedC e m a
$cp1MonadThrow :: forall (e :: Effect) (m :: * -> *).
MonadThrow m =>
Monad (SteppedC e m)
MonadThrow, MonadThrow (SteppedC e m)
MonadThrow (SteppedC e m)
-> (forall e a.
Exception e =>
SteppedC e m a -> (e -> SteppedC e m a) -> SteppedC e m a)
-> MonadCatch (SteppedC e m)
SteppedC e m a -> (e -> SteppedC e m a) -> SteppedC e m a
forall e a.
Exception e =>
SteppedC e m a -> (e -> SteppedC e m a) -> SteppedC e m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (e :: Effect) (m :: * -> *).
MonadCatch m =>
MonadThrow (SteppedC e m)
forall (e :: Effect) (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SteppedC e m a -> (e -> SteppedC e m a) -> SteppedC e m a
catch :: SteppedC e m a -> (e -> SteppedC e m a) -> SteppedC e m a
$ccatch :: forall (e :: Effect) (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SteppedC e m a -> (e -> SteppedC e m a) -> SteppedC e m a
$cp1MonadCatch :: forall (e :: Effect) (m :: * -> *).
MonadCatch m =>
MonadThrow (SteppedC e m)
MonadCatch
)
deriving m a -> SteppedC e m a
(forall (m :: * -> *) a. Monad m => m a -> SteppedC e m a)
-> MonadTrans (SteppedC e)
forall (m :: * -> *) a. Monad m => m a -> SteppedC e m a
forall (t :: Effect).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
forall (e :: Effect) (m :: * -> *) a.
Monad m =>
m a -> SteppedC e m a
lift :: m a -> SteppedC e m a
$clift :: forall (e :: Effect) (m :: * -> *) a.
Monad m =>
m a -> SteppedC e m a
MonadTrans
sendStepped :: e q a -> SteppedC e m a
sendStepped :: e q a -> SteppedC e m a
sendStepped = FreeT (FOEff e) m a -> SteppedC e m a
forall (e :: Effect) (m :: * -> *) a.
FreeT (FOEff e) m a -> SteppedC e m a
SteppedC (FreeT (FOEff e) m a -> SteppedC e m a)
-> (e q a -> FreeT (FOEff e) m a) -> e q a -> SteppedC e m a
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. FOEff e a -> FreeT (FOEff e) m a
forall (f :: * -> *) a (m :: * -> *). f a -> FreeT f m a
liftF (FOEff e a -> FreeT (FOEff e) m a)
-> (e q a -> FOEff e a) -> e q a -> FreeT (FOEff e) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e q a -> FOEff e a
forall k k (e :: k -> k -> *) (q :: k) (x :: k). e q x -> FOEff e x
FOEff
{-# INLINE sendStepped #-}
instance ( Threads (FreeT (FOEff e)) (Prims m)
, Carrier m
)
=> Carrier (SteppedC e m) where
type Derivs (SteppedC e m) = e ': Derivs m
type Prims (SteppedC e m) = Prims m
algPrims :: Algebra' (Prims (SteppedC e m)) (SteppedC e m) a
algPrims = (Union (Prims m) (FreeT (FOEff e) m) a -> FreeT (FOEff e) m a)
-> Algebra' (Prims m) (SteppedC e m) a
coerce (Algebra (Prims m) m -> Algebra (Prims m) (FreeT (FOEff e) m)
forall (t :: Effect) (p :: [Effect]) (m :: * -> *).
(Threads t p, Monad m) =>
Algebra p m -> Algebra p (t m)
thread @(FreeT (FOEff e)) (Carrier m => Algebra (Prims m) m
forall (m :: * -> *) a. Carrier m => Algebra' (Prims m) m a
algPrims @m))
{-# INLINEABLE algPrims #-}
reformulate :: Reformulation'
(Derivs (SteppedC e m)) (Prims (SteppedC e m)) (SteppedC e m) z a
reformulate forall x. SteppedC e m x -> z x
n Algebra (Prims (SteppedC e m)) z
alg = Algebra' (Derivs m) z a
-> (forall (z :: * -> *). Coercible z z => e z a -> z a)
-> Algebra' (e : Derivs m) z a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
Algebra' r m a
-> (forall (z :: * -> *). Coercible z m => e z a -> m a)
-> Algebra' (e : r) m a
powerAlg' (Reformulation' (Derivs m) (Prims m) m z a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate (SteppedC e m x -> z x
forall x. SteppedC e m x -> z x
n (SteppedC e m x -> z x) -> (m x -> SteppedC e m x) -> m x -> z x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m x -> SteppedC e m x
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) forall x. Union (Prims m) z x -> z x
Algebra (Prims (SteppedC e m)) z
alg) (SteppedC e m a -> z a
forall x. SteppedC e m x -> z x
n (SteppedC e m a -> z a)
-> (e z a -> SteppedC e m a) -> e z a -> z a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e z a -> SteppedC e m a
forall (e :: Effect) (q :: * -> *) a (m :: * -> *).
e q a -> SteppedC e m a
sendStepped)
{-# INLINEABLE reformulate #-}
data Steps (e :: Effect) m a where
Done :: a -> Steps e m a
More :: e q x -> (x -> m (Steps e m a)) -> Steps e m a
deriving instance Functor m => Functor (Steps e m)
instance Functor m => Applicative (Steps e m) where
pure :: a -> Steps e m a
pure = a -> Steps e m a
forall a (e :: Effect) (m :: * -> *). a -> Steps e m a
Done
{-# INLINE pure #-}
liftA2 :: (a -> b -> c) -> Steps e m a -> Steps e m b -> Steps e m c
liftA2 a -> b -> c
f (Done a
a) Steps e m b
fb = (b -> c) -> Steps e m b -> Steps e m c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
a) Steps e m b
fb
liftA2 a -> b -> c
f (More e q x
e x -> m (Steps e m a)
c) Steps e m b
fb = e q x -> (x -> m (Steps e m c)) -> Steps e m c
forall (e :: Effect) (q :: * -> *) x (m :: * -> *) a.
e q x -> (x -> m (Steps e m a)) -> Steps e m a
More e q x
e ((Steps e m a -> Steps e m c) -> m (Steps e m a) -> m (Steps e m c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Steps e m a
fa -> (a -> b -> c) -> Steps e m a -> Steps e m b -> Steps e m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Steps e m a
fa Steps e m b
fb) (m (Steps e m a) -> m (Steps e m c))
-> (x -> m (Steps e m a)) -> x -> m (Steps e m c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (Steps e m a)
c)
instance Functor m => Monad (Steps e m) where
Done a
a >>= :: Steps e m a -> (a -> Steps e m b) -> Steps e m b
>>= a -> Steps e m b
f = a -> Steps e m b
f a
a
More e q x
e x -> m (Steps e m a)
c >>= a -> Steps e m b
f = e q x -> (x -> m (Steps e m b)) -> Steps e m b
forall (e :: Effect) (q :: * -> *) x (m :: * -> *) a.
e q x -> (x -> m (Steps e m a)) -> Steps e m a
More e q x
e ((Steps e m a -> Steps e m b) -> m (Steps e m a) -> m (Steps e m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Steps e m a -> (a -> Steps e m b) -> Steps e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Steps e m b
f) (m (Steps e m a) -> m (Steps e m b))
-> (x -> m (Steps e m a)) -> x -> m (Steps e m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (Steps e m a)
c)
steps :: forall e m a p
. ( Carrier m
, Threaders '[SteppedThreads] m p
)
=> SteppedC e m a -> m (Steps e m a)
steps :: SteppedC e m a -> m (Steps e m a)
steps =
(a -> Steps e m a)
-> (forall x.
(x -> m (Steps e m a)) -> FOEff e x -> m (Steps e m a))
-> FreeT (FOEff e) m a
-> m (Steps e m a)
forall (m :: * -> *) a b (f :: * -> *).
Monad m =>
(a -> b)
-> (forall x. (x -> m b) -> f x -> m b) -> FreeT f m a -> m b
foldFreeT
a -> Steps e m a
forall a (e :: Effect) (m :: * -> *). a -> Steps e m a
Done
(\x -> m (Steps e m a)
c (FOEff e) -> Steps e m a -> m (Steps e m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (e q x -> (x -> m (Steps e m a)) -> Steps e m a
forall (e :: Effect) (q :: * -> *) x (m :: * -> *) a.
e q x -> (x -> m (Steps e m a)) -> Steps e m a
More e q x
e x -> m (Steps e m a)
c))
(FreeT (FOEff e) m a -> m (Steps e m a))
-> (SteppedC e m a -> FreeT (FOEff e) m a)
-> SteppedC e m a
-> m (Steps e m a)
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# SteppedC e m a -> FreeT (FOEff e) m a
forall (e :: Effect) (m :: * -> *) a.
SteppedC e m a -> FreeT (FOEff e) m a
unSteppedC
{-# INLINE steps #-}
liftSteps :: (MonadTrans t, Monad m) => Steps e m a -> Steps e (t m) a
liftSteps :: Steps e m a -> Steps e (t m) a
liftSteps (Done a
a) = a -> Steps e (t m) a
forall a (e :: Effect) (m :: * -> *). a -> Steps e m a
Done a
a
liftSteps (More e q x
e x -> m (Steps e m a)
c) = e q x -> (x -> t m (Steps e (t m) a)) -> Steps e (t m) a
forall (e :: Effect) (q :: * -> *) x (m :: * -> *) a.
e q x -> (x -> m (Steps e m a)) -> Steps e m a
More e q x
e (m (Steps e (t m) a) -> t m (Steps e (t m) a)
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Steps e (t m) a) -> t m (Steps e (t m) a))
-> (x -> m (Steps e (t m) a)) -> x -> t m (Steps e (t m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Steps e m a -> Steps e (t m) a)
-> m (Steps e m a) -> m (Steps e (t m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Steps e m a -> Steps e (t m) a
forall (t :: Effect) (m :: * -> *) (e :: Effect) a.
(MonadTrans t, Monad m) =>
Steps e m a -> Steps e (t m) a
liftSteps (m (Steps e m a) -> m (Steps e (t m) a))
-> (x -> m (Steps e m a)) -> x -> m (Steps e (t m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (Steps e m a)
c)
unsteps :: forall e m a
. ( FirstOrder e
, Member e (Derivs m)
, Carrier m
)
=> Steps e m a -> m a
unsteps :: Steps e m a -> m a
unsteps (Done a
a) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
unsteps (More e q x
e x -> m (Steps e m a)
c) = e m x -> m x
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send @e (e q x -> e m x
coerce e q x
e) m x -> (x -> m (Steps e m a)) -> m (Steps e m a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> m (Steps e m a)
c m (Steps e m a) -> (Steps e m a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Steps e m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(FirstOrder e, Member e (Derivs m), Carrier m) =>
Steps e m a -> m a
unsteps
type SteppedThreads = FreeThreads