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