-- |
-- Module      : Streamly.Internal.Data.Stream.StreamD.Eliminate
-- Copyright   : (c) 2018 Composewell Technologies
--               (c) Roman Leshchinskiy 2008-2010
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC

-- A few functions in this module have been adapted from the vector package
-- (c) Roman Leshchinskiy.
--
module Streamly.Internal.Data.Stream.StreamD.Eliminate
    (
    -- * Running a 'Fold'
      fold

    -- -- * Running a 'Parser'
    , parse
    , parse_

    -- * Stream Deconstruction
    , uncons

    -- * Right Folds
    , foldrM
    , foldr
    , foldrMx
    , foldr1

    -- * Left Folds
    , foldlM'
    , foldl'
    , foldlMx'
    , foldlx'

    -- * Specific Fold Functions
    , drain
    , mapM_ -- Map and Fold
    , null
    , head
    , headElse
    , tail
    , last
    , elem
    , notElem
    , all
    , any
    , maximum
    , maximumBy
    , minimum
    , minimumBy
    , lookup
    , findM
    , find
    , (!!)
    , the

    -- * To containers
    , toList
    , toListRev

    -- * Multi-Stream Folds
    -- ** Comparisons
    -- | These should probably be expressed using zipping operations.
    , eqBy
    , cmpBy

    -- ** Substreams
    -- | These should probably be expressed using parsers.
    , isPrefixOf
    , isSubsequenceOf
    , stripPrefix
    )
where

#include "inline.hs"

import Control.Exception (assert)
import Control.Monad.Catch (MonadThrow, throwM)
import GHC.Exts (SpecConstrAnnotation(..))
import GHC.Types (SPEC(..))
import Streamly.Internal.Data.Parser (ParseError(..))
import Streamly.Internal.Data.SVar.Type (defState)

import qualified Streamly.Internal.Data.Parser as PR
import qualified Streamly.Internal.Data.Parser.ParserD as PRD
import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Nesting

import Prelude hiding
       ( all, any, elem, foldr, foldr1, head, last, lookup, mapM, mapM_
       , maximum, minimum, notElem, null, splitAt, tail, (!!))
import Streamly.Internal.Data.Stream.StreamD.Type

------------------------------------------------------------------------------
-- Elimination by Folds
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Right Folds
------------------------------------------------------------------------------

{-# INLINE_NORMAL foldr1 #-}
foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m (Maybe a)
foldr1 :: (a -> a -> a) -> Stream m a -> m (Maybe a)
foldr1 a -> a -> a
f Stream m a
m = do
     Maybe (a, Stream m a)
r <- Stream m a -> m (Maybe (a, Stream m a))
forall (m :: * -> *) a.
Monad m =>
Stream m a -> m (Maybe (a, Stream m a))
uncons Stream m a
m
     case Maybe (a, Stream m a)
r of
         Maybe (a, Stream m a)
Nothing   -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
         Just (a
h, Stream m a
t) -> (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just ((a -> a -> a) -> a -> Stream m a -> m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Stream m a -> m b
foldr a -> a -> a
f a
h Stream m a
t)

------------------------------------------------------------------------------
-- Parsers
------------------------------------------------------------------------------

-- Inlined definition. Without the inline "serially/parser/take" benchmark
-- degrades and parseMany does not fuse. Even using "inline" at the callsite
-- does not help.
{-# INLINE splitAt #-}
splitAt :: Int -> [a] -> ([a],[a])
splitAt :: Int -> [a] -> ([a], [a])
splitAt Int
n [a]
ls
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ([], [a]
ls)
  | Bool
otherwise          = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt' Int
n [a]
ls
    where
        splitAt' :: Int -> [a] -> ([a], [a])
        splitAt' :: Int -> [a] -> ([a], [a])
splitAt' Int
_  []     = ([], [])
        splitAt' Int
1  (a
x:[a]
xs) = ([a
x], [a]
xs)
        splitAt' Int
m  (a
x:[a]
xs) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs', [a]
xs'')
          where
            ([a]
xs', [a]
xs'') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt' (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
xs

-- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need
-- to make a newtype.
{-# ANN type List NoSpecConstr #-}
newtype List a = List {List a -> [a]
getList :: [a]}

-- | Run a 'Parse' over a stream.
{-# INLINE_NORMAL parse #-}
parse
    :: MonadThrow m
    => PRD.Parser m a b
    -> Stream m a
    -> m b
parse :: Parser m a b -> Stream m a -> m b
parse Parser m a b
parser Stream m a
strm = do
    (b
b, Stream m a
_) <- Parser m a b -> Stream m a -> m (b, Stream m a)
forall (m :: * -> *) a b.
MonadThrow m =>
Parser m a b -> Stream m a -> m (b, Stream m a)
parse_ Parser m a b
parser Stream m a
strm
    b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

-- | Run a 'Parse' over a stream and return rest of the Stream.
{-# INLINE_NORMAL parse_ #-}
parse_
    :: MonadThrow m
    => PRD.Parser m a b
    -> Stream m a
    -> m (b, Stream m a)
parse_ :: Parser m a b -> Stream m a -> m (b, Stream m a)
parse_ (PRD.Parser s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m b
extract) stream :: Stream m a
stream@(Stream State Stream m a -> s -> m (Step s a)
step s
state) = do
    Initial s b
res <- m (Initial s b)
initial
    case Initial s b
res of
        PRD.IPartial s
s -> SPEC -> s -> List a -> s -> m (b, Stream m a)
go SPEC
SPEC s
state ([a] -> List a
forall a. [a] -> List a
List []) s
s
        PRD.IDone b
b -> (b, Stream m a) -> m (b, Stream m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Stream m a
stream)
        PRD.IError String
err -> ParseError -> m (b, Stream m a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (b, Stream m a))
-> ParseError -> m (b, Stream m a)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

    where

    -- "buf" contains last few items in the stream that we may have to
    -- backtrack to.
    --
    -- XXX currently we are using a dumb list based approach for backtracking
    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.
    -- That will allow us more efficient random back and forth movement.
    go :: SPEC -> s -> List a -> s -> m (b, Stream m a)
go !SPEC
_ s
st List a
buf !s
pst = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s -> do
                Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
                case Step s b
pRes of
                    PR.Partial Int
0 s
pst1 -> SPEC -> s -> List a -> s -> m (b, Stream m a)
go SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List []) s
pst1
                    PR.Partial Int
n s
pst1 -> do
                        Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                            src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                        SPEC -> s -> List a -> List a -> s -> m (b, Stream m a)
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List []) ([a] -> List a
forall a. [a] -> List a
List [a]
src) s
pst1
                    PR.Continue Int
0 s
pst1 -> SPEC -> s -> List a -> s -> m (b, Stream m a)
go SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) s
pst1
                    PR.Continue Int
n s
pst1 -> do
                        Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let ([a]
src0, [a]
buf1) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                            src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                        SPEC -> s -> List a -> List a -> s -> m (b, Stream m a)
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List [a]
buf1) ([a] -> List a
forall a. [a] -> List a
List [a]
src) s
pst1
                    PR.Done Int
0 b
b -> (b, Stream m a) -> m (b, Stream m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, (State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m a -> s -> m (Step s a)
step s
st)
                    PR.Done Int
n b
b -> do
                        Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                            src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                        -- XXX This would make it quadratic. We should probably
                        -- use StreamK if we have to append many times.
                        (b, Stream m a) -> m (b, Stream m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Stream m a -> Stream m a -> Stream m a
forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
Nesting.append ([a] -> Stream m a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
fromList [a]
src) ((State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m a -> s -> m (Step s a)
step s
s))
                    PR.Error String
err -> ParseError -> m (b, Stream m a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (b, Stream m a))
-> ParseError -> m (b, Stream m a)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err
            Skip s
s -> SPEC -> s -> List a -> s -> m (b, Stream m a)
go SPEC
SPEC s
s List a
buf s
pst
            Step s a
Stop   -> do
                b
b <- s -> m b
extract s
pst
                (b, Stream m a) -> m (b, Stream m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, let List [a]
buffer = List a
buf in [a] -> Stream m a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
fromList [a]
buffer)

    gobuf :: SPEC -> s -> List a -> List a -> s -> m (b, Stream m a)
gobuf !SPEC
_ s
s List a
buf (List []) !s
pst = SPEC -> s -> List a -> s -> m (b, Stream m a)
go SPEC
SPEC s
s List a
buf s
pst
    gobuf !SPEC
_ s
s List a
buf (List (a
x:[a]
xs)) !s
pst = do
        Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
        case Step s b
pRes of
            PR.Partial Int
0 s
pst1 ->
                SPEC -> s -> List a -> List a -> s -> m (b, Stream m a)
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List []) ([a] -> List a
forall a. [a] -> List a
List [a]
xs) s
pst1
            PR.Partial Int
n s
pst1 -> do
                Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
                SPEC -> s -> List a -> List a -> s -> m (b, Stream m a)
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List []) ([a] -> List a
forall a. [a] -> List a
List [a]
src) s
pst1
            PR.Continue Int
0 s
pst1 ->
                SPEC -> s -> List a -> List a -> s -> m (b, Stream m a)
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) ([a] -> List a
forall a. [a] -> List a
List [a]
xs) s
pst1
            PR.Continue Int
n s
pst1 -> do
                Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let ([a]
src0, [a]
buf1) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
                SPEC -> s -> List a -> List a -> s -> m (b, Stream m a)
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List [a]
buf1) ([a] -> List a
forall a. [a] -> List a
List [a]
src) s
pst1
            PR.Done Int
n b
b -> do
                Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                (b, Stream m a) -> m (b, Stream m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Stream m a -> Stream m a -> Stream m a
forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
Nesting.append ([a] -> Stream m a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
fromList [a]
src) ((State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m a -> s -> m (Step s a)
step s
s))
            PR.Error String
err -> ParseError -> m (b, Stream m a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (b, Stream m a))
-> ParseError -> m (b, Stream m a)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

------------------------------------------------------------------------------
-- Specialized Folds
------------------------------------------------------------------------------

{-# INLINE_NORMAL null #-}
null :: Monad m => Stream m a -> m Bool
null :: Stream m a -> m Bool
null = (a -> m Bool -> m Bool) -> m Bool -> Stream m a -> m Bool
forall (m :: * -> *) a b.
Monad m =>
(a -> m b -> m b) -> m b -> Stream m a -> m b
foldrM (\a
_ m Bool
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)

{-# INLINE_NORMAL head #-}
head :: Monad m => Stream m a -> m (Maybe a)
head :: Stream m a -> m (Maybe a)
head = (a -> m (Maybe a) -> m (Maybe a))
-> m (Maybe a) -> Stream m a -> m (Maybe a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b -> m b) -> m b -> Stream m a -> m b
foldrM (\a
x m (Maybe a)
_ -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)) (Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)

{-# INLINE_NORMAL headElse #-}
headElse :: Monad m => a -> Stream m a -> m a
headElse :: a -> Stream m a -> m a
headElse a
a = (a -> m a -> m a) -> m a -> Stream m a -> m a
forall (m :: * -> *) a b.
Monad m =>
(a -> m b -> m b) -> m b -> Stream m a -> m b
foldrM (\a
x m a
_ -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x) (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a)

-- Does not fuse, has the same performance as the StreamK version.
{-# INLINE_NORMAL tail #-}
tail :: Monad m => Stream m a -> m (Maybe (Stream m a))
tail :: Stream m a -> m (Maybe (Stream m a))
tail (UnStream State Stream m a -> s -> m (Step s a)
step s
state) = s -> m (Maybe (Stream m a))
go s
state
  where
    go :: s -> m (Maybe (Stream m a))
go s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
_ s
s -> Maybe (Stream m a) -> m (Maybe (Stream m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream m a -> Maybe (Stream m a)
forall a. a -> Maybe a
Just (Stream m a -> Maybe (Stream m a))
-> Stream m a -> Maybe (Stream m a)
forall a b. (a -> b) -> a -> b
$ (State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m a -> s -> m (Step s a)
step s
s)
            Skip  s
s   -> s -> m (Maybe (Stream m a))
go s
s
            Step s a
Stop      -> Maybe (Stream m a) -> m (Maybe (Stream m a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Stream m a)
forall a. Maybe a
Nothing

-- XXX will it fuse? need custom impl?
{-# INLINE_NORMAL last #-}
last :: Monad m => Stream m a -> m (Maybe a)
last :: Stream m a -> m (Maybe a)
last = (Maybe a -> a -> Maybe a) -> Maybe a -> Stream m a -> m (Maybe a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Stream m a -> m b
foldl' (\Maybe a
_ a
y -> a -> Maybe a
forall a. a -> Maybe a
Just a
y) Maybe a
forall a. Maybe a
Nothing

{-# INLINE_NORMAL elem #-}
elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
-- elem e m = foldrM (\x xs -> if x == e then return True else xs) (return False) m
elem :: a -> Stream m a -> m Bool
elem a
e (Stream State Stream m a -> s -> m (Step s a)
step s
state) = s -> m Bool
go s
state
  where
    go :: s -> m Bool
go s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s
              | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
e    -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
              | Bool
otherwise -> s -> m Bool
go s
s
            Skip s
s -> s -> m Bool
go s
s
            Step s a
Stop   -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

{-# INLINE_NORMAL notElem #-}
notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
notElem :: a -> Stream m a -> m Bool
notElem a
e Stream m a
s = (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (a -> Stream m a -> m Bool
forall (m :: * -> *) a.
(Monad m, Eq a) =>
a -> Stream m a -> m Bool
elem a
e Stream m a
s)

{-# INLINE_NORMAL all #-}
all :: Monad m => (a -> Bool) -> Stream m a -> m Bool
-- all p m = foldrM (\x xs -> if p x then xs else return False) (return True) m
all :: (a -> Bool) -> Stream m a -> m Bool
all a -> Bool
p (Stream State Stream m a -> s -> m (Step s a)
step s
state) = s -> m Bool
go s
state
  where
    go :: s -> m Bool
go s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s
              | a -> Bool
p a
x       -> s -> m Bool
go s
s
              | Bool
otherwise -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            Skip s
s -> s -> m Bool
go s
s
            Step s a
Stop   -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

{-# INLINE_NORMAL any #-}
any :: Monad m => (a -> Bool) -> Stream m a -> m Bool
-- any p m = foldrM (\x xs -> if p x then return True else xs) (return False) m
any :: (a -> Bool) -> Stream m a -> m Bool
any a -> Bool
p (Stream State Stream m a -> s -> m (Step s a)
step s
state) = s -> m Bool
go s
state
  where
    go :: s -> m Bool
go s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s
              | a -> Bool
p a
x       -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
              | Bool
otherwise -> s -> m Bool
go s
s
            Skip s
s -> s -> m Bool
go s
s
            Step s a
Stop   -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

{-# INLINE_NORMAL maximum #-}
maximum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)
maximum :: Stream m a -> m (Maybe a)
maximum (Stream State Stream m a -> s -> m (Step s a)
step s
state) = Maybe a -> s -> m (Maybe a)
go Maybe a
forall a. Maybe a
Nothing s
state
  where
    go :: Maybe a -> s -> m (Maybe a)
go Maybe a
Nothing s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
x) s
s
            Skip  s
s   -> Maybe a -> s -> m (Maybe a)
go Maybe a
forall a. Maybe a
Nothing s
s
            Step s a
Stop      -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    go (Just a
acc) s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s
              | a
acc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x  -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
x) s
s
              | Bool
otherwise -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
acc) s
s
            Skip s
s -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
acc) s
s
            Step s a
Stop   -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
acc)

{-# INLINE_NORMAL maximumBy #-}
maximumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)
maximumBy :: (a -> a -> Ordering) -> Stream m a -> m (Maybe a)
maximumBy a -> a -> Ordering
cmp (Stream State Stream m a -> s -> m (Step s a)
step s
state) = Maybe a -> s -> m (Maybe a)
go Maybe a
forall a. Maybe a
Nothing s
state
  where
    go :: Maybe a -> s -> m (Maybe a)
go Maybe a
Nothing s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
x) s
s
            Skip  s
s   -> Maybe a -> s -> m (Maybe a)
go Maybe a
forall a. Maybe a
Nothing s
s
            Step s a
Stop      -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    go (Just a
acc) s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s -> case a -> a -> Ordering
cmp a
acc a
x of
                Ordering
GT -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
acc) s
s
                Ordering
_  -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
x) s
s
            Skip s
s -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
acc) s
s
            Step s a
Stop   -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
acc)

{-# INLINE_NORMAL minimum #-}
minimum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)
minimum :: Stream m a -> m (Maybe a)
minimum (Stream State Stream m a -> s -> m (Step s a)
step s
state) = Maybe a -> s -> m (Maybe a)
go Maybe a
forall a. Maybe a
Nothing s
state
  where
    go :: Maybe a -> s -> m (Maybe a)
go Maybe a
Nothing s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
x) s
s
            Skip  s
s   -> Maybe a -> s -> m (Maybe a)
go Maybe a
forall a. Maybe a
Nothing s
s
            Step s a
Stop      -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    go (Just a
acc) s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s
              | a
acc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x  -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
acc) s
s
              | Bool
otherwise -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
x) s
s
            Skip s
s -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
acc) s
s
            Step s a
Stop   -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
acc)

{-# INLINE_NORMAL minimumBy #-}
minimumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)
minimumBy :: (a -> a -> Ordering) -> Stream m a -> m (Maybe a)
minimumBy a -> a -> Ordering
cmp (Stream State Stream m a -> s -> m (Step s a)
step s
state) = Maybe a -> s -> m (Maybe a)
go Maybe a
forall a. Maybe a
Nothing s
state
  where
    go :: Maybe a -> s -> m (Maybe a)
go Maybe a
Nothing s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
x) s
s
            Skip  s
s   -> Maybe a -> s -> m (Maybe a)
go Maybe a
forall a. Maybe a
Nothing s
s
            Step s a
Stop      -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    go (Just a
acc) s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s -> case a -> a -> Ordering
cmp a
acc a
x of
                Ordering
GT -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
x) s
s
                Ordering
_  -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
acc) s
s
            Skip s
s -> Maybe a -> s -> m (Maybe a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
acc) s
s
            Step s a
Stop   -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
acc)

{-# INLINE_NORMAL (!!) #-}
(!!) :: (Monad m) => Stream m a -> Int -> m (Maybe a)
(Stream State Stream m a -> s -> m (Step s a)
step s
state) !! :: Stream m a -> Int -> m (Maybe a)
!! Int
i = Int -> s -> m (Maybe a)
forall t. (Ord t, Num t) => t -> s -> m (Maybe a)
go Int
i s
state
  where
    go :: t -> s -> m (Maybe a)
go t
n s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0 -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
                      | t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x
                      | Bool
otherwise -> t -> s -> m (Maybe a)
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) s
s
            Skip s
s -> t -> s -> m (Maybe a)
go t
n s
s
            Step s a
Stop   -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

{-# INLINE_NORMAL lookup #-}
lookup :: (Monad m, Eq a) => a -> Stream m (a, b) -> m (Maybe b)
lookup :: a -> Stream m (a, b) -> m (Maybe b)
lookup a
e = ((a, b) -> m (Maybe b) -> m (Maybe b))
-> m (Maybe b) -> Stream m (a, b) -> m (Maybe b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b -> m b) -> m b -> Stream m a -> m b
foldrM (\(a
a, b
b) m (Maybe b)
xs -> if a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a then Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b
forall a. a -> Maybe a
Just b
b) else m (Maybe b)
xs)
                   (Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing)

{-# INLINE_NORMAL findM #-}
findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)
findM :: (a -> m Bool) -> Stream m a -> m (Maybe a)
findM a -> m Bool
p = (a -> m (Maybe a) -> m (Maybe a))
-> m (Maybe a) -> Stream m a -> m (Maybe a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b -> m b) -> m b -> Stream m a -> m b
foldrM (\a
x m (Maybe a)
xs -> a -> m Bool
p a
x m Bool -> (Bool -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
r -> if Bool
r then Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x) else m (Maybe a)
xs)
                   (Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)

{-# INLINE find #-}
find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)
find :: (a -> Bool) -> Stream m a -> m (Maybe a)
find a -> Bool
p = (a -> m Bool) -> Stream m a -> m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Stream m a -> m (Maybe a)
findM (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (a -> Bool) -> a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

{-# INLINE toListRev #-}
toListRev :: Monad m => Stream m a -> m [a]
toListRev :: Stream m a -> m [a]
toListRev = ([a] -> a -> [a]) -> [a] -> Stream m a -> m [a]
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Stream m a -> m b
foldl' ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []

------------------------------------------------------------------------------
-- Transformation comprehensions
------------------------------------------------------------------------------

{-# INLINE_NORMAL the #-}
the :: (Eq a, Monad m) => Stream m a -> m (Maybe a)
the :: Stream m a -> m (Maybe a)
the (Stream State Stream m a -> s -> m (Step s a)
step s
state) = s -> m (Maybe a)
go s
state
  where
    go :: s -> m (Maybe a)
go s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s -> a -> s -> m (Maybe a)
go' a
x s
s
            Skip s
s    -> s -> m (Maybe a)
go s
s
            Step s a
Stop      -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    go' :: a -> s -> m (Maybe a)
go' a
n s
st = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
            Yield a
x s
s | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n -> a -> s -> m (Maybe a)
go' a
n s
s
                      | Bool
otherwise -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
            Skip s
s -> a -> s -> m (Maybe a)
go' a
n s
s
            Step s a
Stop   -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
n)

------------------------------------------------------------------------------
-- Map and Fold
------------------------------------------------------------------------------

-- | Execute a monadic action for each element of the 'Stream'
{-# INLINE_NORMAL mapM_ #-}
mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()
mapM_ :: (a -> m b) -> Stream m a -> m ()
mapM_ a -> m b
m = Stream m b -> m ()
forall (m :: * -> *) a. Monad m => Stream m a -> m ()
drain (Stream m b -> m ())
-> (Stream m a -> Stream m b) -> Stream m a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m b) -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stream m a -> Stream m b
mapM a -> m b
m

------------------------------------------------------------------------------
-- Multi-stream folds
------------------------------------------------------------------------------

{-# INLINE_NORMAL isPrefixOf #-}
isPrefixOf :: (Eq a, Monad m) => Stream m a -> Stream m a -> m Bool
isPrefixOf :: Stream m a -> Stream m a -> m Bool
isPrefixOf (Stream State Stream m a -> s -> m (Step s a)
stepa s
ta) (Stream State Stream m a -> s -> m (Step s a)
stepb s
tb) = (s, s, Maybe a) -> m Bool
go (s
ta, s
tb, Maybe a
forall a. Maybe a
Nothing)
  where
    go :: (s, s, Maybe a) -> m Bool
go (s
sa, s
sb, Maybe a
Nothing) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
stepa State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
sa
        case Step s a
r of
            Yield a
x s
sa' -> (s, s, Maybe a) -> m Bool
go (s
sa', s
sb, a -> Maybe a
forall a. a -> Maybe a
Just a
x)
            Skip s
sa'    -> (s, s, Maybe a) -> m Bool
go (s
sa', s
sb, Maybe a
forall a. Maybe a
Nothing)
            Step s a
Stop        -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

    go (s
sa, s
sb, Just a
x) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
stepb State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
sb
        case Step s a
r of
            Yield a
y s
sb' ->
                if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
                    then (s, s, Maybe a) -> m Bool
go (s
sa, s
sb', Maybe a
forall a. Maybe a
Nothing)
                    else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            Skip s
sb' -> (s, s, Maybe a) -> m Bool
go (s
sa, s
sb', a -> Maybe a
forall a. a -> Maybe a
Just a
x)
            Step s a
Stop     -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

{-# INLINE_NORMAL isSubsequenceOf #-}
isSubsequenceOf :: (Eq a, Monad m) => Stream m a -> Stream m a -> m Bool
isSubsequenceOf :: Stream m a -> Stream m a -> m Bool
isSubsequenceOf (Stream State Stream m a -> s -> m (Step s a)
stepa s
ta) (Stream State Stream m a -> s -> m (Step s a)
stepb s
tb) = (s, s, Maybe a) -> m Bool
go (s
ta, s
tb, Maybe a
forall a. Maybe a
Nothing)
  where
    go :: (s, s, Maybe a) -> m Bool
go (s
sa, s
sb, Maybe a
Nothing) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
stepa State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
sa
        case Step s a
r of
            Yield a
x s
sa' -> (s, s, Maybe a) -> m Bool
go (s
sa', s
sb, a -> Maybe a
forall a. a -> Maybe a
Just a
x)
            Skip s
sa'    -> (s, s, Maybe a) -> m Bool
go (s
sa', s
sb, Maybe a
forall a. Maybe a
Nothing)
            Step s a
Stop        -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

    go (s
sa, s
sb, Just a
x) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
stepb State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
sb
        case Step s a
r of
            Yield a
y s
sb' ->
                if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
                    then (s, s, Maybe a) -> m Bool
go (s
sa, s
sb', Maybe a
forall a. Maybe a
Nothing)
                    else (s, s, Maybe a) -> m Bool
go (s
sa, s
sb', a -> Maybe a
forall a. a -> Maybe a
Just a
x)
            Skip s
sb' -> (s, s, Maybe a) -> m Bool
go (s
sa, s
sb', a -> Maybe a
forall a. a -> Maybe a
Just a
x)
            Step s a
Stop     -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

{-# INLINE_NORMAL stripPrefix #-}
stripPrefix
    :: (Eq a, Monad m)
    => Stream m a -> Stream m a -> m (Maybe (Stream m a))
stripPrefix :: Stream m a -> Stream m a -> m (Maybe (Stream m a))
stripPrefix (Stream State Stream m a -> s -> m (Step s a)
stepa s
ta) (Stream State Stream m a -> s -> m (Step s a)
stepb s
tb) = (s, s, Maybe a) -> m (Maybe (Stream m a))
go (s
ta, s
tb, Maybe a
forall a. Maybe a
Nothing)
  where
    go :: (s, s, Maybe a) -> m (Maybe (Stream m a))
go (s
sa, s
sb, Maybe a
Nothing) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
stepa State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
sa
        case Step s a
r of
            Yield a
x s
sa' -> (s, s, Maybe a) -> m (Maybe (Stream m a))
go (s
sa', s
sb, a -> Maybe a
forall a. a -> Maybe a
Just a
x)
            Skip s
sa'    -> (s, s, Maybe a) -> m (Maybe (Stream m a))
go (s
sa', s
sb, Maybe a
forall a. Maybe a
Nothing)
            Step s a
Stop        -> Maybe (Stream m a) -> m (Maybe (Stream m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Stream m a) -> m (Maybe (Stream m a)))
-> Maybe (Stream m a) -> m (Maybe (Stream m a))
forall a b. (a -> b) -> a -> b
$ Stream m a -> Maybe (Stream m a)
forall a. a -> Maybe a
Just ((State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m a -> s -> m (Step s a)
stepb s
sb)

    go (s
sa, s
sb, Just a
x) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
stepb State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
sb
        case Step s a
r of
            Yield a
y s
sb' ->
                if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
                    then (s, s, Maybe a) -> m (Maybe (Stream m a))
go (s
sa, s
sb', Maybe a
forall a. Maybe a
Nothing)
                    else Maybe (Stream m a) -> m (Maybe (Stream m a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Stream m a)
forall a. Maybe a
Nothing
            Skip s
sb' -> (s, s, Maybe a) -> m (Maybe (Stream m a))
go (s
sa, s
sb', a -> Maybe a
forall a. a -> Maybe a
Just a
x)
            Step s a
Stop     -> Maybe (Stream m a) -> m (Maybe (Stream m a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Stream m a)
forall a. Maybe a
Nothing