{-# LANGUAGE CPP                       #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : Streamly.Internal.Data.Parser
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- Fast streaming parsers.
--
-- 'Applicative' and 'Alternative' type class based combinators from the
-- <http://hackage.haskell.org/package/parser-combinators parser-combinators>
-- package can also be used with the 'Parser' type. However, there are two
-- important differences between @parser-combinators@ and the equivalent ones
-- provided in this module in terms of performance:
--
-- 1) @parser-combinators@ use plain Haskell lists to collect the results, in a
-- strict Monad like IO, the results are necessarily buffered before they can
-- be consumed.  This may not perform optimally in streaming applications
-- processing large amounts of data.  Equivalent combinators in this module can
-- consume the results of parsing using a 'Fold', thus providing a scalability
-- and a generic consumer.
--
-- 2) Several combinators in this module can be many times faster because of
-- stream fusion. For example, 'Streamly.Internal.Data.Parser.many' combinator
-- in this module is much faster than the 'Control.Applicative.many' combinator
-- of 'Alternative' type class.
--
-- Failing parsers in this module throw the 'ParseError' exception.

-- XXX As far as possible, try that the combinators in this module and in
-- "Text.ParserCombinators.ReadP/parser-combinators/parsec/megaparsec/attoparsec"
-- have consistent names. takeP/takeWhileP/munch?

module Streamly.Internal.Data.Parser
    (
      Parser (..)

    -- First order parsers
    -- * Accumulators
    , fromFold
    , any
    , all
    , yield
    , yieldM
    , die
    , dieM

    -- * Element parsers
    , peek
    , eof
    , satisfy

    -- * Sequence parsers
    --
    -- Parsers chained in series, if one parser terminates the composition
    -- terminates. Currently we are using folds to collect the output of the
    -- parsers but we can use Parsers instead of folds to make the composition
    -- more powerful. For example, we can do:
    --
    -- sliceSepByMax cond n p = sliceBy cond (take n p)
    -- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)
    -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
    --
    -- Grab a sequence of input elements without inspecting them
    , take
    -- , takeBetween
    -- , takeLE -- take   -- takeBetween 0 n
    -- , takeLE1 -- take1 -- takeBetween 1 n
    , takeEQ -- takeBetween n n
    , takeGE -- takeBetween n maxBound

    -- Grab a sequence of input elements by inspecting them
    , lookAhead
    , takeWhile
    , takeWhile1
    , sliceSepBy
    , sliceSepByMax
    -- , sliceSepByBetween
    , sliceEndWith
    , sliceBeginWith
    -- , sliceSepWith
    --
    -- , frameSepBy -- parse frames escaped by an escape char/sequence
    -- , frameEndWith
    --
    , wordBy
    , groupBy
    , eqBy
    -- , prefixOf -- match any prefix of a given string
    -- , suffixOf -- match any suffix of a given string
    -- , infixOf -- match any substring of a given string

    -- Second order parsers (parsers using parsers)
    -- * Binary Combinators

    -- ** Sequential Applicative
    , splitWith

    -- ** Parallel Applicatives
    , teeWith
    , teeWithFst
    , teeWithMin
    -- , teeTill -- like manyTill but parallel

    -- ** Sequential Interleaving
    -- Use two folds, run a primary parser, its rejected values go to the
    -- secondary parser.
    , deintercalate

    -- ** Parallel Alternatives
    , shortest
    , longest
    -- , fastest

    -- * N-ary Combinators
    -- ** Sequential Collection
    , sequence

    -- ** Sequential Repetition
    , count
    , countBetween
    -- , countBetweenTill

    , many
    , some
    , manyTill

    -- -- ** Special cases
    -- XXX traditional implmentations of these may be of limited use. For
    -- example, consider parsing lines separated by "\r\n". The main parser
    -- will have to detect and exclude the sequence "\r\n" anyway so that we
    -- can apply the "sep" parser.
    --
    -- We can instead implement these as special cases of deintercalate.
    --
    -- , endBy
    -- , sepBy
    -- , sepEndBy
    -- , beginBy
    -- , sepBeginBy
    -- , sepAroundBy

    -- -- * Distribution
    --
    -- A simple and stupid impl would be to just convert the stream to an array
    -- and give the array reference to all consumers. The array can be grown on
    -- demand by any consumer and truncated when nonbody needs it.
    --
    -- -- ** Distribute to collection
    -- -- ** Distribute to repetition

    -- -- ** Interleaved collection
    -- Round robin
    -- Priority based
    -- -- ** Interleaved repetition
    -- repeat one parser and when it fails run an error recovery parser
    -- e.g. to find a key frame in the stream after an error

    -- ** Collection of Alternatives
    -- , shortestN
    -- , longestN
    -- , fastestN -- first N successful in time
    -- , choiceN  -- first N successful in position
    , choice   -- first successful in position

    -- -- ** Repeated Alternatives
    -- , retryMax    -- try N times
    -- , retryUntil  -- try until successful
    -- , retryUntilN -- try until successful n times
    )
where

import Control.Exception (assert)
import Control.Monad.Catch (MonadCatch, MonadThrow(..))
import Prelude
       hiding (any, all, take, takeWhile, sequence)

import Streamly.Internal.Data.Fold.Types (Fold(..))

import Streamly.Internal.Data.Parser.Tee
import Streamly.Internal.Data.Parser.Types
import Streamly.Internal.Data.Strict

-------------------------------------------------------------------------------
-- Upgrade folds to parses
-------------------------------------------------------------------------------
--
-- | The resulting parse never terminates and never errors out.
--
{-# INLINE fromFold #-}
fromFold :: Monad m => Fold m a b -> Parser m a b
fromFold :: Fold m a b -> Parser m a b
fromFold (Fold s -> a -> m s
fstep m s
finitial s -> m b
fextract) = (s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser s -> a -> m (Step s b)
forall b. s -> a -> m (Step s b)
step m s
finitial s -> m b
fextract

    where

    step :: s -> a -> m (Step s b)
step s
s a
a = Int -> s -> Step s b
forall s b. Int -> s -> Step s b
Yield Int
0 (s -> Step s b) -> m s -> m (Step s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> a -> m s
fstep s
s a
a

-------------------------------------------------------------------------------
-- Terminating but not failing folds
-------------------------------------------------------------------------------
--
-- |
-- >>> S.parse (PR.any (== 0)) $ S.fromList [1,0,1]
-- > Right True
--
{-# INLINABLE any #-}
any :: Monad m => (a -> Bool) -> Parser m a Bool
any :: (a -> Bool) -> Parser m a Bool
any a -> Bool
predicate = (Bool -> a -> m (Step Bool Bool))
-> m Bool -> (Bool -> m Bool) -> Parser m a Bool
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser Bool -> a -> m (Step Bool Bool)
forall (m :: * -> *). Monad m => Bool -> a -> m (Step Bool Bool)
step m Bool
initial Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return

    where

    initial :: m Bool
initial = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    step :: Bool -> a -> m (Step Bool Bool)
step Bool
s a
a = Step Bool Bool -> m (Step Bool Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step Bool Bool -> m (Step Bool Bool))
-> Step Bool Bool -> m (Step Bool Bool)
forall a b. (a -> b) -> a -> b
$
        if Bool
s
        then Int -> Bool -> Step Bool Bool
forall s b. Int -> b -> Step s b
Stop Int
0 Bool
True
        else
            if a -> Bool
predicate a
a
            then Int -> Bool -> Step Bool Bool
forall s b. Int -> b -> Step s b
Stop Int
0 Bool
True
            else Int -> Bool -> Step Bool Bool
forall s b. Int -> s -> Step s b
Yield Int
0 Bool
False

-- |
-- >>> S.parse (PR.all (== 0)) $ S.fromList [1,0,1]
-- > Right False
--
{-# INLINABLE all #-}
all :: Monad m => (a -> Bool) -> Parser m a Bool
all :: (a -> Bool) -> Parser m a Bool
all a -> Bool
predicate = (Bool -> a -> m (Step Bool Bool))
-> m Bool -> (Bool -> m Bool) -> Parser m a Bool
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser Bool -> a -> m (Step Bool Bool)
forall (m :: * -> *). Monad m => Bool -> a -> m (Step Bool Bool)
step m Bool
initial Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return

    where

    initial :: m Bool
initial = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

    step :: Bool -> a -> m (Step Bool Bool)
step Bool
s a
a = Step Bool Bool -> m (Step Bool Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step Bool Bool -> m (Step Bool Bool))
-> Step Bool Bool -> m (Step Bool Bool)
forall a b. (a -> b) -> a -> b
$
        if Bool
s
        then
            if a -> Bool
predicate a
a
            then Int -> Bool -> Step Bool Bool
forall s b. Int -> s -> Step s b
Yield Int
0 Bool
True
            else Int -> Bool -> Step Bool Bool
forall s b. Int -> b -> Step s b
Stop Int
0 Bool
False
        else Int -> Bool -> Step Bool Bool
forall s b. Int -> b -> Step s b
Stop Int
0 Bool
False

-------------------------------------------------------------------------------
-- Failing Parsers
-------------------------------------------------------------------------------

-- | Peek the head element of a stream, without consuming it. Fails if it
-- encounters end of input.
--
-- >>> S.parse ((,) <$> PR.peek <*> PR.satisfy (> 0)) $ S.fromList [1]
-- (1,1)
--
-- @
-- peek = lookAhead (satisfy True)
-- @
--
-- /Internal/
--
{-# INLINABLE peek #-}
peek :: MonadThrow m => Parser m a a
peek :: Parser m a a
peek = (() -> a -> m (Step () a)) -> m () -> (() -> m a) -> Parser m a a
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser () -> a -> m (Step () a)
forall (m :: * -> *) b s. Monad m => () -> b -> m (Step s b)
step m ()
initial () -> m a
forall (m :: * -> *) a. MonadThrow m => () -> m a
extract

    where

    initial :: m ()
initial = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    step :: () -> b -> m (Step s b)
step () b
a = Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Stop Int
1 b
a

    extract :: () -> m a
extract () = ParseError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m a) -> ParseError -> m a
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"peek: end of input"

-- | Succeeds if we are at the end of input, fails otherwise.
--
-- >>> S.parse ((,) <$> PR.satisfy (> 0) <*> PR.eof) $ S.fromList [1]
-- > (1,())
--
-- /Internal/
--
{-# INLINABLE eof #-}
eof :: Monad m => Parser m a ()
eof :: Parser m a ()
eof = (() -> a -> m (Step () ()))
-> m () -> (() -> m ()) -> Parser m a ()
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser () -> a -> m (Step () ())
forall (m :: * -> *) p s b. Monad m => () -> p -> m (Step s b)
step m ()
initial () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return

    where

    initial :: m ()
initial = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    step :: () -> p -> m (Step s b)
step () p
_ = Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ String -> Step s b
forall s b. String -> Step s b
Error String
"eof: not at end of input"

-- | Returns the next element if it passes the predicate, fails otherwise.
--
-- >>> S.parse (PR.satisfy (== 1)) $ S.fromList [1,0,1]
-- > 1
--
-- /Internal/
--
{-# INLINE satisfy #-}
satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
satisfy :: (a -> Bool) -> Parser m a a
satisfy a -> Bool
predicate = (() -> a -> m (Step () a)) -> m () -> (() -> m a) -> Parser m a a
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser () -> a -> m (Step () a)
forall (m :: * -> *) s. Monad m => () -> a -> m (Step s a)
step m ()
initial () -> m a
forall (m :: * -> *) p a. MonadThrow m => p -> m a
extract

    where

    initial :: m ()
initial = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    step :: () -> a -> m (Step s a)
step () a
a = Step s a -> m (Step s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s a -> m (Step s a)) -> Step s a -> m (Step s a)
forall a b. (a -> b) -> a -> b
$
        if a -> Bool
predicate a
a
        then Int -> a -> Step s a
forall s b. Int -> b -> Step s b
Stop Int
0 a
a
        else String -> Step s a
forall s b. String -> Step s b
Error String
"satisfy: predicate failed"

    extract :: p -> m a
extract p
_ = ParseError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m a) -> ParseError -> m a
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"satisfy: end of input"

-------------------------------------------------------------------------------
-- Taking elements
-------------------------------------------------------------------------------
--
-- XXX Once we have terminating folds, this Parse should get replaced by Fold.
-- Alternatively, we can name it "chunkOf" and the corresponding time domain
-- combinator as "intervalOf" or even "chunk" and "interval".
--
-- | Take at most @n@ input elements and fold them using the supplied fold.
--
-- Stops after @n@ elements.
-- Never fails.
--
-- >>> S.parse (PR.take 1 FL.toList) $ S.fromList [1]
-- [1]
--
-- @
-- S.chunksOf n f = S.splitParse (FL.take n f)
-- @
--
-- /Internal/
--
{-# INLINE take #-}
take :: Monad m => Int -> Fold m a b -> Parser m a b
take :: Int -> Fold m a b -> Parser m a b
take Int
n (Fold s -> a -> m s
fstep m s
finitial s -> m b
fextract) = (Tuple' Int s -> a -> m (Step (Tuple' Int s) b))
-> m (Tuple' Int s) -> (Tuple' Int s -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step m (Tuple' Int s)
initial Tuple' Int s -> m b
forall a. Tuple' a s -> m b
extract

    where

    initial :: m (Tuple' Int s)
initial = Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
0 (s -> Tuple' Int s) -> m s -> m (Tuple' Int s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
finitial

    step :: Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step (Tuple' Int
i s
r) a
a = do
        s
res <- s -> a -> m s
fstep s
r a
a
        let i1 :: Int
i1 = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            s1 :: Tuple' Int s
s1 = Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
i1 s
res
        if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
        then Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Yield Int
0 Tuple' Int s
s1
        else Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
Stop Int
0 (b -> Step (Tuple' Int s) b) -> m b -> m (Step (Tuple' Int s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
res

    extract :: Tuple' a s -> m b
extract (Tuple' a
_ s
r) = s -> m b
fextract s
r

--
-- XXX can we use a "cmp" operation in a common implementation?
--
-- | Stops after taking exactly @n@ input elements.
--
-- * Stops - after @n@ elements.
-- * Fails - if the stream ends before it can collect @n@ elements.
--
-- >>> S.parse (PR.takeEQ 4 FL.toList) $ S.fromList [1,0,1]
-- > "takeEQ: Expecting exactly 4 elements, got 3"
--
-- /Internal/
--
{-# INLINE takeEQ #-}
takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
takeEQ :: Int -> Fold m a b -> Parser m a b
takeEQ Int
n (Fold s -> a -> m s
fstep m s
finitial s -> m b
fextract) = (Tuple' Int s -> a -> m (Step (Tuple' Int s) b))
-> m (Tuple' Int s) -> (Tuple' Int s -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step m (Tuple' Int s)
initial Tuple' Int s -> m b
extract

    where

    initial :: m (Tuple' Int s)
initial = Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
0 (s -> Tuple' Int s) -> m s -> m (Tuple' Int s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
finitial

    step :: Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step (Tuple' Int
i s
r) a
a = do
        s
res <- s -> a -> m s
fstep s
r a
a
        let i1 :: Int
i1 = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            s1 :: Tuple' Int s
s1 = Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
i1 s
res
        if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n then Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Skip Int
0 Tuple' Int s
s1) else Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
Stop Int
0 (b -> Step (Tuple' Int s) b) -> m b -> m (Step (Tuple' Int s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
res

    extract :: Tuple' Int s -> m b
extract (Tuple' Int
i s
r) =
        if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i
        then s -> m b
fextract s
r
        else ParseError -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

        where

        err :: String
err =
               String
"takeEQ: Expecting exactly " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

-- | Take at least @n@ input elements, but can collect more.
--
-- * Stops - never.
-- * Fails - if the stream ends before producing @n@ elements.
--
-- >>> S.parse (PR.takeGE 4 FL.toList) $ S.fromList [1,0,1]
-- > "takeGE: Expecting at least 4 elements, got only 3"
--
-- >>> S.parse (PR.takeGE 4 FL.toList) $ S.fromList [1,0,1,0,1]
-- > [1,0,1,0,1]
--
-- /Internal/
--
{-# INLINE takeGE #-}
takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
takeGE :: Int -> Fold m a b -> Parser m a b
takeGE Int
n (Fold s -> a -> m s
fstep m s
finitial s -> m b
fextract) = (Tuple' Int s -> a -> m (Step (Tuple' Int s) b))
-> m (Tuple' Int s) -> (Tuple' Int s -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
forall b. Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step m (Tuple' Int s)
initial Tuple' Int s -> m b
extract

    where

    initial :: m (Tuple' Int s)
initial = Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
0 (s -> Tuple' Int s) -> m s -> m (Tuple' Int s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
finitial

    step :: Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step (Tuple' Int
i s
r) a
a = do
        s
res <- s -> a -> m s
fstep s
r a
a
        let i1 :: Int
i1 = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            s1 :: Tuple' Int s
s1 = Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
i1 s
res
        Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$
            if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
            then Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Skip Int
0 Tuple' Int s
s1
            else Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Yield Int
0 Tuple' Int s
s1

    extract :: Tuple' Int s -> m b
extract (Tuple' Int
i s
r) = s -> m b
fextract s
r m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
forall (m :: * -> *) a. MonadThrow m => a -> m a
f

        where

        err :: String
err =
              String
"takeGE: Expecting at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, got only " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

        f :: a -> m a
f a
x =
            if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
            then a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
            else ParseError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m a) -> ParseError -> m a
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

-- | Collect stream elements until an element fails the predicate. The element
-- on which the predicate fails is returned back to the input stream.
--
-- * Stops - when the predicate fails.
-- * Fails - never.
--
-- >>> S.parse (PR.takeWhile (== 0) FL.toList) $ S.fromList [0,0,1,0,1]
-- > [0,0]
--
-- We can implement a @breakOn@ using 'takeWhile':
--
-- @
-- breakOn p = takeWhile (not p)
-- @
--
-- /Internal/
--
{-# INLINE takeWhile #-}
takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
takeWhile :: (a -> Bool) -> Fold m a b -> Parser m a b
takeWhile a -> Bool
predicate (Fold s -> a -> m s
fstep m s
finitial s -> m b
fextract) =
    (s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser s -> a -> m (Step s b)
step m s
initial s -> m b
fextract

    where

    initial :: m s
initial = m s
finitial

    step :: s -> a -> m (Step s b)
step s
s a
a =
        if a -> Bool
predicate a
a
        then Int -> s -> Step s b
forall s b. Int -> s -> Step s b
Yield Int
0 (s -> Step s b) -> m s -> m (Step s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> a -> m s
fstep s
s a
a
        else Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Stop Int
1 (b -> Step s b) -> m b -> m (Step s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
s

-- | Like 'takeWhile' but takes at least one element otherwise fails.
--
-- /Internal/
--
{-# INLINE takeWhile1 #-}
takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
takeWhile1 :: (a -> Bool) -> Fold m a b -> Parser m a b
takeWhile1 a -> Bool
predicate (Fold s -> a -> m s
fstep m s
finitial s -> m b
fextract) =
    (Maybe s -> a -> m (Step (Maybe s) b))
-> m (Maybe s) -> (Maybe s -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser Maybe s -> a -> m (Step (Maybe s) b)
step m (Maybe s)
forall a. m (Maybe a)
initial Maybe s -> m b
extract

    where

    initial :: m (Maybe a)
initial = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

    step :: Maybe s -> a -> m (Step (Maybe s) b)
step Maybe s
Nothing a
a =
        if a -> Bool
predicate a
a
        then do
            s
s <- m s
finitial
            s
r <- s -> a -> m s
fstep s
s a
a
            Step (Maybe s) b -> m (Step (Maybe s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe s) b -> m (Step (Maybe s) b))
-> Step (Maybe s) b -> m (Step (Maybe s) b)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe s -> Step (Maybe s) b
forall s b. Int -> s -> Step s b
Yield Int
0 (s -> Maybe s
forall a. a -> Maybe a
Just s
r)
        else Step (Maybe s) b -> m (Step (Maybe s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe s) b -> m (Step (Maybe s) b))
-> Step (Maybe s) b -> m (Step (Maybe s) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (Maybe s) b
forall s b. String -> Step s b
Error String
"takeWhile1: empty"
    step (Just s
s) a
a =
        if a -> Bool
predicate a
a
        then do
            s
r <- s -> a -> m s
fstep s
s a
a
            Step (Maybe s) b -> m (Step (Maybe s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe s) b -> m (Step (Maybe s) b))
-> Step (Maybe s) b -> m (Step (Maybe s) b)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe s -> Step (Maybe s) b
forall s b. Int -> s -> Step s b
Yield Int
0 (s -> Maybe s
forall a. a -> Maybe a
Just s
r)
        else do
            b
b <- s -> m b
fextract s
s
            Step (Maybe s) b -> m (Step (Maybe s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe s) b -> m (Step (Maybe s) b))
-> Step (Maybe s) b -> m (Step (Maybe s) b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step (Maybe s) b
forall s b. Int -> b -> Step s b
Stop Int
1 b
b

    extract :: Maybe s -> m b
extract Maybe s
Nothing = ParseError -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"takeWhile1: end of input"
    extract (Just s
s) = s -> m b
fextract s
s

-- | Collect stream elements until an element succeeds the predicate. Drop the
-- element on which the predicate succeeded. The succeeding element is treated
-- as an infix separator which is dropped from the output.
--
-- * Stops - when the predicate succeeds.
-- * Fails - never.
--
-- >>> S.parse (PR.sliceSepBy (== 1) FL.toList) $ S.fromList [0,0,1,0,1]
-- > [0,0]
--
-- S.splitOn pred f = S.splitParse (PR.sliceSepBy pred f)
--
-- >>> S.toList $ S.splitParse (PR.sliceSepBy (== 1) FL.toList) $ S.fromList [0,0,1,0,1]
-- > [[0,0],[0],[]]
--
-- /Internal/
--
{-# INLINABLE sliceSepBy #-}
sliceSepBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
sliceSepBy :: (a -> Bool) -> Fold m a b -> Parser m a b
sliceSepBy a -> Bool
predicate (Fold s -> a -> m s
fstep m s
finitial s -> m b
fextract) =
    (s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser s -> a -> m (Step s b)
step m s
initial s -> m b
fextract

    where

    initial :: m s
initial = m s
finitial
    step :: s -> a -> m (Step s b)
step s
s a
a =
        if Bool -> Bool
not (a -> Bool
predicate a
a)
        then Int -> s -> Step s b
forall s b. Int -> s -> Step s b
Yield Int
0 (s -> Step s b) -> m s -> m (Step s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> a -> m s
fstep s
s a
a
        else Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Stop Int
0 (b -> Step s b) -> m b -> m (Step s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
s

-- | Collect stream elements until an element succeeds the predicate. Also take
-- the element on which the predicate succeeded. The succeeding element is
-- treated as a suffix separator which is kept in the output segement.
--
-- * Stops - when the predicate succeeds.
-- * Fails - never.
--
-- S.splitWithSuffix pred f = S.splitParse (PR.sliceEndWith pred f)
--
-- /Unimplemented/
--
{-# INLINABLE sliceEndWith #-}
sliceEndWith ::
    -- Monad m =>
    (a -> Bool) -> Fold m a b -> Parser m a b
sliceEndWith :: (a -> Bool) -> Fold m a b -> Parser m a b
sliceEndWith = (a -> Bool) -> Fold m a b -> Parser m a b
forall a. HasCallStack => a
undefined

-- | Collect stream elements until an elements passes the predicate, return the
-- last element on which the predicate succeeded back to the input stream.  If
-- the predicate succeeds on the first element itself then it is kept in the
-- stream and we continue collecting. The succeeding element is treated as a
-- prefix separator which is kept in the output segement.
--
-- * Stops - when the predicate succeeds in non-leading position.
-- * Fails - never.
--
-- S.splitWithPrefix pred f = S.splitParse (PR.sliceBeginWith pred f)
--
-- /Unimplemented/
--
{-# INLINABLE sliceBeginWith #-}
sliceBeginWith ::
    -- Monad m =>
    (a -> Bool) -> Fold m a b -> Parser m a b
sliceBeginWith :: (a -> Bool) -> Fold m a b -> Parser m a b
sliceBeginWith = (a -> Bool) -> Fold m a b -> Parser m a b
forall a. HasCallStack => a
undefined

-- | Split using a condition or a count whichever occurs first. This is a
-- hybrid of 'splitOn' and 'take'. The element on which the condition succeeds
-- is dropped.
--
-- /Internal/
--
{-# INLINABLE sliceSepByMax #-}
sliceSepByMax :: Monad m
    => (a -> Bool) -> Int -> Fold m a b -> Parser m a b
sliceSepByMax :: (a -> Bool) -> Int -> Fold m a b -> Parser m a b
sliceSepByMax a -> Bool
predicate Int
cnt (Fold s -> a -> m s
fstep m s
finitial s -> m b
fextract) =
    (Tuple' Int s -> a -> m (Step (Tuple' Int s) b))
-> m (Tuple' Int s) -> (Tuple' Int s -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step m (Tuple' Int s)
initial Tuple' Int s -> m b
forall a. Tuple' a s -> m b
extract

    where

    initial :: m (Tuple' Int s)
initial = Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
0 (s -> Tuple' Int s) -> m s -> m (Tuple' Int s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
finitial
    step :: Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step (Tuple' Int
i s
r) a
a = do
        s
res <- s -> a -> m s
fstep s
r a
a
        let i1 :: Int
i1 = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            s1 :: Tuple' Int s
s1 = Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
i1 s
res
        if Bool -> Bool
not (a -> Bool
predicate a
a) Bool -> Bool -> Bool
&& Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cnt
        then Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Yield Int
0 Tuple' Int s
s1
        else do
            b
b <- s -> m b
fextract s
res
            Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
Stop Int
0 b
b
    extract :: Tuple' a s -> m b
extract (Tuple' a
_ s
r) = s -> m b
fextract s
r

-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
-- @["a","b"]@.  In other words, its like parsing words from whitespace
-- separated text.
--
-- * Stops - when it finds a word separator after a non-word element
-- * Fails - never.
--
-- @
-- S.wordsBy pred f = S.splitParse (PR.wordBy pred f)
-- @
--
-- /Unimplemented/
--
{-# INLINABLE wordBy #-}
wordBy ::
    -- Monad m =>
    (a -> Bool) -> Fold m a b -> Parser m a b
wordBy :: (a -> Bool) -> Fold m a b -> Parser m a b
wordBy = (a -> Bool) -> Fold m a b -> Parser m a b
forall a. HasCallStack => a
undefined

-- | @groupBy cmp f $ S.fromList [a,b,c,...]@ assigns the element @a@ to the
-- first group, then if @a \`cmp` b@ is 'True' @b@ is also assigned to the same
-- group.  If @a \`cmp` c@ is 'True' then @c@ is also assigned to the same
-- group and so on. When the comparison fails a new group is started. Each
-- group is folded using the 'Fold' @f@ and the result of the fold is emitted
-- in the output stream.
--
-- * Stops - when the comparison fails.
-- * Fails - never.
--
-- @
-- S.groupsBy cmp f = S.splitParse (PR.groupBy cmp f)
-- @
--
-- /Unimplemented/
--
{-# INLINABLE groupBy #-}
groupBy ::
    -- Monad m =>
    (a -> a -> Bool) -> Fold m a b -> Parser m a b
groupBy :: (a -> a -> Bool) -> Fold m a b -> Parser m a b
groupBy = (a -> a -> Bool) -> Fold m a b -> Parser m a b
forall a. HasCallStack => a
undefined

-- XXX use an Unfold instead of a list?
-- XXX custom combinators for matching list, array and stream?
--
-- | Match the given sequence of elements using the given comparison function.
--
-- /Internal/
--
{-# INLINE eqBy #-}
eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
eqBy :: (a -> a -> Bool) -> [a] -> Parser m a ()
eqBy a -> a -> Bool
cmp [a]
str = ([a] -> a -> m (Step [a] ()))
-> m [a] -> ([a] -> m ()) -> Parser m a ()
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser [a] -> a -> m (Step [a] ())
forall (m :: * -> *). Monad m => [a] -> a -> m (Step [a] ())
step m [a]
initial [a] -> m ()
forall (m :: * -> *) (t :: * -> *) a a.
(MonadThrow m, Foldable t) =>
t a -> m a
extract

    where

    initial :: m [a]
initial = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
str

    step :: [a] -> a -> m (Step [a] ())
step [] a
_ = String -> m (Step [a] ())
forall a. HasCallStack => String -> a
error String
"Bug: unreachable"
    step [a
x] a
a = Step [a] () -> m (Step [a] ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Step [a] () -> m (Step [a] ())) -> Step [a] () -> m (Step [a] ())
forall a b. (a -> b) -> a -> b
$
        if a
x a -> a -> Bool
`cmp` a
a
        then Int -> () -> Step [a] ()
forall s b. Int -> b -> Step s b
Stop Int
0 ()
        else String -> Step [a] ()
forall s b. String -> Step s b
Error (String -> Step [a] ()) -> String -> Step [a] ()
forall a b. (a -> b) -> a -> b
$
            String
"eqBy: failed, at the last element"
    step (a
x:[a]
xs) a
a = Step [a] () -> m (Step [a] ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Step [a] () -> m (Step [a] ())) -> Step [a] () -> m (Step [a] ())
forall a b. (a -> b) -> a -> b
$
        if a
x a -> a -> Bool
`cmp` a
a
        then Int -> [a] -> Step [a] ()
forall s b. Int -> s -> Step s b
Skip Int
0 [a]
xs
        else String -> Step [a] ()
forall s b. String -> Step s b
Error (String -> Step [a] ()) -> String -> Step [a] ()
forall a b. (a -> b) -> a -> b
$
            String
"eqBy: failed, yet to match " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements"

    extract :: t a -> m a
extract t a
xs = ParseError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m a) -> ParseError -> m a
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError (String -> ParseError) -> String -> ParseError
forall a b. (a -> b) -> a -> b
$
        String
"eqBy: end of input, yet to match " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements"

-------------------------------------------------------------------------------
-- nested parsers
-------------------------------------------------------------------------------

{-# INLINE lookAhead #-}
lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
lookAhead :: Parser m a b -> Parser m a b
lookAhead (Parser s -> a -> m (Step s b)
step1 m s
initial1 s -> m b
_) =
    (Tuple' Int s -> a -> m (Step (Tuple' Int s) b))
-> m (Tuple' Int s) -> (Tuple' Int s -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step m (Tuple' Int s)
initial Tuple' Int s -> m b
forall (m :: * -> *) a b a.
(MonadThrow m, Show a) =>
Tuple' a b -> m a
extract

    where

    initial :: m (Tuple' Int s)
initial = Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
0 (s -> Tuple' Int s) -> m s -> m (Tuple' Int s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
initial1

    step :: Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step (Tuple' Int
cnt s
st) a
a = do
        Step s b
r <- s -> a -> m (Step s b)
step1 s
st a
a
        let cnt1 :: Int
cnt1 = Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield Int
_ s
s -> Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Skip Int
0 (Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
cnt1 s
s)
            Skip Int
n s
s -> Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Skip Int
n (Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
s)
            Stop Int
_ b
b -> Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
Stop Int
cnt1 b
b
            Error String
err -> String -> Step (Tuple' Int s) b
forall s b. String -> Step s b
Error String
err

    -- XXX returning an error let's us backtrack.  To implement it in a way so
    -- that it terminates on eof without an error then we need a way to
    -- backtrack on eof, that will require extract to return 'Step' type.
    extract :: Tuple' a b -> m a
extract (Tuple' a
n b
_) = ParseError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m a) -> ParseError -> m a
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError (String -> ParseError) -> String -> ParseError
forall a b. (a -> b) -> a -> b
$
        String
"lookAhead: end of input after consuming " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements"

-------------------------------------------------------------------------------
-- Interleaving
-------------------------------------------------------------------------------
--
-- To deinterleave we can chain two parsers one behind the other. The input is
-- given to the first parser and the input definitively rejected by the first
-- parser is given to the second parser.
--
-- We can either have the parsers themselves buffer the input or use the shared
-- global buffer to hold it until none of the parsers need it. When the first
-- parser returns Skip (i.e. rewind) we let the second parser consume the
-- rejected input and when it is done we move the cursor forward to the first
-- parser again. This will require a "move forward" command as well.
--
-- To implement grep we can use three parsers, one to find the pattern, one
-- to store the context behind the pattern and one to store the context in
-- front of the pattern. When a match occurs we need to emit the accumulator of
-- all the three parsers. One parser can count the line numbers to provide the
-- line number info.
--
-- | Apply two parsers alternately to an input stream. The input stream is
-- considered an interleaving of two patterns. The two parsers represent the
-- two patterns.
--
-- This undoes a "gintercalate" of two streams.
--
-- /Unimplemented/
--
{-# INLINE deintercalate #-}
deintercalate ::
    -- Monad m =>
       Fold m a y -> Parser m x a
    -> Fold m b z -> Parser m x b
    -> Parser m x (y, z)
deintercalate :: Fold m a y
-> Parser m x a -> Fold m b z -> Parser m x b -> Parser m x (y, z)
deintercalate = Fold m a y
-> Parser m x a -> Fold m b z -> Parser m x b -> Parser m x (y, z)
forall a. HasCallStack => a
undefined

-------------------------------------------------------------------------------
-- Sequential Collection
-------------------------------------------------------------------------------
--
-- | @sequence f t@ collects sequential parses of parsers in the container @t@
-- using the fold @f@. Fails if the input ends or any of the parsers fail.
--
-- /Unimplemented/
--
{-# INLINE sequence #-}
sequence ::
    -- Foldable t =>
    Fold m b c -> t (Parser m a b) -> Parser m a c
sequence :: Fold m b c -> t (Parser m a b) -> Parser m a c
sequence Fold m b c
_f t (Parser m a b)
_p = Parser m a c
forall a. HasCallStack => a
undefined

-------------------------------------------------------------------------------
-- Alternative Collection
-------------------------------------------------------------------------------
--
-- | @choice parsers@ applies the @parsers@ in order and returns the first
-- successful parse.
--
{-# INLINE choice #-}
choice ::
    -- Foldable t =>
    t (Parser m a b) -> Parser m a b
choice :: t (Parser m a b) -> Parser m a b
choice t (Parser m a b)
_ps = Parser m a b
forall a. HasCallStack => a
undefined

-------------------------------------------------------------------------------
-- Sequential Repetition
-------------------------------------------------------------------------------
--
-- XXX "many" is essentially a Fold because it cannot fail. So it can be
-- downgraded to a Fold. Or we can make the return type a Fold instead and
-- upgrade that to a parser when needed.
--
-- | Collect zero or more parses. Apply the parser repeatedly on the input
-- stream, stop when the parser fails, accumulate zero or more parse results
-- using the supplied 'Fold'. This parser never fails, in case the first
-- application of parser fails it returns an empty result.
--
-- Compare with 'Control.Applicative.many'.
--
-- /Internal/
--
{-# INLINE many #-}
many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
many :: Fold m b c -> Parser m a b -> Parser m a c
many = Fold m b c -> Parser m a b -> Parser m a c
forall (m :: * -> *) b c a.
MonadCatch m =>
Fold m b c -> Parser m a b -> Parser m a c
splitMany
-- many = countBetween 0 maxBound

-- | Collect one or more parses. Apply the supplied parser repeatedly on the
-- input stream and accumulate the parse results as long as the parser
-- succeeds, stop when it fails.  This parser fails if not even one result is
-- collected.
--
-- Compare with 'Control.Applicative.some'.
--
-- /Internal/
--
{-# INLINE some #-}
some :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
some :: Fold m b c -> Parser m a b -> Parser m a c
some = Fold m b c -> Parser m a b -> Parser m a c
forall (m :: * -> *) b c a.
MonadCatch m =>
Fold m b c -> Parser m a b -> Parser m a c
splitSome
-- some f p = many (takeGE 1 f) p
-- many = countBetween 1 maxBound

-- | @countBetween m n f p@ collects between @m@ and @n@ sequential parses of
-- parser @p@ using the fold @f@. Stop after collecting @n@ results. Fails if
-- the input ends or the parser fails before @m@ results are collected.
--
-- /Unimplemented/
--
{-# INLINE countBetween #-}
countBetween ::
    -- MonadCatch m =>
    Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
countBetween :: Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
countBetween Int
_m Int
_n Fold m b c
_f = Parser m a b -> Parser m a c
forall a. HasCallStack => a
undefined
-- countBetween m n f p = many (takeBetween m n f) p

-- | @count n f p@ collects exactly @n@ sequential parses of parser @p@ using
-- the fold @f@.  Fails if the input ends or the parser fails before @n@
-- results are collected.
--
-- /Unimplemented/
--
{-# INLINE count #-}
count ::
    -- MonadCatch m =>
    Int -> Fold m b c -> Parser m a b -> Parser m a c
count :: Int -> Fold m b c -> Parser m a b -> Parser m a c
count Int
n = Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
forall (m :: * -> *) b c a.
Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
countBetween Int
n Int
n
-- count n f p = many (takeEQ n f) p

data ManyTillState fs sr sl = ManyTillR Int fs sr | ManyTillL fs sl

-- | @manyTill f collect test@ tries the parser @test@ on the input, if @test@
-- fails it backtracks and tries @collect@, after @collect@ succeeds @test@ is
-- tried again and so on. The parser stops when @test@ succeeds.  The output of
-- @test@ is discarded and the output of @collect@ is accumulated by the
-- supplied fold. The parser fails if @collect@ fails.
--
-- /Internal/
--
{-# INLINE manyTill #-}
manyTill :: MonadCatch m
    => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
manyTill :: Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
manyTill (Fold s -> b -> m s
fstep m s
finitial s -> m c
fextract)
         (Parser s -> a -> m (Step s b)
stepL m s
initialL s -> m b
extractL)
         (Parser s -> a -> m (Step s x)
stepR m s
initialR s -> m x
_) =
    (ManyTillState s s s -> a -> m (Step (ManyTillState s s s) c))
-> m (ManyTillState s s s)
-> (ManyTillState s s s -> m c)
-> Parser m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Parser m a b
Parser ManyTillState s s s -> a -> m (Step (ManyTillState s s s) c)
step m (ManyTillState s s s)
forall sl. m (ManyTillState s s sl)
initial ManyTillState s s s -> m c
forall sr. ManyTillState s sr s -> m c
extract

    where

    initial :: m (ManyTillState s s sl)
initial = do
        s
fs <- m s
finitial
        Int -> s -> s -> ManyTillState s s sl
forall fs sr sl. Int -> fs -> sr -> ManyTillState fs sr sl
ManyTillR Int
0 s
fs (s -> ManyTillState s s sl) -> m s -> m (ManyTillState s s sl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
initialR

    step :: ManyTillState s s s -> a -> m (Step (ManyTillState s s s) c)
step (ManyTillR Int
cnt s
fs s
st) a
a = do
        Step s x
r <- s -> a -> m (Step s x)
stepR s
st a
a
        case Step s x
r of
            Yield Int
n s
s -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Yield Int
n (Int -> s -> s -> ManyTillState s s s
forall fs sr sl. Int -> fs -> sr -> ManyTillState fs sr sl
ManyTillR Int
0 s
fs s
s)
            Skip Int
n s
s -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Skip Int
n (Int -> s -> s -> ManyTillState s s s
forall fs sr sl. Int -> fs -> sr -> ManyTillState fs sr sl
ManyTillR (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
fs s
s)
            Stop Int
n x
_ -> do
                c
b <- s -> m c
fextract s
fs
                Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (ManyTillState s s s) c
forall s b. Int -> b -> Step s b
Stop Int
n c
b
            Error String
_ -> do
                s
rR <- m s
initialL
                Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Skip (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (s -> s -> ManyTillState s s s
forall fs sr sl. fs -> sl -> ManyTillState fs sr sl
ManyTillL s
fs s
rR)

    step (ManyTillL s
fs s
st) a
a = do
        Step s b
r <- s -> a -> m (Step s b)
stepL s
st a
a
        case Step s b
r of
            Yield Int
n s
s -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Yield Int
n (s -> s -> ManyTillState s s s
forall fs sr sl. fs -> sl -> ManyTillState fs sr sl
ManyTillL s
fs s
s)
            Skip Int
n s
s -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Skip Int
n (s -> s -> ManyTillState s s s
forall fs sr sl. fs -> sl -> ManyTillState fs sr sl
ManyTillL s
fs s
s)
            Stop Int
n b
b -> do
                s
fs1 <- s -> b -> m s
fstep s
fs b
b
                s
l <- m s
initialR
                -- XXX we need a yield with backtrack here
                -- return $ Yield n (ManyTillR 0 fs1 l)
                Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Skip Int
n (Int -> s -> s -> ManyTillState s s s
forall fs sr sl. Int -> fs -> sr -> ManyTillState fs sr sl
ManyTillR Int
0 s
fs1 s
l)
            Error String
err -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (ManyTillState s s s) c
forall s b. String -> Step s b
Error String
err

    extract :: ManyTillState s sr s -> m c
extract (ManyTillL s
fs s
sR) = s -> m b
extractL s
sR m b -> (b -> m s) -> m s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> b -> m s
fstep s
fs m s -> (s -> m c) -> m c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m c
fextract
    extract (ManyTillR Int
_ s
fs sr
_) = s -> m c
fextract s
fs