{-# 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.Monoid (Ap (..))
import Prelude hiding (Applicative (..))

-- transformers
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE, withExceptT)

-- 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.Result

-- * Creating streams

{- | Effectful streams in initial 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@.

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

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

When two streams are composed, GHC can often optimize the combined step function,
resulting in a faster streams than what the final encoding can ever achieve,
because the final 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 final 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 #-}

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 (<*>) #-}

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 (m :: Type -> Type) a. Monad m => a -> m a
return (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 #-}

-- ** 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 (m :: Type -> Type) a. Monad m => a -> m a
return (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 #-}

-- | 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 (m :: Type -> Type) a. Monad m => a -> m a
return (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

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 :: These s s
state = s -> s -> These s s
forall a b. a -> b -> These a b
These s
s10 s
s20
      , step :: These s s -> m (Result (These s s) (These a b))
step = \case
          This s
s1 -> (s -> These s s)
-> Result s (These a b) -> Result (These s s) (These a b)
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState s -> These s s
forall a b. a -> These a b
This (Result s (These a b) -> Result (These s s) (These a b))
-> (Result s a -> Result s (These a b))
-> Result s a
-> Result (These s s) (These a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> These a b) -> Result s a -> Result s (These a 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 -> These a b
forall a b. a -> These a b
This (Result s a -> Result (These s s) (These a b))
-> m (Result s a) -> m (Result (These s s) (These a b))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s a)
step1 s
s1
          That s
s2 -> (s -> These s s)
-> Result s (These a b) -> Result (These s s) (These a b)
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState s -> These s s
forall a b. b -> These a b
That (Result s (These a b) -> Result (These s s) (These a b))
-> (Result s b -> Result s (These a b))
-> Result s b
-> Result (These s s) (These a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> These a b) -> Result s b -> Result s (These a 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 -> These a b
forall a b. b -> These a b
That (Result s b -> Result (These s s) (These a b))
-> m (Result s b) -> m (Result (These s s) (These a b))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Result s b)
step2 s
s2
          These s
s1 s
s2 -> These (Result s a) (Result s b) -> Result (These s s) (These a b)
forall s1 a1 s2 a2.
These (Result s1 a1) (Result s2 a2)
-> Result (These s1 s2) (These a1 a2)
commuteTheseResult (These (Result s a) (Result s b) -> Result (These s s) (These a b))
-> m (These (Result s a) (Result s b))
-> m (Result (These s s) (These a b))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
      }
    where
      commuteTheseResult :: These (Result s1 a1) (Result s2 a2) -> Result (These s1 s2) (These a1 a2)
      commuteTheseResult :: forall s1 a1 s2 a2.
These (Result s1 a1) (Result s2 a2)
-> Result (These s1 s2) (These a1 a2)
commuteTheseResult (This (Result s1
s1 a1
a1)) = These s1 s2 -> These a1 a2 -> Result (These s1 s2) (These a1 a2)
forall s a. s -> a -> Result s a
Result (s1 -> These s1 s2
forall a b. a -> These a b
This s1
s1) (a1 -> These a1 a2
forall a b. a -> These a b
This a1
a1)
      commuteTheseResult (That (Result s2
s2 a2
a2)) = These s1 s2 -> These a1 a2 -> Result (These s1 s2) (These a1 a2)
forall s a. s -> a -> Result s a
Result (s2 -> These s1 s2
forall a b. b -> These a b
That s2
s2) (a2 -> These a1 a2
forall a b. b -> These a b
That a2
a2)
      commuteTheseResult (These (Result s1
s1 a1
a1) (Result s2
s2 a2
a2)) = These s1 s2 -> These a1 a2 -> Result (These s1 s2) (These a1 a2)
forall s a. s -> a -> Result s a
Result (s1 -> s2 -> These s1 s2
forall a b. a -> b -> These a b
These s1
s1 s2
s2) (a1 -> a2 -> These a1 a2
forall a b. a -> b -> These a b
These a1
a1 a2
a2)
  {-# 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 initial 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