{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Stream where

-- base
import Control.Applicative (Alternative (..), Applicative (..), liftA2)
import Control.Monad ((<$!>))
import Data.Bifunctor (bimap)
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.Monoid (Ap (..))
import Data.Tuple (swap)
import Prelude hiding (Applicative (..))

-- transformers
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT, throwE, withExceptT)
import Control.Monad.Trans.Maybe (MaybeT (..))
import Control.Monad.Trans.Writer (WriterT (runWriterT), writer)

-- mmorph
import Control.Monad.Morph (MFunctor (hoist))

-- simple-affine-space
import Data.VectorSpace (VectorSpace (..))

-- selective
import Control.Selective

-- these
import Data.These (These (..))

-- semialign
import Data.Align

-- automaton
import Data.Stream.Internal
import Data.Stream.Recursive (Recursive (..))
import Data.Stream.Result

-- * Creating streams

{- | Effectful streams in coalgebraic encoding.

A stream consists of an internal state @s@, and a step function.
This step can make use of an effect in @m@ (which is often a monad),
alter the state, and return a result value.
Its semantics is continuously outputting values of type @b@,
while performing side effects in @m@.

A coalgebraic encoding was chosen instead of the direct recursion known from e.g. @list-transformer@, @dunai@, @machines@, @streaming@, ...,
because the coalgebraic encoding is much more amenable to compiler optimizations
than the coalgebraic encoding, which is:

@
  data StreamRecursiveT m b = StreamRecursiveT (m (b, StreamRecursiveT m b))
@

When two streams are composed, GHC can often optimize the combined step function,
resulting in a faster streams than what the coalgebraic encoding can ever achieve,
because the coalgebraic encoding has to step through every continuation.
Put differently, the compiler can perform static analysis on the state types of initially encoded state machines,
while the coalgebraic encoding knows its state only at runtime.

This performance gain comes at a peculiar cost:
Recursive definitions /of/ streams are not possible, e.g. an equation like:
@
  fixA stream = stream <*> fixA stream
@
This is impossible since the stream under definition itself appears in the definition body,
and thus the internal /state type/ would be recursively defined, which GHC doesn't allow:
Type level recursion is not supported in existential types.
An stream defined thusly will typically hang and/or leak memory, trying to build up an infinite type at runtime.

It is nevertheless possible to define streams recursively, but one needs to first identify the recursive definition of its /state type/.
Then for the greatest generality, 'fixStream' and 'fixStream'' can be used, and some special cases are covered by functions
such as 'fixA', 'Data.Automaton.parallely', 'many' and 'some'.
-}
data StreamT m a
  = forall s.
  StreamT
  { ()
state :: s
  -- ^ The internal state of the stream
  , ()
step :: s -> m (Result s a)
  -- ^ Stepping a stream by one tick means:
  --   1. performing a side effect in @m@
  --   2. updating the internal state @s@
  --   3. outputting a value of type @a@
  }

-- | Initialise with an internal state, update the state and produce output without side effects.
unfold :: (Applicative m) => s -> (s -> Result s a) -> StreamT m a
unfold :: forall (m :: Type -> Type) s a.
Applicative m =>
s -> (s -> Result s a) -> StreamT m a
unfold s
state s -> Result s a
step =
  StreamT
    { s
state :: s
state :: s
state
    , step :: s -> m (Result s a)
step = Result s a -> m (Result s a)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result s a -> m (Result s a))
-> (s -> Result s a) -> s -> m (Result s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Result s a
step
    }

-- | Like 'unfold', but output the current state.
unfold_ :: (Applicative m) => s -> (s -> s) -> StreamT m s
unfold_ :: forall (m :: Type -> Type) s.
Applicative m =>
s -> (s -> s) -> StreamT m s
unfold_ s
state s -> s
step = s -> (s -> Result s s) -> StreamT m s
forall (m :: Type -> Type) s a.
Applicative m =>
s -> (s -> Result s a) -> StreamT m a
unfold s
state ((s -> Result s s) -> StreamT m s)
-> (s -> Result s s) -> StreamT m s
forall a b. (a -> b) -> a -> b
$ \s
s -> let s' :: s
s' = s -> s
step s
s in s -> s -> Result s s
forall s a. s -> a -> Result s a
Result s
s' s
s'

-- | Constantly perform the same effect, without remembering a state.
constM :: (Functor m) => m a -> StreamT m a
constM :: forall (m :: Type -> Type) a. Functor m => m a -> StreamT m a
constM m a
ma = () -> (() -> m (Result () a)) -> StreamT m a
forall (m :: Type -> Type) a s.
s -> (s -> m (Result s a)) -> StreamT m a
StreamT () ((() -> m (Result () a)) -> StreamT m a)
-> (() -> m (Result () a)) -> StreamT m a
forall a b. (a -> b) -> a -> b
$ m (Result () a) -> () -> m (Result () a)
forall a b. a -> b -> a
const (m (Result () a) -> () -> m (Result () a))
-> m (Result () a) -> () -> m (Result () a)
forall a b. (a -> b) -> a -> b
$ () -> a -> Result () a
forall s a. s -> a -> Result s a
Result () (a -> Result () a) -> m a -> m (Result () a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
ma
{-# INLINE constM #-}

-- | Like 'fmap' or 'rmap', but the postcomposed function may have an effect in @m@.
mmap :: (Monad m) => (a -> m b) -> StreamT m a -> StreamT m b
mmap :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> StreamT m a -> StreamT m b
mmap a -> m b
f StreamT {s
state :: ()
state :: s
state, s -> m (Result s a)
step :: ()
step :: s -> m (Result s a)
step} =
  StreamT
    { s
state :: s
state :: s
state
    , step :: s -> m (Result s b)
step = \s
s -> do
        Result s
s' a
a <- s -> m (Result s a)
step s
s
        s -> b -> Result s b
forall s a. s -> a -> Result s a
Result s
s' (b -> Result s b) -> m b -> m (Result s b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
a
    }
{-# INLINE mmap #-}

{- | Translate a coalgebraically encoded stream into a recursive one.

This is usually a performance penalty.
-}
toRecursive :: (Functor m) => StreamT m a -> Recursive m a
toRecursive :: forall (m :: Type -> Type) a.
Functor m =>
StreamT m a -> Recursive m a
toRecursive StreamT m a
automaton = m (Result (Recursive m a) a) -> Recursive m a
forall (m :: Type -> Type) a.
m (Result (Recursive m a) a) -> Recursive m a
Recursive (m (Result (Recursive m a) a) -> Recursive m a)
-> m (Result (Recursive m a) a) -> Recursive m a
forall a b. (a -> b) -> a -> b
$ (StreamT m a -> Recursive m a)
-> Result (StreamT m a) a -> Result (Recursive m a) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState StreamT m a -> Recursive m a
forall (m :: Type -> Type) a.
Functor m =>
StreamT m a -> Recursive m a
toRecursive (Result (StreamT m a) a -> Result (Recursive m a) a)
-> m (Result (StreamT m a) a) -> m (Result (Recursive m a) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> StreamT m a -> m (Result (StreamT m a) a)
forall (m :: Type -> Type) a.
Functor m =>
StreamT m a -> m (Result (StreamT m a) a)
stepStream StreamT m a
automaton
{-# INLINE toRecursive #-}

{- | Translate a recursive stream into a coalgebraically encoded one.

The internal state is the stream itself.
-}
fromRecursive :: Recursive m a -> StreamT m a
fromRecursive :: forall (m :: Type -> Type) a. Recursive m a -> StreamT m a
fromRecursive Recursive m a
coalgebraic =
  StreamT
    { state :: Recursive m a
state = Recursive m a
coalgebraic
    , step :: Recursive m a -> m (Result (Recursive m a) a)
step = Recursive m a -> m (Result (Recursive m a) a)
forall (m :: Type -> Type) a.
Recursive m a -> m (Result (Recursive m a) a)
getRecursive
    }
{-# INLINE fromRecursive #-}

-- | Call the monadic action once on the first tick and provide its result indefinitely.
initialised :: (Monad m) => m a -> StreamT m a
initialised :: forall (m :: Type -> Type) a. Monad m => m a -> StreamT m a
initialised m a
action =
  let step :: Maybe a -> m (Result (Maybe a) a)
step mr :: Maybe a
mr@(Just a
r) = Result (Maybe a) a -> m (Result (Maybe a) a)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result (Maybe a) a -> m (Result (Maybe a) a))
-> Result (Maybe a) a -> m (Result (Maybe a) a)
forall a b. (a -> b) -> a -> b
$! Maybe a -> a -> Result (Maybe a) a
forall s a. s -> a -> Result s a
Result Maybe a
mr a
r
      step Maybe a
Nothing = (Maybe a -> m (Result (Maybe a) a)
step (Maybe a -> m (Result (Maybe a) a))
-> (a -> Maybe a) -> a -> m (Result (Maybe a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> m (Result (Maybe a) a)) -> m a -> m (Result (Maybe a) a)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< m a
action)
   in StreamT
        { state :: Maybe a
state = Maybe a
forall a. Maybe a
Nothing
        , Maybe a -> m (Result (Maybe a) a)
step :: Maybe a -> m (Result (Maybe a) a)
step :: Maybe a -> m (Result (Maybe a) a)
step
        }
{-# INLINE initialised #-}

instance (Functor m) => Functor (StreamT m) where
  fmap :: forall a b. (a -> b) -> StreamT m a -> StreamT m b
fmap a -> b
f StreamT {s
state :: ()
state :: s
state, s -> m (Result s a)
step :: ()
step :: s -> m (Result s a)
step} = s -> (s -> m (Result s b)) -> StreamT m b
forall (m :: Type -> Type) a s.
s -> (s -> m (Result s a)) -> StreamT m a
StreamT s
state ((s -> m (Result s b)) -> StreamT m b)
-> (s -> m (Result s b)) -> StreamT m b
forall a b. (a -> b) -> a -> b
$! (Result s a -> Result s b) -> m (Result s a) -> m (Result s b)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Result s a -> Result s b
forall a b. (a -> b) -> Result s a -> Result s b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (m (Result s a) -> m (Result s b))
-> (s -> m (Result s a)) -> s -> m (Result s b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s a)
step
  {-# INLINE fmap #-}

-- | 'pure' forever returns the same value, '(<*>)' steps two streams synchronously.
instance (Applicative m) => Applicative (StreamT m) where
  pure :: forall a. a -> StreamT m a
pure = m a -> StreamT m a
forall (m :: Type -> Type) a. Functor m => m a -> StreamT m a
constM (m a -> StreamT m a) -> (a -> m a) -> a -> StreamT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
  {-# INLINE pure #-}

  StreamT s
stateF0 s -> m (Result s (a -> b))
stepF <*> :: forall a b. StreamT m (a -> b) -> StreamT m a -> StreamT m b
<*> StreamT s
stateA0 s -> m (Result s a)
stepA =
    JointState s s
-> (JointState s s -> m (Result (JointState s s) b)) -> StreamT m b
forall (m :: Type -> Type) a s.
s -> (s -> m (Result s a)) -> StreamT m a
StreamT (s -> s -> JointState s s
forall a b. a -> b -> JointState a b
JointState s
stateF0 s
stateA0) (\(JointState s
stateF s
stateA) -> Result s (a -> b) -> Result s a -> Result (JointState s s) b
forall s1 a b s2.
Result s1 (a -> b) -> Result s2 a -> Result (JointState s1 s2) b
apResult (Result s (a -> b) -> Result s a -> Result (JointState s s) b)
-> m (Result s (a -> b))
-> m (Result s a -> Result (JointState s s) b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s (a -> b))
stepF s
stateF m (Result s a -> Result (JointState s s) b)
-> m (Result s a) -> m (Result (JointState s s) b)
forall a b. m (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> s -> m (Result s a)
stepA s
stateA)
  {-# INLINE (<*>) #-}

instance (Foldable m) => Foldable (StreamT m) where
  foldMap :: forall m a. Monoid m => (a -> m) -> StreamT m a -> m
foldMap a -> m
f StreamT {s
state :: ()
state :: s
state, s -> m (Result s a)
step :: ()
step :: s -> m (Result s a)
step} = s -> m
go s
state
    where
      go :: s -> m
go s
s = s -> m (Result s a)
step s
s m (Result s a) -> (m (Result s a) -> m) -> m
forall a b. a -> (a -> b) -> b
& (Result s a -> m) -> m (Result s a) -> m
forall m a. Monoid m => (a -> m) -> m a -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Result s
s' a
a) -> a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> s -> m
go s
s')

instance (Traversable m, Functor m) => Traversable (StreamT m) where
  traverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> StreamT m a -> f (StreamT m b)
traverse a -> f b
f = (Recursive m b -> StreamT m b)
-> f (Recursive m b) -> f (StreamT m b)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Recursive m b -> StreamT m b
forall (m :: Type -> Type) a. Recursive m a -> StreamT m a
fromRecursive (f (Recursive m b) -> f (StreamT m b))
-> (StreamT m a -> f (Recursive m b))
-> StreamT m a
-> f (StreamT m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> Recursive m a -> f (Recursive m b)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Recursive m a -> f (Recursive m b)
traverse a -> f b
f (Recursive m a -> f (Recursive m b))
-> (StreamT m a -> Recursive m a)
-> StreamT m a
-> f (Recursive m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamT m a -> Recursive m a
forall (m :: Type -> Type) a.
Functor m =>
StreamT m a -> Recursive m a
toRecursive

deriving via Ap (StreamT m) a instance (Applicative m, Num a) => Num (StreamT m a)

instance (Applicative m, Fractional a) => Fractional (StreamT m a) where
  fromRational :: Rational -> StreamT m a
fromRational = a -> StreamT m a
forall a. a -> StreamT m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a -> StreamT m a) -> (Rational -> a) -> Rational -> StreamT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
  recip :: StreamT m a -> StreamT m a
recip = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip

instance (Applicative m, Floating a) => Floating (StreamT m a) where
  pi :: StreamT m a
pi = a -> StreamT m a
forall a. a -> StreamT m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
forall a. Floating a => a
pi
  exp :: StreamT m a -> StreamT m a
exp = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
exp
  log :: StreamT m a -> StreamT m a
log = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
log
  sin :: StreamT m a -> StreamT m a
sin = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sin
  cos :: StreamT m a -> StreamT m a
cos = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cos
  asin :: StreamT m a -> StreamT m a
asin = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asin
  acos :: StreamT m a -> StreamT m a
acos = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acos
  atan :: StreamT m a -> StreamT m a
atan = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atan
  sinh :: StreamT m a -> StreamT m a
sinh = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sinh
  cosh :: StreamT m a -> StreamT m a
cosh = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cosh
  asinh :: StreamT m a -> StreamT m a
asinh = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asinh
  acosh :: StreamT m a -> StreamT m a
acosh = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acosh
  atanh :: StreamT m a -> StreamT m a
atanh = (a -> a) -> StreamT m a -> StreamT m a
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atanh

instance (VectorSpace v s, Eq s, Floating s, Applicative m) => VectorSpace (StreamT m v) (StreamT m s) where
  zeroVector :: StreamT m v
zeroVector = v -> StreamT m v
forall a. a -> StreamT m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure v
forall v a. VectorSpace v a => v
zeroVector
  *^ :: StreamT m s -> StreamT m v -> StreamT m v
(*^) = (s -> v -> v) -> StreamT m s -> StreamT m v -> StreamT m v
forall a b c.
(a -> b -> c) -> StreamT m a -> StreamT m b -> StreamT m c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 s -> v -> v
forall v a. VectorSpace v a => a -> v -> v
(*^)
  ^+^ :: StreamT m v -> StreamT m v -> StreamT m v
(^+^) = (v -> v -> v) -> StreamT m v -> StreamT m v -> StreamT m v
forall a b c.
(a -> b -> c) -> StreamT m a -> StreamT m b -> StreamT m c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
(^+^)
  dot :: StreamT m v -> StreamT m v -> StreamT m s
dot = (v -> v -> s) -> StreamT m v -> StreamT m v -> StreamT m s
forall a b c.
(a -> b -> c) -> StreamT m a -> StreamT m b -> StreamT m c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> v -> s
forall v a. VectorSpace v a => v -> v -> a
dot
  normalize :: StreamT m v -> StreamT m v
normalize = (v -> v) -> StreamT m v -> StreamT m v
forall a b. (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> v
forall v a. VectorSpace v a => v -> v
normalize

{- | 'empty' just performs 'empty' in the underlying monad @m@.
  @s1 '<|>' s2@ starts in an undecided state,
  and explores the possibilities of continuing in @s1@ or @s2@
  on the first tick, using the underlying @m@.
-}
instance (Alternative m) => Alternative (StreamT m) where
  empty :: forall a. StreamT m a
empty = m a -> StreamT m a
forall (m :: Type -> Type) a. Functor m => m a -> StreamT m a
constM m a
forall a. m a
forall (f :: Type -> Type) a. Alternative f => f a
empty
  {-# INLINE empty #-}

  StreamT s
stateL0 s -> m (Result s a)
stepL <|> :: forall a. StreamT m a -> StreamT m a -> StreamT m a
<|> StreamT s
stateR0 s -> m (Result s a)
stepR =
    StreamT
      { state :: Alternatively s s
state = Alternatively s s
forall stateL stateR. Alternatively stateL stateR
Undecided
      , step :: Alternatively s s -> m (Result (Alternatively s s) a)
step = \case
          Alternatively s s
Undecided -> ((s -> Alternatively s s)
-> Result s a -> Result (Alternatively s s) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState s -> Alternatively s s
forall stateL stateR. stateL -> Alternatively stateL stateR
DecideL (Result s a -> Result (Alternatively s s) a)
-> m (Result s a) -> m (Result (Alternatively s s) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s a)
stepL s
stateL0) m (Result (Alternatively s s) a)
-> m (Result (Alternatively s s) a)
-> m (Result (Alternatively s s) a)
forall a. m a -> m a -> m a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ((s -> Alternatively s s)
-> Result s a -> Result (Alternatively s s) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState s -> Alternatively s s
forall stateL stateR. stateR -> Alternatively stateL stateR
DecideR (Result s a -> Result (Alternatively s s) a)
-> m (Result s a) -> m (Result (Alternatively s s) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s a)
stepR s
stateR0)
          DecideL s
stateL -> (s -> Alternatively s s)
-> Result s a -> Result (Alternatively s s) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState s -> Alternatively s s
forall stateL stateR. stateL -> Alternatively stateL stateR
DecideL (Result s a -> Result (Alternatively s s) a)
-> m (Result s a) -> m (Result (Alternatively s s) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s a)
stepL s
stateL
          DecideR s
stateR -> (s -> Alternatively s s)
-> Result s a -> Result (Alternatively s s) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState s -> Alternatively s s
forall stateL stateR. stateR -> Alternatively stateL stateR
DecideR (Result s a -> Result (Alternatively s s) a)
-> m (Result s a) -> m (Result (Alternatively s s) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s a)
stepR s
stateR
      }
  {-# INLINE (<|>) #-}

  many :: forall a. StreamT m a -> StreamT m [a]
many StreamT {s
state :: ()
state :: s
state, s -> m (Result s a)
step :: ()
step :: s -> m (Result s a)
step} = (forall s. s -> Many s s)
-> (forall {s}.
    s
    -> (s -> m (Result s [a]))
    -> Many s s
    -> m (Result (Many s s) [a]))
-> StreamT m [a]
forall (m :: Type -> Type) (t :: Type -> Type) a.
Functor m =>
(forall s. s -> t s)
-> (forall s.
    s -> (s -> m (Result s a)) -> t s -> m (Result (t s) a))
-> StreamT m a
fixStream'
    (Many s s -> s -> Many s s
forall a b. a -> b -> a
const Many s s
forall state x. Many state x
NotStarted)
    ((forall {s}.
  s
  -> (s -> m (Result s [a]))
  -> Many s s
  -> m (Result (Many s s) [a]))
 -> StreamT m [a])
-> (forall {s}.
    s
    -> (s -> m (Result s [a]))
    -> Many s s
    -> m (Result (Many s s) [a]))
-> StreamT m [a]
forall a b. (a -> b) -> a -> b
$ \s
fixstate s -> m (Result s [a])
fixstep -> \case
      Many s s
NotStarted -> ((\(Result s
s' a
a) (Result s
ss' [a]
as) -> Many s s -> [a] -> Result (Many s s) [a]
forall s a. s -> a -> Result s a
Result (s -> s -> Many s s
forall state x. x -> state -> Many state x
Ongoing s
ss' s
s') ([a] -> Result (Many s s) [a]) -> [a] -> Result (Many s s) [a]
forall a b. (a -> b) -> a -> b
$ a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as) (Result s a -> Result s [a] -> Result (Many s s) [a])
-> m (Result s a) -> m (Result s [a] -> Result (Many s s) [a])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s a)
step s
state m (Result s [a] -> Result (Many s s) [a])
-> m (Result s [a]) -> m (Result (Many s s) [a])
forall a b. m (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> s -> m (Result s [a])
fixstep s
fixstate) m (Result (Many s s) [a])
-> m (Result (Many s s) [a]) -> m (Result (Many s s) [a])
forall a. m a -> m a -> m a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Result (Many s s) [a] -> m (Result (Many s s) [a])
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Many s s -> [a] -> Result (Many s s) [a]
forall s a. s -> a -> Result s a
Result Many s s
forall state x. Many state x
Finished [])
      Many s s
Finished -> Result (Many s s) [a] -> m (Result (Many s s) [a])
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result (Many s s) [a] -> m (Result (Many s s) [a]))
-> Result (Many s s) [a] -> m (Result (Many s s) [a])
forall a b. (a -> b) -> a -> b
$! Many s s -> [a] -> Result (Many s s) [a]
forall s a. s -> a -> Result s a
Result Many s s
forall state x. Many state x
Finished []
      Ongoing s
ss s
s -> (\(Result s
s' a
a) (Result s
ss' [a]
as) -> Many s s -> [a] -> Result (Many s s) [a]
forall s a. s -> a -> Result s a
Result (s -> s -> Many s s
forall state x. x -> state -> Many state x
Ongoing s
ss' s
s') ([a] -> Result (Many s s) [a]) -> [a] -> Result (Many s s) [a]
forall a b. (a -> b) -> a -> b
$ a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as) (Result s a -> Result s [a] -> Result (Many s s) [a])
-> m (Result s a) -> m (Result s [a] -> Result (Many s s) [a])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s a)
step s
s m (Result s [a] -> Result (Many s s) [a])
-> m (Result s [a]) -> m (Result (Many s s) [a])
forall a b. m (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> s -> m (Result s [a])
fixstep s
ss
  {-# INLINE many #-}

  some :: forall a. StreamT m a -> StreamT m [a]
some StreamT m a
stream = (:) (a -> [a] -> [a]) -> StreamT m a -> StreamT m ([a] -> [a])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> StreamT m a
stream StreamT m ([a] -> [a]) -> StreamT m [a] -> StreamT m [a]
forall a b. StreamT m (a -> b) -> StreamT m a -> StreamT m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> StreamT m a -> StreamT m [a]
forall a. StreamT m a -> StreamT m [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many StreamT m a
stream
  {-# INLINE some #-}

instance MFunctor StreamT where
  hoist :: forall (m :: Type -> Type) (n :: Type -> Type) b.
Monad m =>
(forall a. m a -> n a) -> StreamT m b -> StreamT n b
hoist = (forall x. m x -> n x) -> StreamT m b -> StreamT n b
forall (m1 :: Type -> Type) (m2 :: Type -> Type) a.
(forall x. m1 x -> m2 x) -> StreamT m1 a -> StreamT m2 a
hoist'
  {-# INLINE hoist #-}

{- | Hoist a stream along a monad morphism, by applying said morphism to the step function.

This is like @mmorph@'s 'hoist', but it doesn't require a 'Monad' constraint on @m2@.
-}
hoist' :: (forall x. m1 x -> m2 x) -> StreamT m1 a -> StreamT m2 a
hoist' :: forall (m1 :: Type -> Type) (m2 :: Type -> Type) a.
(forall x. m1 x -> m2 x) -> StreamT m1 a -> StreamT m2 a
hoist' forall x. m1 x -> m2 x
f StreamT {s
state :: ()
state :: s
state, s -> m1 (Result s a)
step :: ()
step :: s -> m1 (Result s a)
step} = StreamT {s
state :: s
state :: s
state, step :: s -> m2 (Result s a)
step = m1 (Result s a) -> m2 (Result s a)
forall x. m1 x -> m2 x
f (m1 (Result s a) -> m2 (Result s a))
-> (s -> m1 (Result s a)) -> s -> m2 (Result s a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m1 (Result s a)
step}
{-# INLINE hoist' #-}

-- * Running streams

-- | Perform one step of a stream, resulting in an updated stream and an output value.
stepStream :: (Functor m) => StreamT m a -> m (Result (StreamT m a) a)
stepStream :: forall (m :: Type -> Type) a.
Functor m =>
StreamT m a -> m (Result (StreamT m a) a)
stepStream StreamT {s
state :: ()
state :: s
state, s -> m (Result s a)
step :: ()
step :: s -> m (Result s a)
step} = (s -> StreamT m a) -> Result s a -> Result (StreamT m a) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState (s -> (s -> m (Result s a)) -> StreamT m a
forall (m :: Type -> Type) a s.
s -> (s -> m (Result s a)) -> StreamT m a
`StreamT` s -> m (Result s a)
step) (Result s a -> Result (StreamT m a) a)
-> m (Result s a) -> m (Result (StreamT m a) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s a)
step s
state
{-# INLINE stepStream #-}

{- | Run a stream with trivial output.

If the output of a stream does not contain information,
all of its meaning is in its effects.
This function runs the stream indefinitely.
Since it will never return with a value, this function also has no output (its output is void).
The only way it can return is if @m@ includes some effect of termination,
e.g. 'Maybe' or 'Either' could terminate with a 'Nothing' or 'Left' value,
or 'IO' can raise an exception.
-}
reactimate :: (Monad m) => StreamT m () -> m void
reactimate :: forall (m :: Type -> Type) void. Monad m => StreamT m () -> m void
reactimate StreamT {s
state :: ()
state :: s
state, s -> m (Result s ())
step :: ()
step :: s -> m (Result s ())
step} = s -> m void
go s
state
  where
    go :: s -> m void
go s
s = do
      Result s
s' () <- s -> m (Result s ())
step s
s
      s -> m void
go s
s'
{-# INLINE reactimate #-}

-- | Run a stream, collecting the outputs in a lazy, infinite list.
streamToList :: (Monad m) => StreamT m a -> m [a]
streamToList :: forall (m :: Type -> Type) a. Monad m => StreamT m a -> m [a]
streamToList StreamT {s
state :: ()
state :: s
state, s -> m (Result s a)
step :: ()
step :: s -> m (Result s a)
step} = s -> m [a]
go s
state
  where
    go :: s -> m [a]
go s
s = do
      Result s
s' a
a <- s -> m (Result s a)
step s
s
      (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m [a]
go s
s'
{-# INLINE streamToList #-}

-- * Modifying streams

-- | Change the output type and effect of a stream without changing its state type.
withStreamT :: (Functor m, Functor n) => (forall s. m (Result s a) -> n (Result s b)) -> StreamT m a -> StreamT n b
withStreamT :: forall (m :: Type -> Type) (n :: Type -> Type) a b.
(Functor m, Functor n) =>
(forall s. m (Result s a) -> n (Result s b))
-> StreamT m a -> StreamT n b
withStreamT forall s. m (Result s a) -> n (Result s b)
f StreamT {s
state :: ()
state :: s
state, s -> m (Result s a)
step :: ()
step :: s -> m (Result s a)
step} = s -> (s -> n (Result s b)) -> StreamT n b
forall (m :: Type -> Type) a s.
s -> (s -> m (Result s a)) -> StreamT m a
StreamT s
state ((s -> n (Result s b)) -> StreamT n b)
-> (s -> n (Result s b)) -> StreamT n b
forall a b. (a -> b) -> a -> b
$ (m (Result s a) -> n (Result s b))
-> (s -> m (Result s a)) -> s -> n (Result s b)
forall a b. (a -> b) -> (s -> a) -> s -> b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap m (Result s a) -> n (Result s b)
forall s. m (Result s a) -> n (Result s b)
f s -> m (Result s a)
step
{-# INLINE withStreamT #-}

{- | Buffer the output of a stream, returning one value at a time.

This function lets a stream control the speed at which it produces data,
since it can decide to produce any amount of output at every step.
-}
concatS :: (Monad m) => StreamT m [a] -> StreamT m a
concatS :: forall (m :: Type -> Type) a.
Monad m =>
StreamT m [a] -> StreamT m a
concatS StreamT {s
state :: ()
state :: s
state, s -> m (Result s [a])
step :: ()
step :: s -> m (Result s [a])
step} =
  StreamT
    { state :: (s, [a])
state = (s
state, [])
    , step :: (s, [a]) -> m (Result (s, [a]) a)
step = (s, [a]) -> m (Result (s, [a]) a)
go
    }
  where
    go :: (s, [a]) -> m (Result (s, [a]) a)
go (s
s, []) = do
      Result s
s' [a]
as <- s -> m (Result s [a])
step s
s
      (s, [a]) -> m (Result (s, [a]) a)
go (s
s', [a]
as)
    go (s
s, a
a : [a]
as) = Result (s, [a]) a -> m (Result (s, [a]) a)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result (s, [a]) a -> m (Result (s, [a]) a))
-> Result (s, [a]) a -> m (Result (s, [a]) a)
forall a b. (a -> b) -> a -> b
$ (s, [a]) -> a -> Result (s, [a]) a
forall s a. s -> a -> Result s a
Result (s
s, [a]
as) a
a
{-# INLINE concatS #-}

{- | At each step, duplicate the @m@ effect of the current step to the output.

This is useful if @m@ has some means of static analysis, or if you want to re-perform the effects.
-}
snapshot :: (Functor m) => StreamT m a -> StreamT m (m a)
snapshot :: forall (m :: Type -> Type) a.
Functor m =>
StreamT m a -> StreamT m (m a)
snapshot StreamT {s
state :: ()
state :: s
state, s -> m (Result s a)
step :: ()
step :: s -> m (Result s a)
step} =
  StreamT
    { s
state :: s
state :: s
state
    , step :: s -> m (Result s (m a))
step = \s
s ->
        let result :: m (Result s a)
result = s -> m (Result s a)
step s
s
         in (s -> m a -> Result s (m a)) -> m a -> s -> Result s (m a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip s -> m a -> Result s (m a)
forall s a. s -> a -> Result s a
Result (Result s a -> a
forall s a. Result s a -> a
output (Result s a -> a) -> m (Result s a) -> m a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Result s a)
result) (s -> Result s (m a))
-> (Result s a -> s) -> Result s a -> Result s (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result s a -> s
forall s a. Result s a -> s
resultState (Result s a -> Result s (m a))
-> m (Result s a) -> m (Result s (m a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Result s a)
result
    }

-- ** Exception handling

{- | Streams with exceptions are 'Applicative' in the exception type.

Run the first stream until it throws a function as an exception,
then run the second one. If the second one ever throws an exception,
apply the function thrown by the first one to it.
-}
applyExcept :: (Monad m) => StreamT (ExceptT (e1 -> e2) m) a -> StreamT (ExceptT e1 m) a -> StreamT (ExceptT e2 m) a
applyExcept :: forall (m :: Type -> Type) e1 e2 a.
Monad m =>
StreamT (ExceptT (e1 -> e2) m) a
-> StreamT (ExceptT e1 m) a -> StreamT (ExceptT e2 m) a
applyExcept (StreamT s
state1 s -> ExceptT (e1 -> e2) m (Result s a)
step1) (StreamT s
state2 s -> ExceptT e1 m (Result s a)
step2) =
  StreamT
    { state :: Either s (s, e1 -> e2)
state = s -> Either s (s, e1 -> e2)
forall a b. a -> Either a b
Left s
state1
    , Either s (s, e1 -> e2)
-> ExceptT e2 m (Result (Either s (s, e1 -> e2)) a)
step :: Either s (s, e1 -> e2)
-> ExceptT e2 m (Result (Either s (s, e1 -> e2)) a)
step :: Either s (s, e1 -> e2)
-> ExceptT e2 m (Result (Either s (s, e1 -> e2)) a)
step
    }
  where
    step :: Either s (s, e1 -> e2)
-> ExceptT e2 m (Result (Either s (s, e1 -> e2)) a)
step (Left s
s1) = do
      Either (e1 -> e2) (Result s a)
resultOrException <- m (Either (e1 -> e2) (Result s a))
-> ExceptT e2 m (Either (e1 -> e2) (Result s a))
forall (m :: Type -> Type) a. Monad m => m a -> ExceptT e2 m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either (e1 -> e2) (Result s a))
 -> ExceptT e2 m (Either (e1 -> e2) (Result s a)))
-> m (Either (e1 -> e2) (Result s a))
-> ExceptT e2 m (Either (e1 -> e2) (Result s a))
forall a b. (a -> b) -> a -> b
$ ExceptT (e1 -> e2) m (Result s a)
-> m (Either (e1 -> e2) (Result s a))
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (e1 -> e2) m (Result s a)
 -> m (Either (e1 -> e2) (Result s a)))
-> ExceptT (e1 -> e2) m (Result s a)
-> m (Either (e1 -> e2) (Result s a))
forall a b. (a -> b) -> a -> b
$ s -> ExceptT (e1 -> e2) m (Result s a)
step1 s
s1
      case Either (e1 -> e2) (Result s a)
resultOrException of
        Right Result s a
result -> Result (Either s (s, e1 -> e2)) a
-> ExceptT e2 m (Result (Either s (s, e1 -> e2)) a)
forall a. a -> ExceptT e2 m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result (Either s (s, e1 -> e2)) a
 -> ExceptT e2 m (Result (Either s (s, e1 -> e2)) a))
-> Result (Either s (s, e1 -> e2)) a
-> ExceptT e2 m (Result (Either s (s, e1 -> e2)) a)
forall a b. (a -> b) -> a -> b
$! (s -> Either s (s, e1 -> e2))
-> Result s a -> Result (Either s (s, e1 -> e2)) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState s -> Either s (s, e1 -> e2)
forall a b. a -> Either a b
Left Result s a
result
        Left e1 -> e2
f -> Either s (s, e1 -> e2)
-> ExceptT e2 m (Result (Either s (s, e1 -> e2)) a)
step ((s, e1 -> e2) -> Either s (s, e1 -> e2)
forall a b. b -> Either a b
Right (s
state2, e1 -> e2
f))
    step (Right (s
s2, e1 -> e2
f)) = (s -> Either s (s, e1 -> e2))
-> Result s a -> Result (Either s (s, e1 -> e2)) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState ((s, e1 -> e2) -> Either s (s, e1 -> e2)
forall a b. b -> Either a b
Right ((s, e1 -> e2) -> Either s (s, e1 -> e2))
-> (s -> (s, e1 -> e2)) -> s -> Either s (s, e1 -> e2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,e1 -> e2
f)) (Result s a -> Result (Either s (s, e1 -> e2)) a)
-> ExceptT e2 m (Result s a)
-> ExceptT e2 m (Result (Either s (s, e1 -> e2)) a)
forall (m :: Type -> Type) a b. Monad m => (a -> b) -> m a -> m b
<$!> (e1 -> e2)
-> ExceptT e1 m (Result s a) -> ExceptT e2 m (Result s a)
forall (m :: Type -> Type) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT e1 -> e2
f (s -> ExceptT e1 m (Result s a)
step2 s
s2)
{-# INLINE applyExcept #-}

{- | Execute the stream until it throws an exception, then restart it.

One might be tempted to define this function recursively with 'applyExcept',
but this would result in a runtime error, trying to define an infinite state.
-}
foreverExcept :: (Functor m, Monad m) => StreamT (ExceptT e m) a -> StreamT m a
foreverExcept :: forall (m :: Type -> Type) e a.
(Functor m, Monad m) =>
StreamT (ExceptT e m) a -> StreamT m a
foreverExcept StreamT {s
state :: ()
state :: s
state, s -> ExceptT e m (Result s a)
step :: ()
step :: s -> ExceptT e m (Result s a)
step} =
  StreamT
    { s
state :: s
state :: s
state
    , step :: s -> m (Result s a)
step = s -> m (Result s a)
stepNew
    }
  where
    stepNew :: s -> m (Result s a)
stepNew s
s = do
      Either e (Result s a)
resultOrException <- ExceptT e m (Result s a) -> m (Either e (Result s a))
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e m (Result s a) -> m (Either e (Result s a)))
-> ExceptT e m (Result s a) -> m (Either e (Result s a))
forall a b. (a -> b) -> a -> b
$ s -> ExceptT e m (Result s a)
step s
s
      case Either e (Result s a)
resultOrException of
        Left e
_ -> s -> m (Result s a)
stepNew s
state
        Right Result s a
result -> Result s a -> m (Result s a)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Result s a
result

-- | Whenever an exception occurs, output it and retry on the next step.
exceptS :: (Applicative m) => StreamT (ExceptT e m) b -> StreamT m (Either e b)
exceptS :: forall (m :: Type -> Type) e b.
Applicative m =>
StreamT (ExceptT e m) b -> StreamT m (Either e b)
exceptS StreamT {s
state :: ()
state :: s
state, s -> ExceptT e m (Result s b)
step :: ()
step :: s -> ExceptT e m (Result s b)
step} =
  StreamT
    { step :: s -> m (Result s (Either e b))
step = \s
state -> (Either e (Result s b) -> Result s (Either e b))
-> m (Either e (Result s b)) -> m (Result s (Either e b))
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> Result s (Either e b))
-> (Result s b -> Result s (Either e b))
-> Either e (Result s b)
-> Result s (Either e b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (s -> Either e b -> Result s (Either e b)
forall s a. s -> a -> Result s a
Result s
state (Either e b -> Result s (Either e b))
-> (e -> Either e b) -> e -> Result s (Either e b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e b
forall a b. a -> Either a b
Left) ((b -> Either e b) -> Result s b -> Result s (Either e b)
forall a b. (a -> b) -> Result s a -> Result s b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either e b
forall a b. b -> Either a b
Right)) (m (Either e (Result s b)) -> m (Result s (Either e b)))
-> m (Either e (Result s b)) -> m (Result s (Either e b))
forall a b. (a -> b) -> a -> b
$ ExceptT e m (Result s b) -> m (Either e (Result s b))
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e m (Result s b) -> m (Either e (Result s b)))
-> ExceptT e m (Result s b) -> m (Either e (Result s b))
forall a b. (a -> b) -> a -> b
$ s -> ExceptT e m (Result s b)
step s
state
    , s
state :: s
state :: s
state
    }
{-# INLINE exceptS #-}

{- | Run the first stream until it throws an exception.
  If the exception is 'Right', throw it immediately.
  If it is 'Left', run the second stream until it throws a function, which is then applied to the first exception.
-}
selectExcept :: (Monad m) => StreamT (ExceptT (Either e1 e2) m) a -> StreamT (ExceptT (e1 -> e2) m) a -> StreamT (ExceptT e2 m) a
selectExcept :: forall (m :: Type -> Type) e1 e2 a.
Monad m =>
StreamT (ExceptT (Either e1 e2) m) a
-> StreamT (ExceptT (e1 -> e2) m) a -> StreamT (ExceptT e2 m) a
selectExcept (StreamT s
stateE0 s -> ExceptT (Either e1 e2) m (Result s a)
stepE) (StreamT s
stateF0 s -> ExceptT (e1 -> e2) m (Result s a)
stepF) =
  StreamT
    { state :: Either s (e1, s)
state = s -> Either s (e1, s)
forall a b. a -> Either a b
Left s
stateE0
    , Either s (e1, s) -> ExceptT e2 m (Result (Either s (e1, s)) a)
step :: Either s (e1, s) -> ExceptT e2 m (Result (Either s (e1, s)) a)
step :: Either s (e1, s) -> ExceptT e2 m (Result (Either s (e1, s)) a)
step
    }
  where
    step :: Either s (e1, s) -> ExceptT e2 m (Result (Either s (e1, s)) a)
step (Left s
stateE) = do
      Either (Either e1 e2) (Result s a)
resultOrException <- m (Either (Either e1 e2) (Result s a))
-> ExceptT e2 m (Either (Either e1 e2) (Result s a))
forall (m :: Type -> Type) a. Monad m => m a -> ExceptT e2 m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either (Either e1 e2) (Result s a))
 -> ExceptT e2 m (Either (Either e1 e2) (Result s a)))
-> m (Either (Either e1 e2) (Result s a))
-> ExceptT e2 m (Either (Either e1 e2) (Result s a))
forall a b. (a -> b) -> a -> b
$ ExceptT (Either e1 e2) m (Result s a)
-> m (Either (Either e1 e2) (Result s a))
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (Either e1 e2) m (Result s a)
 -> m (Either (Either e1 e2) (Result s a)))
-> ExceptT (Either e1 e2) m (Result s a)
-> m (Either (Either e1 e2) (Result s a))
forall a b. (a -> b) -> a -> b
$ s -> ExceptT (Either e1 e2) m (Result s a)
stepE s
stateE
      case Either (Either e1 e2) (Result s a)
resultOrException of
        Right Result s a
result -> Result (Either s (e1, s)) a
-> ExceptT e2 m (Result (Either s (e1, s)) a)
forall a. a -> ExceptT e2 m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result (Either s (e1, s)) a
 -> ExceptT e2 m (Result (Either s (e1, s)) a))
-> Result (Either s (e1, s)) a
-> ExceptT e2 m (Result (Either s (e1, s)) a)
forall a b. (a -> b) -> a -> b
$ (s -> Either s (e1, s))
-> Result s a -> Result (Either s (e1, s)) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState s -> Either s (e1, s)
forall a b. a -> Either a b
Left Result s a
result
        Left (Left e1
e1) -> Either s (e1, s) -> ExceptT e2 m (Result (Either s (e1, s)) a)
step ((e1, s) -> Either s (e1, s)
forall a b. b -> Either a b
Right (e1
e1, s
stateF0))
        Left (Right e2
e2) -> e2 -> ExceptT e2 m (Result (Either s (e1, s)) a)
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE e2
e2
    step (Right (e1
e1, s
stateF)) = ((e1 -> e2) -> e2)
-> ExceptT (e1 -> e2) m (Result (Either s (e1, s)) a)
-> ExceptT e2 m (Result (Either s (e1, s)) a)
forall (m :: Type -> Type) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ((e1 -> e2) -> e1 -> e2
forall a b. (a -> b) -> a -> b
$ e1
e1) (ExceptT (e1 -> e2) m (Result (Either s (e1, s)) a)
 -> ExceptT e2 m (Result (Either s (e1, s)) a))
-> ExceptT (e1 -> e2) m (Result (Either s (e1, s)) a)
-> ExceptT e2 m (Result (Either s (e1, s)) a)
forall a b. (a -> b) -> a -> b
$ (s -> Either s (e1, s))
-> Result s a -> Result (Either s (e1, s)) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState ((e1, s) -> Either s (e1, s)
forall a b. b -> Either a b
Right ((e1, s) -> Either s (e1, s))
-> (s -> (e1, s)) -> s -> Either s (e1, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e1
e1,)) (Result s a -> Result (Either s (e1, s)) a)
-> ExceptT (e1 -> e2) m (Result s a)
-> ExceptT (e1 -> e2) m (Result (Either s (e1, s)) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> ExceptT (e1 -> e2) m (Result s a)
stepF s
stateF

instance (Selective m) => Selective (StreamT m) where
  select :: forall a b.
StreamT m (Either a b) -> StreamT m (a -> b) -> StreamT m b
select (StreamT s
stateE0 s -> m (Result s (Either a b))
stepE) (StreamT s
stateF0 s -> m (Result s (a -> b))
stepF) =
    StreamT
      { state :: JointState s s
state = s -> s -> JointState s s
forall a b. a -> b -> JointState a b
JointState s
stateE0 s
stateF0
      , step :: JointState s s -> m (Result (JointState s s) b)
step = \(JointState s
stateE s
stateF) ->
          ((Result s b -> Result (JointState s s) b)
-> Either (Result s a) (Result s b)
-> Either (Result s a) (Result (JointState s s) b)
forall a b.
(a -> b) -> Either (Result s a) a -> Either (Result s a) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> JointState s s) -> Result s b -> Result (JointState s s) b
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState (s -> s -> JointState s s
forall a b. a -> b -> JointState a b
`JointState` s
stateF)) (Either (Result s a) (Result s b)
 -> Either (Result s a) (Result (JointState s s) b))
-> (Result s (Either a b) -> Either (Result s a) (Result s b))
-> Result s (Either a b)
-> Either (Result s a) (Result (JointState s s) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result s (Either a b) -> Either (Result s a) (Result s b)
forall s a b.
Result s (Either a b) -> Either (Result s a) (Result s b)
eitherResult (Result s (Either a b)
 -> Either (Result s a) (Result (JointState s s) b))
-> m (Result s (Either a b))
-> m (Either (Result s a) (Result (JointState s s) b))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s (Either a b))
stepE s
stateE)
            m (Either (Result s a) (Result (JointState s s) b))
-> m (Result s a -> Result (JointState s s) b)
-> m (Result (JointState s s) b)
forall (f :: Type -> Type) a b.
Selective f =>
f (Either a b) -> f (a -> b) -> f b
<*? ((\(Result s
stateF' a -> b
f) (Result s
stateE' a
a) -> JointState s s -> b -> Result (JointState s s) b
forall s a. s -> a -> Result s a
Result (s -> s -> JointState s s
forall a b. a -> b -> JointState a b
JointState s
stateE' s
stateF') (a -> b
f a
a)) (Result s (a -> b) -> Result s a -> Result (JointState s s) b)
-> m (Result s (a -> b))
-> m (Result s a -> Result (JointState s s) b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s (a -> b))
stepF s
stateF)
      }
    where
      eitherResult :: Result s (Either a b) -> Either (Result s a) (Result s b)
      eitherResult :: forall s a b.
Result s (Either a b) -> Either (Result s a) (Result s b)
eitherResult (Result s
s Either a b
eab) = (a -> Result s a)
-> (b -> Result s b)
-> Either a b
-> Either (Result s a) (Result s b)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: Type -> Type -> Type) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (s -> a -> Result s a
forall s a. s -> a -> Result s a
Result s
s) (s -> b -> Result s b
forall s a. s -> a -> Result s a
Result s
s) Either a b
eab

{- | Run both streams in parallel and use @'Semialign' m@ to decide which stream produces output.
  If you understand @m@ as an effect that models the passage of time, then 'align' runs both streams concurrently.
-}
instance (Semialign m) => Semialign (StreamT m) where
  align :: forall a b. StreamT m a -> StreamT m b -> StreamT m (These a b)
align (StreamT s
s10 s -> m (Result s a)
step1) (StreamT s
s20 s -> m (Result s b)
step2) =
    StreamT
      { state :: JointState s s
state = s -> s -> JointState s s
forall a b. a -> b -> JointState a b
JointState s
s10 s
s20
      , step :: JointState s s -> m (Result (JointState s s) (These a b))
step = \(JointState s
s1 s
s2) -> m (Result s a)
-> m (Result s b) -> m (These (Result s a) (Result s b))
forall a b. m a -> m b -> m (These a b)
forall (f :: Type -> Type) a b.
Semialign f =>
f a -> f b -> f (These a b)
align (s -> m (Result s a)
step1 s
s1) (s -> m (Result s b)
step2 s
s2) m (These (Result s a) (Result s b))
-> (These (Result s a) (Result s b)
    -> Result (JointState s s) (These a b))
-> m (Result (JointState s s) (These a b))
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> s
-> s
-> These (Result s a) (Result s b)
-> Result (JointState s s) (These a b)
forall s1 s2 a b.
s1
-> s2
-> These (Result s1 a) (Result s2 b)
-> Result (JointState s1 s2) (These a b)
updateTheseState s
s1 s
s2
      }
    where
      updateTheseState :: s1 -> s2 -> These (Result s1 a) (Result s2 b) -> Result (JointState s1 s2) (These a b)
      updateTheseState :: forall s1 s2 a b.
s1
-> s2
-> These (Result s1 a) (Result s2 b)
-> Result (JointState s1 s2) (These a b)
updateTheseState s1
_s1 s2
s2 (This (Result s1
s1 a
a)) = JointState s1 s2
-> These a b -> Result (JointState s1 s2) (These a b)
forall s a. s -> a -> Result s a
Result (s1 -> s2 -> JointState s1 s2
forall a b. a -> b -> JointState a b
JointState s1
s1 s2
s2) (These a b -> Result (JointState s1 s2) (These a b))
-> These a b -> Result (JointState s1 s2) (These a b)
forall a b. (a -> b) -> a -> b
$ a -> These a b
forall a b. a -> These a b
This a
a
      updateTheseState s1
s1 s2
_s2 (That (Result s2
s2 b
b)) = JointState s1 s2
-> These a b -> Result (JointState s1 s2) (These a b)
forall s a. s -> a -> Result s a
Result (s1 -> s2 -> JointState s1 s2
forall a b. a -> b -> JointState a b
JointState s1
s1 s2
s2) (These a b -> Result (JointState s1 s2) (These a b))
-> These a b -> Result (JointState s1 s2) (These a b)
forall a b. (a -> b) -> a -> b
$ b -> These a b
forall a b. b -> These a b
That b
b
      updateTheseState s1
_ s2
_ (These (Result s1
s1 a
a) (Result s2
s2 b
b)) = JointState s1 s2
-> These a b -> Result (JointState s1 s2) (These a b)
forall s a. s -> a -> Result s a
Result (s1 -> s2 -> JointState s1 s2
forall a b. a -> b -> JointState a b
JointState s1
s1 s2
s2) (These a b -> Result (JointState s1 s2) (These a b))
-> These a b -> Result (JointState s1 s2) (These a b)
forall a b. (a -> b) -> a -> b
$ a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b
  {-# INLINE align #-}

instance (Align m) => Align (StreamT m) where
  nil :: forall a. StreamT m a
nil = m a -> StreamT m a
forall (m :: Type -> Type) a. Functor m => m a -> StreamT m a
constM m a
forall a. m a
forall (f :: Type -> Type) a. Align f => f a
nil
  {-# INLINE nil #-}

-- ** Fix points, or recursive definitions

{- | Recursively define a stream from a recursive definition of the state, and of the step function.

If you want to define a stream recursively, this is not possible directly.
For example, consider this definition:
@
loops :: Monad m => StreamT m [Int]
loops = (:) <$> unfold_ 0 (+ 1) <*> loops
@
The defined value @loops@ contains itself in its definition.
This means that the internal state type of @loops@ must itself be recursively defined.
But GHC cannot do this automatically, because type level and value level are separate.
Instead, we need to spell out the type level recursion explicitly with a type constructor,
over which we will take the fixpoint.

In this example, we can figure out from the definitions that:
1. @'unfold_' 0 (+ 1)@ has @0 :: Int@ as state
2. '(:)' does not change the state
3. '<*>' takes the product of both states

So the internal state @s@ of @loops@ must satisfy the equation @s = (Int, s)@.
If the recursion is written as above, it tries to compute the infinite tuple @(Int, (Int, (Int, ...)))@, which hangs.
Instead, we need to define a type operator over which we take the fixpoint:

@
-- You need to write this:
data Loops x = Loops Int x

-- The library supplies:
data Fix f = Fix f (Fix f)
type LoopsState = Fix Loops
@

We can then use 'fixStream' to define the recursive definition of @loops@.
For this, we have to to tediously inline the definitions of 'unfold_', '(:)', and '<*>',
until we arrive at an explicit recursive definition of the state and the step function of @loops@, separately.
These are the two arguments of 'fixStream'.

@
loops :: Monad m => StreamT m [Int]
loops = fixStream (Loops 0) $ \fixStep (Loops n fixState) -> do
  Result s' a <- fixStep fixState
  return $ Result (Loops (n + 1) s') a
@
-}
fixStream ::
  (Functor m) =>
  -- | The recursive definition of the state of the stream.
  (forall s. s -> t s) ->
  -- | The recursive definition of the step function of the stream.
  ( forall s.
    (s -> m (Result s a)) ->
    (t s -> m (Result (t s) a))
  ) ->
  StreamT m a
fixStream :: forall (m :: Type -> Type) (t :: Type -> Type) a.
Functor m =>
(forall s. s -> t s)
-> (forall s. (s -> m (Result s a)) -> t s -> m (Result (t s) a))
-> StreamT m a
fixStream forall s. s -> t s
transformState forall s. (s -> m (Result s a)) -> t s -> m (Result (t s) a)
transformStep =
  StreamT
    { state :: Fix t
state = (forall s. s -> t s) -> Fix t
forall (t :: Type -> Type). (forall s. s -> t s) -> Fix t
fixState s -> t s
forall s. s -> t s
transformState
    , Fix t -> m (Result (Fix t) a)
step :: Fix t -> m (Result (Fix t) a)
step :: Fix t -> m (Result (Fix t) a)
step
    }
  where
    step :: Fix t -> m (Result (Fix t) a)
step Fix {t (Fix t)
getFix :: t (Fix t)
getFix :: forall (t :: Type -> Type). Fix t -> t (Fix t)
getFix} = (t (Fix t) -> Fix t) -> Result (t (Fix t)) a -> Result (Fix t) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState t (Fix t) -> Fix t
forall (t :: Type -> Type). t (Fix t) -> Fix t
Fix (Result (t (Fix t)) a -> Result (Fix t) a)
-> m (Result (t (Fix t)) a) -> m (Result (Fix t) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Fix t -> m (Result (Fix t) a))
-> t (Fix t) -> m (Result (t (Fix t)) a)
forall s. (s -> m (Result s a)) -> t s -> m (Result (t s) a)
transformStep Fix t -> m (Result (Fix t) a)
step t (Fix t)
getFix

-- | A generalisation of 'fixStream' where the step definition is allowed to depend on the state.
fixStream' ::
  (Functor m) =>
  (forall s. s -> t s) ->
  -- | The recursive definition of the state of the stream.
  (forall s. s -> (s -> m (Result s a)) -> (t s -> m (Result (t s) a))) ->
  -- | The recursive definition of the step function of the stream.
  StreamT m a
fixStream' :: forall (m :: Type -> Type) (t :: Type -> Type) a.
Functor m =>
(forall s. s -> t s)
-> (forall s.
    s -> (s -> m (Result s a)) -> t s -> m (Result (t s) a))
-> StreamT m a
fixStream' forall s. s -> t s
transformState forall s. s -> (s -> m (Result s a)) -> t s -> m (Result (t s) a)
transformStep =
  StreamT
    { state :: Fix t
state = (forall s. s -> t s) -> Fix t
forall (t :: Type -> Type). (forall s. s -> t s) -> Fix t
fixState s -> t s
forall s. s -> t s
transformState
    , Fix t -> m (Result (Fix t) a)
step :: Fix t -> m (Result (Fix t) a)
step :: Fix t -> m (Result (Fix t) a)
step
    }
  where
    step :: Fix t -> m (Result (Fix t) a)
step fix :: Fix t
fix@(Fix {t (Fix t)
getFix :: forall (t :: Type -> Type). Fix t -> t (Fix t)
getFix :: t (Fix t)
getFix}) = (t (Fix t) -> Fix t) -> Result (t (Fix t)) a -> Result (Fix t) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState t (Fix t) -> Fix t
forall (t :: Type -> Type). t (Fix t) -> Fix t
Fix (Result (t (Fix t)) a -> Result (Fix t) a)
-> m (Result (t (Fix t)) a) -> m (Result (Fix t) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Fix t
-> (Fix t -> m (Result (Fix t) a))
-> t (Fix t)
-> m (Result (t (Fix t)) a)
forall s. s -> (s -> m (Result s a)) -> t s -> m (Result (t s) a)
transformStep Fix t
fix Fix t -> m (Result (Fix t) a)
step t (Fix t)
getFix

{- | The solution to the equation @'fixA' stream = stream <*> 'fixA' stream@.

Such a fix point operator needs to be used instead of the above direct definition because recursive definitions of streams
loop at runtime due to the coalgebraic encoding of the state.
-}
fixA :: (Applicative m) => StreamT m (a -> a) -> StreamT m a
fixA :: forall (m :: Type -> Type) a.
Applicative m =>
StreamT m (a -> a) -> StreamT m a
fixA StreamT {s
state :: ()
state :: s
state, s -> m (Result s (a -> a))
step :: ()
step :: s -> m (Result s (a -> a))
step} = (forall s. s -> JointState s s)
-> (forall {s}.
    (s -> m (Result s a))
    -> JointState s s -> m (Result (JointState s s) a))
-> StreamT m a
forall (m :: Type -> Type) (t :: Type -> Type) a.
Functor m =>
(forall s. s -> t s)
-> (forall s. (s -> m (Result s a)) -> t s -> m (Result (t s) a))
-> StreamT m a
fixStream (s -> s -> JointState s s
forall a b. a -> b -> JointState a b
JointState s
state) ((forall {s}.
  (s -> m (Result s a))
  -> JointState s s -> m (Result (JointState s s) a))
 -> StreamT m a)
-> (forall {s}.
    (s -> m (Result s a))
    -> JointState s s -> m (Result (JointState s s) a))
-> StreamT m a
forall a b. (a -> b) -> a -> b
$
  \s -> m (Result s a)
stepA (JointState s
s s
ss) -> Result s (a -> a) -> Result s a -> Result (JointState s s) a
forall s1 a b s2.
Result s1 (a -> b) -> Result s2 a -> Result (JointState s1 s2) b
apResult (Result s (a -> a) -> Result s a -> Result (JointState s s) a)
-> m (Result s (a -> a))
-> m (Result s a -> Result (JointState s s) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s (a -> a))
step s
s m (Result s a -> Result (JointState s s) a)
-> m (Result s a) -> m (Result (JointState s s) a)
forall a b. m (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> s -> m (Result s a)
stepA s
ss

-- * Effect handling

-- | Lift the monad of a stream into a transformer.
liftS :: (Monad m, MonadTrans t) => StreamT m a -> StreamT (t m) a
liftS :: forall (m :: Type -> Type) (t :: (Type -> Type) -> Type -> Type) a.
(Monad m, MonadTrans t) =>
StreamT m a -> StreamT (t m) a
liftS = (forall a. m a -> t m a) -> StreamT m a -> StreamT (t m) a
forall {k} (t :: (Type -> Type) -> k -> Type) (m :: Type -> Type)
       (n :: Type -> Type) (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: Type -> Type) (n :: Type -> Type) b.
Monad m =>
(forall a. m a -> n a) -> StreamT m b -> StreamT n b
hoist m a -> t m a
forall a. m a -> t m a
forall (m :: Type -> Type) a. Monad m => m a -> t m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

{- | Continuously interpret a first order effect.

Several types are relevant here:

* @sig@: An effect signature functor, that encodes one effect.
  For example, @'Either' e@ for raising exceptions of type @e@, or @(w, )@ for a logging effect.
* @eff@: A monad that carries the effect.
  This can be a monad transformer stack including a transformer corresponding to @sig@, such as 'ExceptT' for 'Either'.
  It can also be the @Eff@ monad of an effect library such as @polysemy@, @bluefin@, @effectful@ and so on.
* @m@: The underlying monad in which the interpretation is performed, think "@eff@ without the effects from @sig@".

This function takes two functions, one to create effects in @eff@ from the signature, and the other to fully interpret them in @m@,
storing the complete effect information in @sig@ again.
It then executes the given automaton, extracting the effect by interpretation, and sending it back in.
The execution semantics is that of the monad @eff@, while the pure effect of the whole computation is returned in the output, encoded in @sig@.

For examples, see 'handleExceptT', 'handleWriterT' and similar functions below.
-}
handleEffect ::
  (Monad m, Monad eff, Functor sig) =>
  -- | Send a declarative effect in the signature to the effect carrier monad.
  (forall x. sig x -> eff x) ->
  -- | Interpret the effect in @m@, returning its result in the signature.
  (forall x. eff x -> m (sig x)) ->
  StreamT eff a ->
  StreamT m (sig a)
handleEffect :: forall (m :: Type -> Type) (eff :: Type -> Type)
       (sig :: Type -> Type) a.
(Monad m, Monad eff, Functor sig) =>
(forall x. sig x -> eff x)
-> (forall x. eff x -> m (sig x))
-> StreamT eff a
-> StreamT m (sig a)
handleEffect forall x. sig x -> eff x
send forall x. eff x -> m (sig x)
interpret StreamT {s
state :: ()
state :: s
state, s -> eff (Result s a)
step :: ()
step :: s -> eff (Result s a)
step} =
  StreamT
    { state :: eff s
state = s -> eff s
forall a. a -> eff a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure s
state
    , step :: eff s -> m (Result (eff s) (sig a))
step = \eff s
s -> do
        sig (Result s a)
results <- eff (Result s a) -> m (sig (Result s a))
forall x. eff x -> m (sig x)
interpret (eff (Result s a) -> m (sig (Result s a)))
-> eff (Result s a) -> m (sig (Result s a))
forall a b. (a -> b) -> a -> b
$ s -> eff (Result s a)
step (s -> eff (Result s a)) -> eff s -> eff (Result s a)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< eff s
s
        Result (eff s) (sig a) -> m (Result (eff s) (sig a))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result (eff s) (sig a) -> m (Result (eff s) (sig a)))
-> Result (eff s) (sig a) -> m (Result (eff s) (sig a))
forall a b. (a -> b) -> a -> b
$! (sig s -> eff s)
-> Result (sig s) (sig a) -> Result (eff s) (sig a)
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState sig s -> eff s
forall x. sig x -> eff x
send (Result (sig s) (sig a) -> Result (eff s) (sig a))
-> Result (sig s) (sig a) -> Result (eff s) (sig a)
forall a b. (a -> b) -> a -> b
$ sig (Result s a) -> Result (sig s) (sig a)
forall (f :: Type -> Type) s a.
Functor f =>
f (Result s a) -> Result (f s) (f a)
unzipResult sig (Result s a)
results
    }

-- | Execute a stream until it throws an exception, then output the exception forever.
handleExceptT :: (Monad m) => StreamT (ExceptT e m) a -> StreamT m (Either e a)
handleExceptT :: forall (m :: Type -> Type) e a.
Monad m =>
StreamT (ExceptT e m) a -> StreamT m (Either e a)
handleExceptT = (forall x. Either e x -> ExceptT e m x)
-> (forall x. ExceptT e m x -> m (Either e x))
-> StreamT (ExceptT e m) a
-> StreamT m (Either e a)
forall (m :: Type -> Type) (eff :: Type -> Type)
       (sig :: Type -> Type) a.
(Monad m, Monad eff, Functor sig) =>
(forall x. sig x -> eff x)
-> (forall x. eff x -> m (sig x))
-> StreamT eff a
-> StreamT m (sig a)
handleEffect Either e x -> ExceptT e m x
forall x. Either e x -> ExceptT e m x
forall (m :: Type -> Type) e a.
Monad m =>
Either e a -> ExceptT e m a
except ExceptT e m x -> m (Either e x)
forall x. ExceptT e m x -> m (Either e x)
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT

-- | Return the accumulated log at every step alongside the value.
handleWriterT :: (Monad m, Monoid w) => StreamT (WriterT w m) a -> StreamT m (w, a)
handleWriterT :: forall (m :: Type -> Type) w a.
(Monad m, Monoid w) =>
StreamT (WriterT w m) a -> StreamT m (w, a)
handleWriterT = (forall x. (w, x) -> WriterT w m x)
-> (forall x. WriterT w m x -> m (w, x))
-> StreamT (WriterT w m) a
-> StreamT m (w, a)
forall (m :: Type -> Type) (eff :: Type -> Type)
       (sig :: Type -> Type) a.
(Monad m, Monad eff, Functor sig) =>
(forall x. sig x -> eff x)
-> (forall x. eff x -> m (sig x))
-> StreamT eff a
-> StreamT m (sig a)
handleEffect ((x, w) -> WriterT w m x
forall (m :: Type -> Type) a w. Monad m => (a, w) -> WriterT w m a
writer ((x, w) -> WriterT w m x)
-> ((w, x) -> (x, w)) -> (w, x) -> WriterT w m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w, x) -> (x, w)
forall a b. (a, b) -> (b, a)
swap) (((x, w) -> (w, x)) -> m (x, w) -> m (w, x)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (x, w) -> (w, x)
forall a b. (a, b) -> (b, a)
swap (m (x, w) -> m (w, x))
-> (WriterT w m x -> m (x, w)) -> WriterT w m x -> m (w, x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m x -> m (x, w)
forall w (m :: Type -> Type) a. WriterT w m a -> m (a, w)
runWriterT)

-- | Execute a stream until it stops, then output 'Nothing' forever.
handleMaybeT :: (Monad m) => StreamT (MaybeT m) a -> StreamT m (Maybe a)
handleMaybeT :: forall (m :: Type -> Type) a.
Monad m =>
StreamT (MaybeT m) a -> StreamT m (Maybe a)
handleMaybeT = (forall x. Maybe x -> MaybeT m x)
-> (forall x. MaybeT m x -> m (Maybe x))
-> StreamT (MaybeT m) a
-> StreamT m (Maybe a)
forall (m :: Type -> Type) (eff :: Type -> Type)
       (sig :: Type -> Type) a.
(Monad m, Monad eff, Functor sig) =>
(forall x. sig x -> eff x)
-> (forall x. eff x -> m (sig x))
-> StreamT eff a
-> StreamT m (sig a)
handleEffect (m (Maybe x) -> MaybeT m x
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe x) -> MaybeT m x)
-> (Maybe x -> m (Maybe x)) -> Maybe x -> MaybeT m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe x -> m (Maybe x)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure) MaybeT m x -> m (Maybe x)
forall x. MaybeT m x -> m (Maybe x)
forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT