-- |
-- Module      : Control.Monad.Stream
-- Copyright   : Oleg Kiselyov, Sebastian Fischer, David A Roberts
-- License     : BSD3
-- 
-- Maintainer  : David A Roberts <d@vidr.cc>
-- Stability   : experimental
-- Portability : portable
-- 
-- This Haskell library provides an implementation of the MonadPlus
-- type class that enumerates results of a non-deterministic
-- computation by interleaving subcomputations in a way that has
-- usually much better memory performance than other strategies with
-- the same termination properties.
-- 
-- By using supensions in strategic positions, the user can ensure
-- that the search does not diverge if there are remaining
-- non-deterministic results.
-- 
-- More information is available on the author's website:
-- <http://okmij.org/ftp/Computation/monads.html#fair-bt-stream>
-- 
-- Warning: @Stream@ is only a monad when the results of @observeAll@
-- are interpreted as a multiset, i.e., a valid transformation
-- according to the monad laws may change the order of the results.
-- 
{-# LANGUAGE CPP, FlexibleInstances, LambdaCase,
  MultiParamTypeClasses, UndecidableInstances #-}

module Control.Monad.Stream
  ( StreamT
  , Stream
  , suspended
  , runStream
  , observe
  , observeT
  , observeAll
  , observeAllT
  , observeMany
  , observeManyT
  , module Control.Monad.Logic.Class
  ) where

import Control.Applicative (Alternative(..), (<**>))
import Control.Monad (MonadPlus(..), liftM)
import qualified Control.Monad.Fail as Fail
import Control.Monad.Identity (Identity(..))
import Control.Monad.Logic.Class
import Control.Monad.Reader.Class (MonadReader(..))
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.Trans (MonadIO(..), MonadTrans(..))
import qualified Data.Foldable as F
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid(..))
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#endif

data StreamF s a
  = Nil
  | Single a
  | Cons a s
  | Susp s

-- |
-- Results of non-deterministic computations of type @StreamT m a@ can be
-- enumerated efficiently.
-- 
newtype StreamT m a =
  StreamT
    { StreamT m a -> m (StreamF (StreamT m a) a)
unStreamT :: m (StreamF (StreamT m a) a)
    }

type Stream = StreamT Identity

-- |
-- Suspensions can be used to ensure fairness.
-- 
suspended :: Monad m => StreamT m a -> StreamT m a
suspended :: StreamT m a -> StreamT m a
suspended = m (StreamF (StreamT m a) a) -> StreamT m a
forall (m :: * -> *) a. m (StreamF (StreamT m a) a) -> StreamT m a
StreamT (m (StreamF (StreamT m a) a) -> StreamT m a)
-> (StreamT m a -> m (StreamF (StreamT m a) a))
-> StreamT m a
-> StreamT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamF (StreamT m a) a -> m (StreamF (StreamT m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (StreamF (StreamT m a) a -> m (StreamF (StreamT m a) a))
-> (StreamT m a -> StreamF (StreamT m a) a)
-> StreamT m a
-> m (StreamF (StreamT m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamT m a -> StreamF (StreamT m a) a
forall s a. s -> StreamF s a
Susp

cons :: Monad m => a -> StreamT m a -> StreamT m a
cons :: a -> StreamT m a -> StreamT m a
cons a
a = m (StreamF (StreamT m a) a) -> StreamT m a
forall (m :: * -> *) a. m (StreamF (StreamT m a) a) -> StreamT m a
StreamT (m (StreamF (StreamT m a) a) -> StreamT m a)
-> (StreamT m a -> m (StreamF (StreamT m a) a))
-> StreamT m a
-> StreamT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamF (StreamT m a) a -> m (StreamF (StreamT m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (StreamF (StreamT m a) a -> m (StreamF (StreamT m a) a))
-> (StreamT m a -> StreamF (StreamT m a) a)
-> StreamT m a
-> m (StreamF (StreamT m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StreamT m a -> StreamF (StreamT m a) a
forall s a. a -> s -> StreamF s a
Cons a
a

bind ::
     Monad m
  => StreamT m a
  -> (StreamF (StreamT m a) a -> StreamT m b)
  -> StreamT m b
bind :: StreamT m a
-> (StreamF (StreamT m a) a -> StreamT m b) -> StreamT m b
bind StreamT m a
m StreamF (StreamT m a) a -> StreamT m b
f = m (StreamF (StreamT m b) b) -> StreamT m b
forall (m :: * -> *) a. m (StreamF (StreamT m a) a) -> StreamT m a
StreamT (m (StreamF (StreamT m b) b) -> StreamT m b)
-> m (StreamF (StreamT m b) b) -> StreamT m b
forall a b. (a -> b) -> a -> b
$ StreamT m a -> m (StreamF (StreamT m a) a)
forall (m :: * -> *) a. StreamT m a -> m (StreamF (StreamT m a) a)
unStreamT StreamT m a
m m (StreamF (StreamT m a) a)
-> (StreamF (StreamT m a) a -> m (StreamF (StreamT m b) b))
-> m (StreamF (StreamT m b) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StreamT m b -> m (StreamF (StreamT m b) b)
forall (m :: * -> *) a. StreamT m a -> m (StreamF (StreamT m a) a)
unStreamT (StreamT m b -> m (StreamF (StreamT m b) b))
-> (StreamF (StreamT m a) a -> StreamT m b)
-> StreamF (StreamT m a) a
-> m (StreamF (StreamT m b) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamF (StreamT m a) a -> StreamT m b
f

-- |
-- The function @runStream@ enumerates the results of a
-- non-deterministic computation.
-- 
runStream :: Stream a -> [a]
runStream :: Stream a -> [a]
runStream = Stream a -> [a]
forall a. Stream a -> [a]
observeAll

{-# DEPRECATED
runStream "use observeAll"
 #-}

instance Monad m => Monad (StreamT m) where
  return :: a -> StreamT m a
return = a -> StreamT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  StreamT m a
m >>= :: StreamT m a -> (a -> StreamT m b) -> StreamT m b
>>= a -> StreamT m b
f =
    StreamT m a
m StreamT m a
-> (StreamF (StreamT m a) a -> StreamT m b) -> StreamT m b
forall (m :: * -> *) a b.
Monad m =>
StreamT m a
-> (StreamF (StreamT m a) a -> StreamT m b) -> StreamT m b
`bind` \case
      StreamF (StreamT m a) a
Nil -> StreamT m b
forall (f :: * -> *) a. Alternative f => f a
empty
      Single a
x -> a -> StreamT m b
f a
x
      Cons a
x StreamT m a
xs -> a -> StreamT m b
f a
x StreamT m b -> StreamT m b -> StreamT m b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StreamT m b -> StreamT m b
forall (m :: * -> *) a. Monad m => StreamT m a -> StreamT m a
suspended (StreamT m a
xs StreamT m a -> (a -> StreamT m b) -> StreamT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> StreamT m b
f)
      Susp StreamT m a
xs -> StreamT m b -> StreamT m b
forall (m :: * -> *) a. Monad m => StreamT m a -> StreamT m a
suspended (StreamT m a
xs StreamT m a -> (a -> StreamT m b) -> StreamT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> StreamT m b
f)
#if !MIN_VERSION_base(4,13,0)
  fail = Fail.fail
#endif
instance Monad m => Fail.MonadFail (StreamT m) where
  fail :: String -> StreamT m a
fail String
_ = StreamT m a
forall (f :: * -> *) a. Alternative f => f a
empty

instance Monad m => Alternative (StreamT m) where
  empty :: StreamT m a
empty = m (StreamF (StreamT m a) a) -> StreamT m a
forall (m :: * -> *) a. m (StreamF (StreamT m a) a) -> StreamT m a
StreamT (m (StreamF (StreamT m a) a) -> StreamT m a)
-> m (StreamF (StreamT m a) a) -> StreamT m a
forall a b. (a -> b) -> a -> b
$ StreamF (StreamT m a) a -> m (StreamF (StreamT m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return StreamF (StreamT m a) a
forall s a. StreamF s a
Nil
  StreamT m a
m <|> :: StreamT m a -> StreamT m a -> StreamT m a
<|> StreamT m a
ys =
    StreamT m a
m StreamT m a
-> (StreamF (StreamT m a) a -> StreamT m a) -> StreamT m a
forall (m :: * -> *) a b.
Monad m =>
StreamT m a
-> (StreamF (StreamT m a) a -> StreamT m b) -> StreamT m b
`bind` \case
      StreamF (StreamT m a) a
Nil -> StreamT m a -> StreamT m a
forall (m :: * -> *) a. Monad m => StreamT m a -> StreamT m a
suspended StreamT m a
ys -- suspending
      Single a
x -> a -> StreamT m a -> StreamT m a
forall (m :: * -> *) a. Monad m => a -> StreamT m a -> StreamT m a
cons a
x StreamT m a
ys
      Cons a
x StreamT m a
xs -> a -> StreamT m a -> StreamT m a
forall (m :: * -> *) a. Monad m => a -> StreamT m a -> StreamT m a
cons a
x (StreamT m a
ys StreamT m a -> StreamT m a -> StreamT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StreamT m a
xs) -- interleaving
      Susp StreamT m a
xs ->
        StreamT m a
ys StreamT m a
-> (StreamF (StreamT m a) a -> StreamT m a) -> StreamT m a
forall (m :: * -> *) a b.
Monad m =>
StreamT m a
-> (StreamF (StreamT m a) a -> StreamT m b) -> StreamT m b
`bind` \case
          StreamF (StreamT m a) a
Nil -> StreamT m a -> StreamT m a
forall (m :: * -> *) a. Monad m => StreamT m a -> StreamT m a
suspended StreamT m a
xs
          Single a
y -> a -> StreamT m a -> StreamT m a
forall (m :: * -> *) a. Monad m => a -> StreamT m a -> StreamT m a
cons a
y StreamT m a
xs
          Cons a
y StreamT m a
ys' -> a -> StreamT m a -> StreamT m a
forall (m :: * -> *) a. Monad m => a -> StreamT m a -> StreamT m a
cons a
y (StreamT m a
xs StreamT m a -> StreamT m a -> StreamT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StreamT m a
ys')
          Susp StreamT m a
ys' -> StreamT m a -> StreamT m a
forall (m :: * -> *) a. Monad m => StreamT m a -> StreamT m a
suspended (StreamT m a
xs StreamT m a -> StreamT m a -> StreamT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StreamT m a
ys')

instance Monad m => MonadPlus (StreamT m) where
  mzero :: StreamT m a
mzero = StreamT m a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: StreamT m a -> StreamT m a -> StreamT m a
mplus = StreamT m a -> StreamT m a -> StreamT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
#if MIN_VERSION_base(4,9,0)
instance Monad m => Semigroup (StreamT m a) where
  <> :: StreamT m a -> StreamT m a -> StreamT m a
(<>) = StreamT m a -> StreamT m a -> StreamT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
  sconcat :: NonEmpty (StreamT m a) -> StreamT m a
sconcat = (StreamT m a -> StreamT m a -> StreamT m a)
-> NonEmpty (StreamT m a) -> StreamT m a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 StreamT m a -> StreamT m a -> StreamT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
#endif
instance Monad m => Monoid (StreamT m a) where
  mempty :: StreamT m a
mempty = StreamT m a
forall (f :: * -> *) a. Alternative f => f a
empty
  mappend :: StreamT m a -> StreamT m a -> StreamT m a
mappend = StreamT m a -> StreamT m a -> StreamT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  mconcat :: [StreamT m a] -> StreamT m a
mconcat = [StreamT m a] -> StreamT m a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum

instance Monad m => Functor (StreamT m) where
  fmap :: (a -> b) -> StreamT m a -> StreamT m b
fmap a -> b
f StreamT m a
m =
    StreamT m a
m StreamT m a
-> (StreamF (StreamT m a) a -> StreamT m b) -> StreamT m b
forall (m :: * -> *) a b.
Monad m =>
StreamT m a
-> (StreamF (StreamT m a) a -> StreamT m b) -> StreamT m b
`bind` \case
      StreamF (StreamT m a) a
Nil -> StreamT m b
forall (f :: * -> *) a. Alternative f => f a
empty
      Single a
x -> b -> StreamT m b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x)
      Cons a
x StreamT m a
xs -> b -> StreamT m b -> StreamT m b
forall (m :: * -> *) a. Monad m => a -> StreamT m a -> StreamT m a
cons (a -> b
f a
x) ((a -> b) -> StreamT m a -> StreamT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f StreamT m a
xs)
      Susp StreamT m a
xs -> StreamT m b -> StreamT m b
forall (m :: * -> *) a. Monad m => StreamT m a -> StreamT m a
suspended ((a -> b) -> StreamT m a -> StreamT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f StreamT m a
xs)

instance Monad m => Applicative (StreamT m) where
  pure :: a -> StreamT m a
pure = m (StreamF (StreamT m a) a) -> StreamT m a
forall (m :: * -> *) a. m (StreamF (StreamT m a) a) -> StreamT m a
StreamT (m (StreamF (StreamT m a) a) -> StreamT m a)
-> (a -> m (StreamF (StreamT m a) a)) -> a -> StreamT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamF (StreamT m a) a -> m (StreamF (StreamT m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (StreamF (StreamT m a) a -> m (StreamF (StreamT m a) a))
-> (a -> StreamF (StreamT m a) a)
-> a
-> m (StreamF (StreamT m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StreamF (StreamT m a) a
forall s a. a -> StreamF s a
Single
  StreamT m (a -> b)
m <*> :: StreamT m (a -> b) -> StreamT m a -> StreamT m b
<*> StreamT m a
xs =
    StreamT m (a -> b)
m StreamT m (a -> b)
-> (StreamF (StreamT m (a -> b)) (a -> b) -> StreamT m b)
-> StreamT m b
forall (m :: * -> *) a b.
Monad m =>
StreamT m a
-> (StreamF (StreamT m a) a -> StreamT m b) -> StreamT m b
`bind` \case
      StreamF (StreamT m (a -> b)) (a -> b)
Nil -> StreamT m b
forall (f :: * -> *) a. Alternative f => f a
empty
      Single a -> b
f -> (a -> b) -> StreamT m a -> StreamT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f StreamT m a
xs
      Cons a -> b
f StreamT m (a -> b)
fs -> (a -> b) -> StreamT m a -> StreamT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f StreamT m a
xs StreamT m b -> StreamT m b -> StreamT m b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StreamT m a
xs StreamT m a -> StreamT m (a -> b) -> StreamT m b
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> StreamT m (a -> b)
fs)
      Susp StreamT m (a -> b)
fs -> StreamT m b -> StreamT m b
forall (m :: * -> *) a. Monad m => StreamT m a -> StreamT m a
suspended (StreamT m a
xs StreamT m a -> StreamT m (a -> b) -> StreamT m b
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> StreamT m (a -> b)
fs)

instance Monad m => MonadLogic (StreamT m) where
  >>- :: StreamT m a -> (a -> StreamT m b) -> StreamT m b
(>>-) = StreamT m a -> (a -> StreamT m b) -> StreamT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
  interleave :: StreamT m a -> StreamT m a -> StreamT m a
interleave = StreamT m a -> StreamT m a -> StreamT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
  msplit :: StreamT m a -> StreamT m (Maybe (a, StreamT m a))
msplit StreamT m a
m =
    StreamT m a
m StreamT m a
-> (StreamF (StreamT m a) a -> StreamT m (Maybe (a, StreamT m a)))
-> StreamT m (Maybe (a, StreamT m a))
forall (m :: * -> *) a b.
Monad m =>
StreamT m a
-> (StreamF (StreamT m a) a -> StreamT m b) -> StreamT m b
`bind` \case
      StreamF (StreamT m a) a
Nil -> Maybe (a, StreamT m a) -> StreamT m (Maybe (a, StreamT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, StreamT m a)
forall a. Maybe a
Nothing
      Single a
x -> Maybe (a, StreamT m a) -> StreamT m (Maybe (a, StreamT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (a, StreamT m a) -> StreamT m (Maybe (a, StreamT m a)))
-> Maybe (a, StreamT m a) -> StreamT m (Maybe (a, StreamT m a))
forall a b. (a -> b) -> a -> b
$ (a, StreamT m a) -> Maybe (a, StreamT m a)
forall a. a -> Maybe a
Just (a
x, StreamT m a
forall (f :: * -> *) a. Alternative f => f a
empty)
      Cons a
x StreamT m a
xs -> Maybe (a, StreamT m a) -> StreamT m (Maybe (a, StreamT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (a, StreamT m a) -> StreamT m (Maybe (a, StreamT m a)))
-> Maybe (a, StreamT m a) -> StreamT m (Maybe (a, StreamT m a))
forall a b. (a -> b) -> a -> b
$ (a, StreamT m a) -> Maybe (a, StreamT m a)
forall a. a -> Maybe a
Just (a
x, StreamT m a -> StreamT m a
forall (m :: * -> *) a. Monad m => StreamT m a -> StreamT m a
suspended StreamT m a
xs)
      Susp StreamT m a
xs -> StreamT m (Maybe (a, StreamT m a))
-> StreamT m (Maybe (a, StreamT m a))
forall (m :: * -> *) a. Monad m => StreamT m a -> StreamT m a
suspended (StreamT m (Maybe (a, StreamT m a))
 -> StreamT m (Maybe (a, StreamT m a)))
-> StreamT m (Maybe (a, StreamT m a))
-> StreamT m (Maybe (a, StreamT m a))
forall a b. (a -> b) -> a -> b
$ StreamT m a -> StreamT m (Maybe (a, StreamT m a))
forall (m :: * -> *) a. MonadLogic m => m a -> m (Maybe (a, m a))
msplit StreamT m a
xs

instance MonadTrans StreamT where
  lift :: m a -> StreamT m a
lift = m (StreamF (StreamT m a) a) -> StreamT m a
forall (m :: * -> *) a. m (StreamF (StreamT m a) a) -> StreamT m a
StreamT (m (StreamF (StreamT m a) a) -> StreamT m a)
-> (m a -> m (StreamF (StreamT m a) a)) -> m a -> StreamT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> StreamF (StreamT m a) a)
-> m a -> m (StreamF (StreamT m a) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> StreamF (StreamT m a) a
forall s a. a -> StreamF s a
Single

instance MonadIO m => MonadIO (StreamT m) where
  liftIO :: IO a -> StreamT m a
liftIO = m a -> StreamT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StreamT m a) -> (IO a -> m a) -> IO a -> StreamT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadReader r m => MonadReader r (StreamT m) where
  ask :: StreamT m r
ask = m r -> StreamT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: (r -> r) -> StreamT m a -> StreamT m a
local r -> r
f = m (StreamF (StreamT m a) a) -> StreamT m a
forall (m :: * -> *) a. m (StreamF (StreamT m a) a) -> StreamT m a
StreamT (m (StreamF (StreamT m a) a) -> StreamT m a)
-> (StreamT m a -> m (StreamF (StreamT m a) a))
-> StreamT m a
-> StreamT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r)
-> m (StreamF (StreamT m a) a) -> m (StreamF (StreamT m a) a)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (m (StreamF (StreamT m a) a) -> m (StreamF (StreamT m a) a))
-> (StreamT m a -> m (StreamF (StreamT m a) a))
-> StreamT m a
-> m (StreamF (StreamT m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamT m a -> m (StreamF (StreamT m a) a)
forall (m :: * -> *) a. StreamT m a -> m (StreamF (StreamT m a) a)
unStreamT

instance MonadState s m => MonadState s (StreamT m) where
  get :: StreamT m s
get = m s -> StreamT m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> StreamT m ()
put = m () -> StreamT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StreamT m ()) -> (s -> m ()) -> s -> StreamT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance (Monad m, Foldable m) => Foldable (StreamT m) where
  foldMap :: (a -> m) -> StreamT m a -> m
foldMap a -> m
f = (StreamF (StreamT m a) a -> m) -> m (StreamF (StreamT m a) a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap StreamF (StreamT m a) a -> m
forall (t :: * -> *). Foldable t => StreamF (t a) a -> m
g (m (StreamF (StreamT m a) a) -> m)
-> (StreamT m a -> m (StreamF (StreamT m a) a)) -> StreamT m a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamT m a -> m (StreamF (StreamT m a) a)
forall (m :: * -> *) a. StreamT m a -> m (StreamF (StreamT m a) a)
unStreamT
    where
      g :: StreamF (t a) a -> m
g StreamF (t a) a
Nil = m
forall a. Monoid a => a
mempty
      g (Single a
x) = a -> m
f a
x
      g (Cons a
x t a
xs) = a -> m
f a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f t a
xs
      g (Susp t a
xs) = (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f t a
xs

instance (Monad m, Traversable m) => Traversable (StreamT m) where
  traverse :: (a -> f b) -> StreamT m a -> f (StreamT m b)
traverse a -> f b
f = (m (StreamF (StreamT m b) b) -> StreamT m b)
-> f (m (StreamF (StreamT m b) b)) -> f (StreamT m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (StreamF (StreamT m b) b) -> StreamT m b
forall (m :: * -> *) a. m (StreamF (StreamT m a) a) -> StreamT m a
StreamT (f (m (StreamF (StreamT m b) b)) -> f (StreamT m b))
-> (StreamT m a -> f (m (StreamF (StreamT m b) b)))
-> StreamT m a
-> f (StreamT m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StreamF (StreamT m a) a -> f (StreamF (StreamT m b) b))
-> m (StreamF (StreamT m a) a) -> f (m (StreamF (StreamT m b) b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse StreamF (StreamT m a) a -> f (StreamF (StreamT m b) b)
forall (t :: * -> *).
Traversable t =>
StreamF (t a) a -> f (StreamF (t b) b)
g (m (StreamF (StreamT m a) a) -> f (m (StreamF (StreamT m b) b)))
-> (StreamT m a -> m (StreamF (StreamT m a) a))
-> StreamT m a
-> f (m (StreamF (StreamT m b) b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamT m a -> m (StreamF (StreamT m a) a)
forall (m :: * -> *) a. StreamT m a -> m (StreamF (StreamT m a) a)
unStreamT
    where
      g :: StreamF (t a) a -> f (StreamF (t b) b)
g StreamF (t a) a
Nil = StreamF (t b) b -> f (StreamF (t b) b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StreamF (t b) b
forall s a. StreamF s a
Nil
      g (Single a
x) = b -> StreamF (t b) b
forall s a. a -> StreamF s a
Single (b -> StreamF (t b) b) -> f b -> f (StreamF (t b) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
      g (Cons a
x t a
xs) = b -> t b -> StreamF (t b) b
forall s a. a -> s -> StreamF s a
Cons (b -> t b -> StreamF (t b) b) -> f b -> f (t b -> StreamF (t b) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x f (t b -> StreamF (t b) b) -> f (t b) -> f (StreamF (t b) b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> t a -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f t a
xs
      g (Susp t a
xs) = t b -> StreamF (t b) b
forall s a. s -> StreamF s a
Susp (t b -> StreamF (t b) b) -> f (t b) -> f (StreamF (t b) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> t a -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f t a
xs

observeAllT :: Monad m => StreamT m a -> m [a]
observeAllT :: StreamT m a -> m [a]
observeAllT StreamT m a
m =
  StreamT m a -> m (StreamF (StreamT m a) a)
forall (m :: * -> *) a. StreamT m a -> m (StreamF (StreamT m a) a)
unStreamT StreamT m a
m m (StreamF (StreamT m a) a)
-> (StreamF (StreamT m a) a -> m [a]) -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    StreamF (StreamT m a) a
Nil -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Single a
a -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a
a]
    Cons a
a StreamT m a
r -> do
      [a]
t <- StreamT m a -> m [a]
forall (m :: * -> *) a. Monad m => StreamT m a -> m [a]
observeAllT StreamT m a
r
      [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
t)
    Susp StreamT m a
r -> StreamT m a -> m [a]
forall (m :: * -> *) a. Monad m => StreamT m a -> m [a]
observeAllT StreamT m a
r

observeAll :: Stream a -> [a]
observeAll :: Stream a -> [a]
observeAll = Identity [a] -> [a]
forall a. Identity a -> a
runIdentity (Identity [a] -> [a])
-> (Stream a -> Identity [a]) -> Stream a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> Identity [a]
forall (m :: * -> *) a. Monad m => StreamT m a -> m [a]
observeAllT

observeManyT :: Monad m => Int -> StreamT m a -> m [a]
observeManyT :: Int -> StreamT m a -> m [a]
observeManyT Int
0 StreamT m a
_ = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
observeManyT Int
n StreamT m a
m =
  StreamT m a -> m (StreamF (StreamT m a) a)
forall (m :: * -> *) a. StreamT m a -> m (StreamF (StreamT m a) a)
unStreamT StreamT m a
m m (StreamF (StreamT m a) a)
-> (StreamF (StreamT m a) a -> m [a]) -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    StreamF (StreamT m a) a
Nil -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Single a
a -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a
a]
    Cons a
a StreamT m a
r -> do
      [a]
t <- Int -> StreamT m a -> m [a]
forall (m :: * -> *) a. Monad m => Int -> StreamT m a -> m [a]
observeManyT (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) StreamT m a
r
      [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
t)
    Susp StreamT m a
r -> Int -> StreamT m a -> m [a]
forall (m :: * -> *) a. Monad m => Int -> StreamT m a -> m [a]
observeManyT Int
n StreamT m a
r

observeMany :: Int -> Stream a -> [a]
observeMany :: Int -> Stream a -> [a]
observeMany Int
n = Identity [a] -> [a]
forall a. Identity a -> a
runIdentity (Identity [a] -> [a])
-> (Stream a -> Identity [a]) -> Stream a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Stream a -> Identity [a]
forall (m :: * -> *) a. Monad m => Int -> StreamT m a -> m [a]
observeManyT Int
n

#if !MIN_VERSION_base(4,13,0)
observeT :: Monad m => StreamT m a -> m a
#else
observeT :: MonadFail m => StreamT m a -> m a
#endif
observeT :: StreamT m a -> m a
observeT StreamT m a
m =
  StreamT m a -> m (StreamF (StreamT m a) a)
forall (m :: * -> *) a. StreamT m a -> m (StreamF (StreamT m a) a)
unStreamT StreamT m a
m m (StreamF (StreamT m a) a)
-> (StreamF (StreamT m a) a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    StreamF (StreamT m a) a
Nil -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No answer."
    Single a
a -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    Cons a
a StreamT m a
_ -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    Susp StreamT m a
r -> StreamT m a -> m a
forall (m :: * -> *) a. MonadFail m => StreamT m a -> m a
observeT StreamT m a
r

observe :: Stream a -> a
observe :: Stream a -> a
observe Stream a
m =
  case Identity (StreamF (Stream a) a) -> StreamF (Stream a) a
forall a. Identity a -> a
runIdentity (Stream a -> Identity (StreamF (Stream a) a)
forall (m :: * -> *) a. StreamT m a -> m (StreamF (StreamT m a) a)
unStreamT Stream a
m) of
    StreamF (Stream a) a
Nil -> String -> a
forall a. HasCallStack => String -> a
error String
"No answer."
    Single a
a -> a
a
    Cons a
a Stream a
_ -> a
a
    Susp Stream a
r -> Stream a -> a
forall a. Stream a -> a
observe Stream a
r