{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.Conduino.Internal (
Pipe(..)
, PipeF(..)
, awaitEither
, yield, yieldLazy
, trimapPipe, trimapPipeF, mapInput, mapOutput, mapUpRes
, hoistPipe
, RecPipe
, toRecPipe, fromRecPipe
, withRecPipe
, runStateP, runStatePS
, pAwaitF, pYieldF
) where
import Control.Applicative
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Free.Class
import Control.Monad.Free.TH
import Control.Monad.RWS
import Control.Monad.Trans.Free (FreeT(..), FreeF(..))
import Control.Monad.Trans.Free.Church
import Control.Monad.Trans.State
import Data.Functor
import qualified Control.Monad.Trans.State.Strict as SS
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail
#endif
data PipeF i o u a =
PAwaitF (u -> a) (i -> a)
| PYieldF o a
deriving forall a b. a -> PipeF i o u b -> PipeF i o u a
forall a b. (a -> b) -> PipeF i o u a -> PipeF i o u b
forall i o u a b. a -> PipeF i o u b -> PipeF i o u a
forall i o u a b. (a -> b) -> PipeF i o u a -> PipeF i o u b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PipeF i o u b -> PipeF i o u a
$c<$ :: forall i o u a b. a -> PipeF i o u b -> PipeF i o u a
fmap :: forall a b. (a -> b) -> PipeF i o u a -> PipeF i o u b
$cfmap :: forall i o u a b. (a -> b) -> PipeF i o u a -> PipeF i o u b
Functor
makeFree ''PipeF
{-# INLINE pYieldF #-}
{-# INLINE pAwaitF #-}
newtype Pipe i o u m a = Pipe { forall i o u (m :: * -> *) a.
Pipe i o u m a -> FT (PipeF i o u) m a
pipeFree :: FT (PipeF i o u) m a }
deriving
( forall a b. a -> Pipe i o u m b -> Pipe i o u m a
forall a b. (a -> b) -> Pipe i o u m a -> Pipe i o u m b
forall i o u (m :: * -> *) a b.
a -> Pipe i o u m b -> Pipe i o u m a
forall i o u (m :: * -> *) a b.
(a -> b) -> Pipe i o u m a -> Pipe i o u m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Pipe i o u m b -> Pipe i o u m a
$c<$ :: forall i o u (m :: * -> *) a b.
a -> Pipe i o u m b -> Pipe i o u m a
fmap :: forall a b. (a -> b) -> Pipe i o u m a -> Pipe i o u m b
$cfmap :: forall i o u (m :: * -> *) a b.
(a -> b) -> Pipe i o u m a -> Pipe i o u m b
Functor
, forall a. a -> Pipe i o u m a
forall a b. Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m a
forall a b. Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m b
forall a b.
Pipe i o u m (a -> b) -> Pipe i o u m a -> Pipe i o u m b
forall a b c.
(a -> b -> c) -> Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m c
forall i o u (m :: * -> *). Functor (Pipe i o u m)
forall i o u (m :: * -> *) a. a -> Pipe i o u m a
forall i o u (m :: * -> *) a b.
Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m a
forall i o u (m :: * -> *) a b.
Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m b
forall i o u (m :: * -> *) a b.
Pipe i o u m (a -> b) -> Pipe i o u m a -> Pipe i o u m b
forall i o u (m :: * -> *) a b c.
(a -> b -> c) -> Pipe i o u m a -> Pipe i o u m b -> Pipe i o u 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 a b. Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m a
$c<* :: forall i o u (m :: * -> *) a b.
Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m a
*> :: forall a b. Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m b
$c*> :: forall i o u (m :: * -> *) a b.
Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m b
liftA2 :: forall a b c.
(a -> b -> c) -> Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m c
$cliftA2 :: forall i o u (m :: * -> *) a b c.
(a -> b -> c) -> Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m c
<*> :: forall a b.
Pipe i o u m (a -> b) -> Pipe i o u m a -> Pipe i o u m b
$c<*> :: forall i o u (m :: * -> *) a b.
Pipe i o u m (a -> b) -> Pipe i o u m a -> Pipe i o u m b
pure :: forall a. a -> Pipe i o u m a
$cpure :: forall i o u (m :: * -> *) a. a -> Pipe i o u m a
Applicative
, forall a. a -> Pipe i o u m a
forall a b. Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m b
forall a b.
Pipe i o u m a -> (a -> Pipe i o u m b) -> Pipe i o u m b
forall i o u (m :: * -> *). Applicative (Pipe i o u m)
forall i o u (m :: * -> *) a. a -> Pipe i o u m a
forall i o u (m :: * -> *) a b.
Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m b
forall i o u (m :: * -> *) a b.
Pipe i o u m a -> (a -> Pipe i o u m b) -> Pipe i o u 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
return :: forall a. a -> Pipe i o u m a
$creturn :: forall i o u (m :: * -> *) a. a -> Pipe i o u m a
>> :: forall a b. Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m b
$c>> :: forall i o u (m :: * -> *) a b.
Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m b
>>= :: forall a b.
Pipe i o u m a -> (a -> Pipe i o u m b) -> Pipe i o u m b
$c>>= :: forall i o u (m :: * -> *) a b.
Pipe i o u m a -> (a -> Pipe i o u m b) -> Pipe i o u m b
Monad
, forall i o u (m :: * -> *) a. Monad m => m a -> Pipe i o u m a
forall (m :: * -> *) a. Monad m => m a -> Pipe i o u m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> Pipe i o u m a
$clift :: forall i o u (m :: * -> *) a. Monad m => m a -> Pipe i o u m a
MonadTrans
, MonadFree (PipeF i o u)
, forall a. IO a -> Pipe i o u m a
forall {i} {o} {u} {m :: * -> *}. MonadIO m => Monad (Pipe i o u m)
forall i o u (m :: * -> *) a. MonadIO m => IO a -> Pipe i o u m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Pipe i o u m a
$cliftIO :: forall i o u (m :: * -> *) a. MonadIO m => IO a -> Pipe i o u m a
MonadIO
, MonadState s
, MonadReader r
, MonadWriter w
, MonadError e
, MonadRWS r w s
, forall a. Pipe i o u m a
forall a. Pipe i o u m a -> Pipe i o u m [a]
forall a. Pipe i o u m a -> Pipe i o u m a -> Pipe i o u m a
forall {i} {o} {u} {m :: * -> *}.
Alternative m =>
Applicative (Pipe i o u m)
forall i o u (m :: * -> *) a. Alternative m => Pipe i o u m a
forall i o u (m :: * -> *) a.
Alternative m =>
Pipe i o u m a -> Pipe i o u m [a]
forall i o u (m :: * -> *) a.
Alternative m =>
Pipe i o u m a -> Pipe i o u m a -> Pipe i o u 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
many :: forall a. Pipe i o u m a -> Pipe i o u m [a]
$cmany :: forall i o u (m :: * -> *) a.
Alternative m =>
Pipe i o u m a -> Pipe i o u m [a]
some :: forall a. Pipe i o u m a -> Pipe i o u m [a]
$csome :: forall i o u (m :: * -> *) a.
Alternative m =>
Pipe i o u m a -> Pipe i o u m [a]
<|> :: forall a. Pipe i o u m a -> Pipe i o u m a -> Pipe i o u m a
$c<|> :: forall i o u (m :: * -> *) a.
Alternative m =>
Pipe i o u m a -> Pipe i o u m a -> Pipe i o u m a
empty :: forall a. Pipe i o u m a
$cempty :: forall i o u (m :: * -> *) a. Alternative m => Pipe i o u m a
Alternative
, forall a. Pipe i o u m a
forall a. Pipe i o u m a -> Pipe i o u m a -> Pipe i o u m a
forall {i} {o} {u} {m :: * -> *}.
MonadPlus m =>
Monad (Pipe i o u m)
forall {i} {o} {u} {m :: * -> *}.
MonadPlus m =>
Alternative (Pipe i o u m)
forall i o u (m :: * -> *) a. MonadPlus m => Pipe i o u m a
forall i o u (m :: * -> *) a.
MonadPlus m =>
Pipe i o u m a -> Pipe i o u m a -> Pipe i o u m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. Pipe i o u m a -> Pipe i o u m a -> Pipe i o u m a
$cmplus :: forall i o u (m :: * -> *) a.
MonadPlus m =>
Pipe i o u m a -> Pipe i o u m a -> Pipe i o u m a
mzero :: forall a. Pipe i o u m a
$cmzero :: forall i o u (m :: * -> *) a. MonadPlus m => Pipe i o u m a
MonadPlus
, forall e a. Exception e => e -> Pipe i o u m a
forall {i} {o} {u} {m :: * -> *}.
MonadThrow m =>
Monad (Pipe i o u m)
forall i o u (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> Pipe i o u m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> Pipe i o u m a
$cthrowM :: forall i o u (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> Pipe i o u m a
MonadThrow
, forall e a.
Exception e =>
Pipe i o u m a -> (e -> Pipe i o u m a) -> Pipe i o u m a
forall {i} {o} {u} {m :: * -> *}.
MonadCatch m =>
MonadThrow (Pipe i o u m)
forall i o u (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
Pipe i o u m a -> (e -> Pipe i o u m a) -> Pipe i o u m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
Pipe i o u m a -> (e -> Pipe i o u m a) -> Pipe i o u m a
$ccatch :: forall i o u (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
Pipe i o u m a -> (e -> Pipe i o u m a) -> Pipe i o u m a
MonadCatch
)
instance MonadFail m => MonadFail (Pipe i o u m) where
#if MIN_VERSION_base(4,13,0)
fail :: forall a. String -> Pipe i o u m a
fail = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => String -> m a
fail
#else
fail = lift . Control.Monad.Fail.fail
#endif
awaitEither :: Pipe i o u m (Either u i)
awaitEither :: forall i o u (m :: * -> *). Pipe i o u m (Either u i)
awaitEither = forall (m :: * -> *) i o u.
MonadFree (PipeF i o u) m =>
m (Either u i)
pAwaitF
{-# INLINE awaitEither #-}
yield :: o -> Pipe i o u m ()
yield :: forall o i u (m :: * -> *). o -> Pipe i o u m ()
yield o
x = o
x seq :: forall a b. a -> b -> b
`seq` forall o i u (m :: * -> *). o -> Pipe i o u m ()
yieldLazy o
x
{-# INLINE yield #-}
yieldLazy :: o -> Pipe i o u m ()
yieldLazy :: forall o i u (m :: * -> *). o -> Pipe i o u m ()
yieldLazy = forall (m :: * -> *) i o u. MonadFree (PipeF i o u) m => o -> m ()
pYieldF
{-# INLINE yieldLazy #-}
trimapPipe
:: (i -> j)
-> (p -> o)
-> (u -> v)
-> Pipe j p v m a
-> Pipe i o u m a
trimapPipe :: forall i j p o u v (m :: * -> *) a.
(i -> j)
-> (p -> o) -> (u -> v) -> Pipe j p v m a -> Pipe i o u m a
trimapPipe i -> j
f p -> o
g u -> v
h (Pipe FT (PipeF j p v) m a
p) = forall i o u (m :: * -> *) a.
FT (PipeF i o u) m a -> Pipe i o u m a
Pipe (forall (f :: * -> *) (g :: * -> *) (m :: * -> *) b.
(forall a. f a -> g a) -> FT f m b -> FT g m b
transFT (forall i j p o u v a.
(i -> j) -> (p -> o) -> (u -> v) -> PipeF j p v a -> PipeF i o u a
trimapPipeF i -> j
f p -> o
g u -> v
h) FT (PipeF j p v) m a
p)
{-# INLINE trimapPipe #-}
trimapPipeF
:: (i -> j)
-> (p -> o)
-> (u -> v)
-> PipeF j p v a
-> PipeF i o u a
trimapPipeF :: forall i j p o u v a.
(i -> j) -> (p -> o) -> (u -> v) -> PipeF j p v a -> PipeF i o u a
trimapPipeF i -> j
f p -> o
g u -> v
h = \case
PAwaitF v -> a
a j -> a
b -> forall i o u a. (u -> a) -> (i -> a) -> PipeF i o u a
PAwaitF (v -> a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> v
h) (j -> a
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> j
f)
PYieldF p
a a
x -> forall i o u a. o -> a -> PipeF i o u a
PYieldF (p -> o
g p
a) a
x
{-# INLINE trimapPipeF #-}
hoistPipe
:: (Monad m, Monad n)
=> (forall x. m x -> n x)
-> Pipe i o u m a
-> Pipe i o u n a
hoistPipe :: forall (m :: * -> *) (n :: * -> *) i o u a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> Pipe i o u m a -> Pipe i o u n a
hoistPipe forall x. m x -> n x
f = forall i o u (m :: * -> *) a.
FT (PipeF i o u) m a -> Pipe i o u m a
Pipe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) (f :: * -> *) b.
(Monad m, Monad n) =>
(forall a. m a -> n a) -> FT f m b -> FT f n b
hoistFT forall x. m x -> n x
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i o u (m :: * -> *) a.
Pipe i o u m a -> FT (PipeF i o u) m a
pipeFree
{-# INLINE hoistPipe #-}
mapInput :: (i -> j) -> Pipe j o u m a -> Pipe i o u m a
mapInput :: forall i j o u (m :: * -> *) a.
(i -> j) -> Pipe j o u m a -> Pipe i o u m a
mapInput i -> j
f = forall i j p o u v (m :: * -> *) a.
(i -> j)
-> (p -> o) -> (u -> v) -> Pipe j p v m a -> Pipe i o u m a
trimapPipe i -> j
f forall a. a -> a
id forall a. a -> a
id
{-# INLINE mapInput #-}
mapOutput :: (p -> o) -> Pipe i p u m a -> Pipe i o u m a
mapOutput :: forall p o i u (m :: * -> *) a.
(p -> o) -> Pipe i p u m a -> Pipe i o u m a
mapOutput p -> o
f = forall i j p o u v (m :: * -> *) a.
(i -> j)
-> (p -> o) -> (u -> v) -> Pipe j p v m a -> Pipe i o u m a
trimapPipe forall a. a -> a
id p -> o
f forall a. a -> a
id
{-# INLINE mapOutput #-}
mapUpRes :: (u -> v) -> Pipe i o v m a -> Pipe i o u m a
mapUpRes :: forall u v i o (m :: * -> *) a.
(u -> v) -> Pipe i o v m a -> Pipe i o u m a
mapUpRes = forall i j p o u v (m :: * -> *) a.
(i -> j)
-> (p -> o) -> (u -> v) -> Pipe j p v m a -> Pipe i o u m a
trimapPipe forall a. a -> a
id forall a. a -> a
id
{-# INLINE mapUpRes #-}
type RecPipe i o u = FreeT (PipeF i o u)
toRecPipe :: Monad m => Pipe i o u m a -> RecPipe i o u m a
toRecPipe :: forall (m :: * -> *) i o u a.
Monad m =>
Pipe i o u m a -> RecPipe i o u m a
toRecPipe = forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
_fromFT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i o u (m :: * -> *) a.
Pipe i o u m a -> FT (PipeF i o u) m a
pipeFree
{-# INLINE toRecPipe #-}
_fromFT :: (Monad m, Functor f) => FT f m a -> FreeT f m a
_fromFT :: forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
_fromFT (FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k) = forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT forall a b. (a -> b) -> a -> b
$ forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. a -> FreeF f a b
Pure) (\x -> m (FreeF f a (FreeT f m a))
xg -> forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (FreeF f a (FreeT f m a))
xg))
{-# INLINE _fromFT #-}
fromRecPipe :: Monad m => RecPipe i o u m a -> Pipe i o u m a
fromRecPipe :: forall (m :: * -> *) i o u a.
Monad m =>
RecPipe i o u m a -> Pipe i o u m a
fromRecPipe = forall i o u (m :: * -> *) a.
FT (PipeF i o u) m a -> Pipe i o u m a
Pipe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
FreeT f m a -> FT f m a
toFT
{-# INLINE fromRecPipe #-}
withRecPipe
:: (Monad m, Monad n)
=> (RecPipe i o u m a -> RecPipe j p v n b)
-> Pipe i o u m a
-> Pipe j p v n b
withRecPipe :: forall (m :: * -> *) (n :: * -> *) i o u a j p v b.
(Monad m, Monad n) =>
(RecPipe i o u m a -> RecPipe j p v n b)
-> Pipe i o u m a -> Pipe j p v n b
withRecPipe RecPipe i o u m a -> RecPipe j p v n b
f = forall (m :: * -> *) i o u a.
Monad m =>
RecPipe i o u m a -> Pipe i o u m a
fromRecPipe forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecPipe i o u m a -> RecPipe j p v n b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) i o u a.
Monad m =>
Pipe i o u m a -> RecPipe i o u m a
toRecPipe
{-# INLINE withRecPipe #-}
runStateP
:: Monad m
=> s
-> Pipe i o u (StateT s m) a
-> Pipe i o u m (a, s)
runStateP :: forall (m :: * -> *) s i o u a.
Monad m =>
s -> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s)
runStateP = forall (m :: * -> *) (n :: * -> *) i o u a j p v b.
(Monad m, Monad n) =>
(RecPipe i o u m a -> RecPipe j p v n b)
-> Pipe i o u m a -> Pipe j p v n b
withRecPipe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *} {f :: * -> *} {t} {a}.
(Functor m, Functor f) =>
t -> FreeT f (StateT t m) a -> FreeT f m (a, t)
go
where
go :: t -> FreeT f (StateT t m) a -> FreeT f m (a, t)
go t
s (FreeT StateT t m (FreeF f a (FreeT f (StateT t m) a))
p) = forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT t m (FreeF f a (FreeT f (StateT t m) a))
p t
s forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(FreeF f a (FreeT f (StateT t m) a)
q, t
s') ->
case FreeF f a (FreeT f (StateT t m) a)
q of
Pure a
x -> forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a
x, t
s')
Free f (FreeT f (StateT t m) a)
l -> forall (f :: * -> *) a b. f b -> FreeF f a b
Free forall a b. (a -> b) -> a -> b
$ t -> FreeT f (StateT t m) a -> FreeT f m (a, t)
go t
s' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (FreeT f (StateT t m) a)
l
{-# INLINE runStateP #-}
runStatePS
:: Monad m
=> s
-> Pipe i o u (SS.StateT s m) a
-> Pipe i o u m (a, s)
runStatePS :: forall (m :: * -> *) s i o u a.
Monad m =>
s -> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s)
runStatePS = forall (m :: * -> *) (n :: * -> *) i o u a j p v b.
(Monad m, Monad n) =>
(RecPipe i o u m a -> RecPipe j p v n b)
-> Pipe i o u m a -> Pipe j p v n b
withRecPipe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *} {f :: * -> *} {t} {a}.
(Functor m, Functor f) =>
t -> FreeT f (StateT t m) a -> FreeT f m (a, t)
go
where
go :: t -> FreeT f (StateT t m) a -> FreeT f m (a, t)
go t
s (FreeT StateT t m (FreeF f a (FreeT f (StateT t m) a))
p) = forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
SS.runStateT StateT t m (FreeF f a (FreeT f (StateT t m) a))
p t
s forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(FreeF f a (FreeT f (StateT t m) a)
q, t
s') ->
case FreeF f a (FreeT f (StateT t m) a)
q of
Pure a
x -> forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a
x, t
s')
Free f (FreeT f (StateT t m) a)
l -> forall (f :: * -> *) a b. f b -> FreeF f a b
Free forall a b. (a -> b) -> a -> b
$ t -> FreeT f (StateT t m) a -> FreeT f m (a, t)
go t
s' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (FreeT f (StateT t m) a)
l
{-# INLINE runStatePS #-}