2863

pending completion

Build # 2863

Build Type

Pull #488

travis-ci-com

Committed by

web-flow

Commit Message

<a href="https://github.com/composewell/streamly/commit/<a class=hub.com/composewell/streamly/commit/502d8ac0cb040ac5a12134b50d4c3ec42829a607">502d8ac0c<a href="https://github.com/composewell/streamly/commit/502d8ac0cb040ac5a12134b50d4c3ec42829a607">">Merge </a><a class="double-link" href="https://github.com/composewell/streamly/commit/<a class="double-link" href="https://github.com/composewell/streamly/commit/c04c71e10d0e505fd2dd91753719ff86c213f0bb">c04c71e10</a>">c04c71e10</a><a href="https://github.com/composewell/streamly/commit/502d8ac0cb040ac5a12134b50d4c3ec42829a607"> into f38b672e4">f38b672e4</a>

Pull Request Pull Request #488: Enhance the fold type to capture terminating folds

Run Details

557 of 557 new or added lines in 14 files covered. (100.0%)

3330 of 9480 relevant lines covered (35.13%)

0.35 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

55.56

/src/Streamly/Internal/Data/Parser/ParserD.hs

#include "inline.hs"

-- |
-- Module      : Streamly.Internal.Data.Parser.ParserD
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- Direct style parser implementation with stream fusion.

module Streamly.Internal.Data.Parser.ParserD
    (
      Parser (..)
    , ParseError (..)
    , Step (..)

    -- First order parsers
    -- * Accumulators
    , fromFold
    , toParserK
    , fromParserK
    , 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
    , split_

    -- ** 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

    -- ** Sequential Alternative
    , alt

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

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

    -- ** 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, concatMap)

import Streamly.Internal.Data.Fold.Types (Fold(..), liftInitialM, liftStep, liftExtract)

import qualified Streamly.Internal.Data.Parser.ParserK.Types as K
import qualified Streamly.Internal.Data.Zipper as Z
import qualified Streamly.Internal.Data.Fold.Types as FL

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

-------------------------------------------------------------------------------
-- Upgrade folds to parses
-------------------------------------------------------------------------------
--
-- | See 'Streamly.Internal.Data.Parser.fromFold'.
--
-- /Internal/
--
{-# INLINE fromFold #-}
fromFold :: Monad m => Fold m a b -> Parser m a b
fromFold (Fold fstep finitial fextract) = Parser step finitial fextract

    where

    step s a = do
        res <- fstep s a
        case res of
            FL.Yield s1 -> return $ Partial 0 s1
            FL.Stop b -> return $ Done 0 b


-------------------------------------------------------------------------------
-- Convert to and from CPS style parser representation
-------------------------------------------------------------------------------

-- | Convert a direct style 'Parser' to a CPS style 'K.Parser'.
--
-- /Internal/
--
{-# INLINE_LATE toParserK #-}
toParserK :: MonadCatch m => Parser m a b -> K.Parser m a b
toParserK (Parser step initial extract) =
    K.MkParser $ \inp yieldk ->
        Z.parse step initial extract inp >>= yieldk

-- | Convert a CPS style 'K.Parser' to a direct style 'Parser'.
--
-- /Unimplemented/
--
{-# NOINLINE fromParserK #-}
fromParserK :: Monad m => K.Parser m a b -> Parser m a b
fromParserK _ = Parser step initial extract

    where

    initial = return ()
    step () _ = error "fromParserK: unimplemented"
    extract () = error "fromParserK: unimplemented"

#ifndef DISABLE_FUSION
{-# RULES "fromParserK/toParserK fusion" [2]
    forall s. toParserK (fromParserK s) = s #-}
{-# RULES "toParserK/fromParserK fusion" [2]
    forall s. fromParserK (toParserK s) = s #-}
#endif

-------------------------------------------------------------------------------
-- Terminating but not failing folds
-------------------------------------------------------------------------------
--
{-# INLINE any #-}
any :: Monad m => (a -> Bool) -> Parser m a Bool
any predicate = Parser step initial return

    where

    initial = return False

    step s a = return (if s || predicate a then Done 0 True else Partial 0 False)

{-# INLINABLE all #-}
all :: Monad m => (a -> Bool) -> Parser m a Bool
all predicate = Parser step initial return

    where

    initial = return True

    step s a = return (if s && predicate a then Partial 0 True else Done 0 False)

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

-- | See 'Streamly.Internal.Data.Parser.peek'.
--
-- /Internal/
--
{-# INLINABLE peek #-}
peek :: MonadThrow m => Parser m a a
peek = Parser step initial extract

    where

    initial = return ()

    step () a = return $ Done 1 a

    extract () = throwM $ ParseError "peek: end of input"

-- | See 'Streamly.Internal.Data.Parser.eof'.
--
-- /Internal/
--
{-# INLINABLE eof #-}
eof :: Monad m => Parser m a ()
eof = Parser step initial return

    where

    initial = return ()

    step () _ = return $ Error "eof: not at end of input"

-- | See 'Streamly.Internal.Data.Parser.satisfy'.
--
-- /Internal/
--
{-# INLINE satisfy #-}
satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
satisfy predicate = Parser step initial extract

    where

    initial = return ()

    step () a = return $
        if predicate a
        then Done 0 a
        else Error "satisfy: predicate failed"

    extract _ = throwM $ ParseError "satisfy: end of input"

-------------------------------------------------------------------------------
-- Taking elements
-------------------------------------------------------------------------------
--
-- | See 'Streamly.Internal.Data.Parser.take'.
--
-- /Internal/
--
{-# INLINE take #-}
take :: Monad m => Int -> Fold m a b -> Parser m a b
take n (Fold fstep finitial fextract) = Parser step initial extract

     where

    initial = Tuple' 0 <$> liftInitialM finitial

    step (Tuple' i r) a
        | i < n = do
            res <- liftStep fstep r a
            let i1 = i + 1
                s1 = Tuple' i1 res
            if i1 < n
            then return $ Partial 0 s1
            else Done 0 <$> liftExtract fextract res
        | otherwise = Done 1 <$> liftExtract fextract r

    extract (Tuple' _ r) = liftExtract fextract r

-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
--
-- /Internal/
--
{-# INLINE takeEQ #-}
takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
takeEQ cnt (Fold fstep finitial fextract) = Parser step initial extract

    where

    n = max cnt 0

    initial = Tuple' 0 <$> liftInitialM finitial

    step (Tuple' i r) a
      | i < n = do
          res <- liftStep fstep r a
          let i1 = i + 1
              s1 = Tuple' i1 res
          if i1 < n
          then return (Continue 0 s1)
          else Done 0 <$> liftExtract fextract res
      | otherwise = Done 1 <$> liftExtract fextract r

    extract (Tuple' i r) =
        if n == i
        then liftExtract fextract r
        else throwM $ ParseError err

        where

        err =
               "takeEQ: Expecting exactly " ++ show n
            ++ " elements, got " ++ show i

-- | See 'Streamly.Internal.Data.Parser.takeGE'.
--
-- /Internal/
--
{-# INLINE takeGE #-}
takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
takeGE cnt (Fold fstep finitial fextract) = Parser step initial extract
    where

    n = max cnt 0

    initial = Tuple' 0 <$> liftInitialM finitial

    step (Tuple' i r) a = do
        res <- liftStep fstep r a
        let i1 = i + 1
            s1 = Tuple' i1 res
        return $
            if i1 < n
            then Continue 0 s1
            else Partial 0 s1

    extract (Tuple' i r) = liftExtract fextract r >>= f

        where

        err =
              "takeGE: Expecting at least " ++ show n
           ++ " elements, got only " ++ show i

        f x =
            if i >= n
            then return x
            else throwM $ ParseError err

-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
--
-- /Internal/
--
{-# INLINE takeWhile #-}
takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
takeWhile predicate (Fold fstep finitial fextract) =
    Parser step initial (liftExtract fextract)

    where

    initial = liftInitialM finitial

    step s a =
        if predicate a
        then Partial 0 <$> liftStep fstep s a
        else Done 1 <$> liftExtract fextract s

-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
--
-- /Internal/
--
{-# INLINE takeWhile1 #-}
takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
takeWhile1 predicate (Fold fstep finitial fextract) =
    Parser step initial extract

    where

    initial = return Nothing

    step Nothing a =
        if predicate a
        then do
            s <- finitial
            r <- fstep s a
            return $ Partial 0 (Just r)
        else return $ Error "takeWhile1: empty"
    step (Just s) a =
        if predicate a
        then do
            r <- liftStep fstep s a
            return $ Partial 0 (Just r)
        else do
            b <- liftExtract fextract s
            return $ Done 1 b

    extract Nothing = throwM $ ParseError "takeWhile1: end of input"
    extract (Just s) = liftExtract fextract s

-- | See 'Streamly.Internal.Data.Parser.sliceSepBy'.
--
-- /Internal/
--
{-# INLINABLE sliceSepBy #-}
sliceSepBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
sliceSepBy predicate (Fold fstep finitial fextract) =
    Parser step initial (liftExtract fextract)

    where

    initial = liftInitialM finitial
    step s a =
        if not (predicate a)
        then Partial 0 <$> liftStep fstep s a
        else Done 0 <$> liftExtract fextract s

-- | See 'Streamly.Internal.Data.Parser.sliceEndWith'.
--
-- /Unimplemented/
--
{-# INLINABLE sliceEndWith #-}
sliceEndWith ::
    -- Monad m =>
    (a -> Bool) -> Fold m a b -> Parser m a b
sliceEndWith = undefined

-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
--
-- /Unimplemented/
--
{-# INLINABLE sliceBeginWith #-}
sliceBeginWith ::
    -- Monad m =>
    (a -> Bool) -> Fold m a b -> Parser m a b
sliceBeginWith = undefined

-- | See 'Streamly.Internal.Data.Parser.sliceSepByMax'.
--
-- /Internal/
--
{-# INLINABLE sliceSepByMax #-}
sliceSepByMax :: Monad m
    => (a -> Bool) -> Int -> Fold m a b -> Parser m a b
sliceSepByMax predicate cnt (Fold fstep finitial fextract) =
    Parser step initial extract

    where

    initial = Tuple' 0 <$> liftInitialM finitial

    step (Tuple' i r) a
        | not (predicate a) =
            if i < cnt
            then do
                res <- liftStep fstep r a
                let i1 = i + 1
                    s1 = Tuple' i1 res
                return $ Partial 0 s1
            else Done 1 <$> liftExtract fextract r
        | otherwise = Done 0 <$> liftExtract fextract r

    extract (Tuple' _ r) = liftExtract fextract r

-- | See 'Streamly.Internal.Data.Parser.wordBy'.
--
-- /Unimplemented/
--
{-# INLINABLE wordBy #-}
wordBy ::
    -- Monad m =>
    (a -> Bool) -> Fold m a b -> Parser m a b
wordBy = undefined

-- | See 'Streamly.Internal.Data.Parser.groupBy'.
--
-- /Unimplemented/
--
{-# INLINABLE groupBy #-}
groupBy ::
    -- Monad m =>
    (a -> a -> Bool) -> Fold m a b -> Parser m a b
groupBy = undefined

-- XXX use an Unfold instead of a list?
-- XXX custom combinators for matching list, array and stream?
--
-- | See 'Streamly.Internal.Data.Parser.eqBy'.
--
-- /Internal/
--
{-# INLINE eqBy #-}
eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
eqBy cmp str = Parser step initial extract

    where

    initial = return str

    step [] _ = return $ Done 0 ()
    step [x] a = return $
        if x `cmp` a
        then Done 0 ()
        else Error "eqBy: failed, yet to match the last element"
    step (x:xs) a = return $
        if x `cmp` a
        then Continue 0 xs
        else Error $
            "eqBy: failed, yet to match " ++ show (length xs + 1) ++ " elements"

    extract xs = throwM $ ParseError $
        "eqBy: end of input, yet to match " ++ show (length xs) ++ " elements"

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

-- | See 'Streamly.Internal.Data.Parser.lookahead'.
--
-- /Internal/
--
{-# INLINE lookAhead #-}
lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
lookAhead (Parser step1 initial1 _) =
    Parser step initial extract

    where

    initial = Tuple' 0 <$> initial1

    step (Tuple' cnt st) a = do
        r <- step1 st a
        let cnt1 = cnt + 1
        return $ case r of
            Partial n s -> Continue n (Tuple' (cnt1 - n) s)
            Continue n s -> Continue n (Tuple' (cnt1 - n) s)
            Done _ b -> Done cnt1 b
            Error err -> Error 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' n _) = throwM $ ParseError $
        "lookAhead: end of input after consuming " ++ show n ++ " elements"

-------------------------------------------------------------------------------
-- Interleaving
-------------------------------------------------------------------------------
--
-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
--
-- /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 = undefined

-------------------------------------------------------------------------------
-- Sequential Collection
-------------------------------------------------------------------------------
--
-- | See 'Streamly.Internal.Data.Parser.sequence'.
--
-- /Unimplemented/
--
{-# INLINE sequence #-}
sequence ::
    -- Foldable t =>
    Fold m b c -> t (Parser m a b) -> Parser m a c
sequence _f _p = undefined

-------------------------------------------------------------------------------
-- Alternative Collection
-------------------------------------------------------------------------------
--
-- | See 'Streamly.Internal.Data.Parser.choice'.
--
-- /Unimplemented/
--
{-# INLINE choice #-}
choice ::
    -- Foldable t =>
    t (Parser m a b) -> Parser m a b
choice _ps = undefined

-------------------------------------------------------------------------------
-- Sequential Repetition
-------------------------------------------------------------------------------
--
-- | See 'Streamly.Internal.Data.Parser.many'.
--
-- /Internal/
--
{-# INLINE many #-}
many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
many = splitMany
-- many = countBetween 0 maxBound

-- | See 'Streamly.Internal.Data.Parser.some'.
--
-- /Internal/
--
{-# INLINE some #-}
some :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
some = splitSome
-- some f p = many (takeGE 1 f) p
-- many = countBetween 1 maxBound

-- | See 'Streamly.Internal.Data.Parser.countBetween'.
--
-- /Unimplemented/
--
{-# INLINE countBetween #-}
countBetween ::
    -- MonadCatch m =>
    Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
countBetween _m _n _f = undefined
-- countBetween m n f p = many (takeBetween m n f) p

-- | See 'Streamly.Internal.Data.Parser.count'.
--
-- /Unimplemented/
--
{-# INLINE count #-}
count ::
    -- MonadCatch m =>
    Int -> Fold m b c -> Parser m a b -> Parser m a c
count n = countBetween n n
-- count n f p = many (takeEQ n f) p

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

-- | See 'Streamly.Internal.Data.Parser.manyTill'.
--
-- /Internal/
--
{-# INLINE manyTill #-}
manyTill :: MonadCatch m
    => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
manyTill (Fold fstep finitial fextract)
         (Parser stepL initialL extractL)
         (Parser stepR initialR _) =
    Parser step initial extract

    where

    initial = do
        fs <- liftInitialM finitial
        ManyTillR 0 fs <$> initialR

    step (ManyTillR cnt fs st) a = do
        r <- stepR st a
        case r of
            Partial n s -> return $ Partial n (ManyTillR 0 fs s)
            Continue n s -> do
                assert (cnt + 1 - n >= 0) (return ())
                return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
            Done n _ -> do
                b <- liftExtract fextract fs
                return $ Done n b
            Error _ -> do
                rR <- initialL
                return $ Continue (cnt + 1) (ManyTillL fs rR)

    step (ManyTillL fs st) a = do
        r <- stepL st a
        case r of
            Partial n s -> return $ Partial n (ManyTillL fs s)
            Continue n s -> return $ Continue n (ManyTillL fs s)
            Done n b -> do
                fs1 <- liftStep fstep fs b
                l <- initialR
                return $ Partial n (ManyTillR 0 fs1 l)
            Error err -> return $ Error err

    extract (ManyTillL fs sR) = extractL sR >>= liftStep fstep fs >>= liftExtract fextract
    extract (ManyTillR _ fs _) = liftExtract fextract fs

1	#include "inline.hs"
2
3	-- \|
4	-- Module : Streamly.Internal.Data.Parser.ParserD
5	-- Copyright : (c) 2020 Composewell Technologies
6	-- License : BSD-3-Clause
7	-- Maintainer : streamly@composewell.com
8	-- Stability : experimental
9	-- Portability : GHC
10	--
11	-- Direct style parser implementation with stream fusion.
12
13	module Streamly.Internal.Data.Parser.ParserD
14	(
15	Parser (..)
16	, ParseError (..)
17	, Step (..)
18
19	-- First order parsers
20	-- * Accumulators
21	, fromFold
22	, toParserK
23	, fromParserK
24	, any
25	, all
26	, yield
27	, yieldM
28	, die
29	, dieM
30
31	-- * Element parsers
32	, peek
33	, eof
34	, satisfy
35
36	-- * Sequence parsers
37	--
38	-- Parsers chained in series, if one parser terminates the composition
39	-- terminates. Currently we are using folds to collect the output of the
40	-- parsers but we can use Parsers instead of folds to make the composition
41	-- more powerful. For example, we can do:
42	--
43	-- sliceSepByMax cond n p = sliceBy cond (take n p)
44	-- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)
45	-- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
46	--
47	-- Grab a sequence of input elements without inspecting them
48	, take
49	-- , takeBetween
50	-- , takeLE -- take -- takeBetween 0 n
51	-- , takeLE1 -- take1 -- takeBetween 1 n
52	, takeEQ -- takeBetween n n
53	, takeGE -- takeBetween n maxBound
54
55	-- Grab a sequence of input elements by inspecting them
56	, lookAhead
57	, takeWhile
58	, takeWhile1
59	, sliceSepBy
60	, sliceSepByMax
61	-- , sliceSepByBetween
62	, sliceEndWith
63	, sliceBeginWith
64	-- , sliceSepWith
65	--
66	-- , frameSepBy -- parse frames escaped by an escape char/sequence
67	-- , frameEndWith
68	--
69	, wordBy
70	, groupBy
71	, eqBy
72	-- , prefixOf -- match any prefix of a given string
73	-- , suffixOf -- match any suffix of a given string
74	-- , infixOf -- match any substring of a given string
75
76	-- Second order parsers (parsers using parsers)
77	-- * Binary Combinators
78
79	-- ** Sequential Applicative
80	, splitWith
81	, split_
82
83	-- ** Parallel Applicatives
84	, teeWith
85	, teeWithFst
86	, teeWithMin
87	-- , teeTill -- like manyTill but parallel
88
89	-- ** Sequential Interleaving
90	-- Use two folds, run a primary parser, its rejected values go to the
91	-- secondary parser.
92	, deintercalate
93
94	-- ** Sequential Alternative
95	, alt
96
97	-- ** Parallel Alternatives
98	, shortest
99	, longest
100	-- , fastest
101
102	-- * N-ary Combinators
103	-- ** Sequential Collection
104	, sequence
105	, concatMap
106
107	-- ** Sequential Repetition
108	, count
109	, countBetween
110	-- , countBetweenTill
111
112	, many
113	, some
114	, manyTill
115
116	-- -- ** Special cases
117	-- XXX traditional implmentations of these may be of limited use. For
118	-- example, consider parsing lines separated by "\r\n". The main parser
119	-- will have to detect and exclude the sequence "\r\n" anyway so that we
120	-- can apply the "sep" parser.
121	--
122	-- We can instead implement these as special cases of deintercalate.
123	--
124	-- , endBy
125	-- , sepBy
126	-- , sepEndBy
127	-- , beginBy
128	-- , sepBeginBy
129	-- , sepAroundBy
130
131	-- -- * Distribution
132	--
133	-- A simple and stupid impl would be to just convert the stream to an array
134	-- and give the array reference to all consumers. The array can be grown on
135	-- demand by any consumer and truncated when nonbody needs it.
136	--
137	-- -- ** Distribute to collection
138	-- -- ** Distribute to repetition
139
140	-- -- ** Interleaved collection
141	-- Round robin
142	-- Priority based
143	-- -- ** Interleaved repetition
144	-- repeat one parser and when it fails run an error recovery parser
145	-- e.g. to find a key frame in the stream after an error
146
147	-- ** Collection of Alternatives
148	-- , shortestN
149	-- , longestN
150	-- , fastestN -- first N successful in time
151	-- , choiceN -- first N successful in position
152	, choice -- first successful in position
153
154	-- -- ** Repeated Alternatives
155	-- , retryMax -- try N times
156	-- , retryUntil -- try until successful
157	-- , retryUntilN -- try until successful n times
158	)
159	where
160
161	import Control.Exception (assert)
162	import Control.Monad.Catch (MonadCatch, MonadThrow(..))
163	import Prelude
164	hiding (any, all, take, takeWhile, sequence, concatMap)
165
166	import Streamly.Internal.Data.Fold.Types (Fold(..), liftInitialM, liftStep, liftExtract)
167
168	import qualified Streamly.Internal.Data.Parser.ParserK.Types as K
169	import qualified Streamly.Internal.Data.Zipper as Z
170	import qualified Streamly.Internal.Data.Fold.Types as FL
171
172	import Streamly.Internal.Data.Parser.ParserD.Tee
173	import Streamly.Internal.Data.Parser.ParserD.Types
174	import Streamly.Internal.Data.Strict
175
176	-------------------------------------------------------------------------------
177	-- Upgrade folds to parses
178	-------------------------------------------------------------------------------
179	--
180	-- \| See 'Streamly.Internal.Data.Parser.fromFold'.
181	--
182	-- /Internal/
183	--
184	{-# INLINE fromFold #-}
185	fromFold :: Monad m => Fold m a b -> Parser m a b
186	fromFold (Fold fstep finitial fextract) = Parser step finitial fextract	1✔
187
188	where
189
190	step s a = do	1✔
191	res <- fstep s a	1✔
192	case res of	1✔
193	FL.Yield s1 -> return $ Partial 0 s1	1✔
194	FL.Stop b -> return $ Done 0 b	×
195
196
197	-------------------------------------------------------------------------------
198	-- Convert to and from CPS style parser representation
199	-------------------------------------------------------------------------------
200
201	-- \| Convert a direct style 'Parser' to a CPS style 'K.Parser'.
202	--
203	-- /Internal/
204	--
205	{-# INLINE_LATE toParserK #-}
206	toParserK :: MonadCatch m => Parser m a b -> K.Parser m a b
207	toParserK (Parser step initial extract) =	1✔
208	K.MkParser $ \inp yieldk ->	1✔
209	Z.parse step initial extract inp >>= yieldk	1✔
210
211	-- \| Convert a CPS style 'K.Parser' to a direct style 'Parser'.
212	--
213	-- /Unimplemented/
214	--
215	{-# NOINLINE fromParserK #-}
216	fromParserK :: Monad m => K.Parser m a b -> Parser m a b
217	fromParserK _ = Parser step initial extract	×
218
219	where
220
221	initial = return ()	×
222	step () _ = error "fromParserK: unimplemented"	×
223	extract () = error "fromParserK: unimplemented"	×
224
225	#ifndef DISABLE_FUSION
226	{-# RULES "fromParserK/toParserK fusion" [2]
227	forall s. toParserK (fromParserK s) = s #-}
228	{-# RULES "toParserK/fromParserK fusion" [2]
229	forall s. fromParserK (toParserK s) = s #-}
230	#endif
231
232	-------------------------------------------------------------------------------
233	-- Terminating but not failing folds
234	-------------------------------------------------------------------------------
235	--
236	{-# INLINE any #-}
237	any :: Monad m => (a -> Bool) -> Parser m a Bool
238	any predicate = Parser step initial return	1✔
239
240	where
241
242	initial = return False	1✔
243
244	step s a = return (if s \|\| predicate a then Done 0 True else Partial 0 False)	×
245
246	{-# INLINABLE all #-}
247	all :: Monad m => (a -> Bool) -> Parser m a Bool
248	all predicate = Parser step initial return	1✔
249
250	where
251
252	initial = return True	1✔
253
254	step s a = return (if s && predicate a then Partial 0 True else Done 0 False)	×
255
256	-------------------------------------------------------------------------------
257	-- Failing Parsers
258	-------------------------------------------------------------------------------
259
260	-- \| See 'Streamly.Internal.Data.Parser.peek'.
261	--
262	-- /Internal/
263	--
264	{-# INLINABLE peek #-}
265	peek :: MonadThrow m => Parser m a a
266	peek = Parser step initial extract	1✔
267
268	where
269
270	initial = return ()	1✔
271
272	step () a = return $ Done 1 a	×
273
274	extract () = throwM $ ParseError "peek: end of input"	×
275
276	-- \| See 'Streamly.Internal.Data.Parser.eof'.
277	--
278	-- /Internal/
279	--
280	{-# INLINABLE eof #-}
281	eof :: Monad m => Parser m a ()
282	eof = Parser step initial return	1✔
283
284	where
285
286	initial = return ()	1✔
287
288	step () _ = return $ Error "eof: not at end of input"	×
289
290	-- \| See 'Streamly.Internal.Data.Parser.satisfy'.
291	--
292	-- /Internal/
293	--
294	{-# INLINE satisfy #-}
295	satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
296	satisfy predicate = Parser step initial extract	1✔
297
298	where
299
300	initial = return ()	1✔
301
302	step () a = return $	1✔
303	if predicate a	1✔
304	then Done 0 a	1✔
305	else Error "satisfy: predicate failed"	×
306
307	extract _ = throwM $ ParseError "satisfy: end of input"	×
308
309	-------------------------------------------------------------------------------
310	-- Taking elements
311	-------------------------------------------------------------------------------
312	--
313	-- \| See 'Streamly.Internal.Data.Parser.take'.
314	--
315	-- /Internal/
316	--
317	{-# INLINE take #-}
318	take :: Monad m => Int -> Fold m a b -> Parser m a b
319	take n (Fold fstep finitial fextract) = Parser step initial extract	1✔
320
321	where
322
323	initial = Tuple' 0 <$> liftInitialM finitial	1✔
324
325	step (Tuple' i r) a	1✔
326	\| i < n = do	1✔
327	res <- liftStep fstep r a	1✔
328	let i1 = i + 1	1✔
329	s1 = Tuple' i1 res	1✔
330	if i1 < n	1✔
331	then return $ Partial 0 s1	1✔
332	else Done 0 <$> liftExtract fextract res	×
333	\| otherwise = Done 1 <$> liftExtract fextract r	×
334
335	extract (Tuple' _ r) = liftExtract fextract r	1✔
336
337	-- \| See 'Streamly.Internal.Data.Parser.takeEQ'.
338	--
339	-- /Internal/
340	--
341	{-# INLINE takeEQ #-}
342	takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
343	takeEQ cnt (Fold fstep finitial fextract) = Parser step initial extract	1✔
344
345	where
346
347	n = max cnt 0	1✔
348
349	initial = Tuple' 0 <$> liftInitialM finitial	1✔
350
351	step (Tuple' i r) a	1✔
352	\| i < n = do	1✔
353	res <- liftStep fstep r a	1✔
354	let i1 = i + 1	1✔
355	s1 = Tuple' i1 res	1✔
356	if i1 < n	1✔
357	then return (Continue 0 s1)	1✔
358	else Done 0 <$> liftExtract fextract res	×
359	\| otherwise = Done 1 <$> liftExtract fextract r	×
360
361	extract (Tuple' i r) =	1✔
362	if n == i	1✔
363	then liftExtract fextract r	1✔
364	else throwM $ ParseError err	×
365
366	where
367
368	err =	×
369	"takeEQ: Expecting exactly " ++ show n	×
370	++ " elements, got " ++ show i	×
371
372	-- \| See 'Streamly.Internal.Data.Parser.takeGE'.
373	--
374	-- /Internal/
375	--
376	{-# INLINE takeGE #-}
377	takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
378	takeGE cnt (Fold fstep finitial fextract) = Parser step initial extract	1✔
379	where
380
381	n = max cnt 0	1✔
382
383	initial = Tuple' 0 <$> liftInitialM finitial	1✔
384
385	step (Tuple' i r) a = do	1✔
386	res <- liftStep fstep r a	1✔
387	let i1 = i + 1	1✔
388	s1 = Tuple' i1 res	1✔
389	return $	1✔
390	if i1 < n	1✔
391	then Continue 0 s1	1✔
392	else Partial 0 s1	1✔
393
394	extract (Tuple' i r) = liftExtract fextract r >>= f	1✔
395
396	where
397
398	err =	×
399	"takeGE: Expecting at least " ++ show n	×
400	++ " elements, got only " ++ show i	×
401
402	f x =	1✔
403	if i >= n	1✔
404	then return x	1✔
405	else throwM $ ParseError err	×
406
407	-- \| See 'Streamly.Internal.Data.Parser.takeWhile'.
408	--
409	-- /Internal/
410	--
411	{-# INLINE takeWhile #-}
412	takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
413	takeWhile predicate (Fold fstep finitial fextract) =	1✔
414	Parser step initial (liftExtract fextract)	1✔
415
416	where
417
418	initial = liftInitialM finitial	1✔
419
420	step s a =	1✔
421	if predicate a	1✔
422	then Partial 0 <$> liftStep fstep s a	1✔
423	else Done 1 <$> liftExtract fextract s	1✔
424
425	-- \| See 'Streamly.Internal.Data.Parser.takeWhile1'.
426	--
427	-- /Internal/
428	--
429	{-# INLINE takeWhile1 #-}
430	takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
431	takeWhile1 predicate (Fold fstep finitial fextract) =	1✔
432	Parser step initial extract	1✔
433
434	where
435
436	initial = return Nothing	1✔
437
438	step Nothing a =	1✔
439	if predicate a	1✔
440	then do	1✔
441	s <- finitial	1✔
442	r <- fstep s a	1✔
443	return $ Partial 0 (Just r)	1✔
444	else return $ Error "takeWhile1: empty"	×
445	step (Just s) a =
446	if predicate a	1✔
447	then do	1✔
448	r <- liftStep fstep s a	1✔
449	return $ Partial 0 (Just r)	1✔
450	else do	1✔
451	b <- liftExtract fextract s	1✔
452	return $ Done 1 b	×
453
454	extract Nothing = throwM $ ParseError "takeWhile1: end of input"	×
455	extract (Just s) = liftExtract fextract s	1✔
456
457	-- \| See 'Streamly.Internal.Data.Parser.sliceSepBy'.
458	--
459	-- /Internal/
460	--
461	{-# INLINABLE sliceSepBy #-}
462	sliceSepBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
463	sliceSepBy predicate (Fold fstep finitial fextract) =	1✔
464	Parser step initial (liftExtract fextract)	1✔
465
466	where
467
468	initial = liftInitialM finitial	1✔
469	step s a =	1✔
470	if not (predicate a)	1✔
471	then Partial 0 <$> liftStep fstep s a	1✔
472	else Done 0 <$> liftExtract fextract s	1✔
473
474	-- \| See 'Streamly.Internal.Data.Parser.sliceEndWith'.
475	--
476	-- /Unimplemented/
477	--
478	{-# INLINABLE sliceEndWith #-}
479	sliceEndWith ::
480	-- Monad m =>
481	(a -> Bool) -> Fold m a b -> Parser m a b
482	sliceEndWith = undefined	×
483
484	-- \| See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
485	--
486	-- /Unimplemented/
487	--
488	{-# INLINABLE sliceBeginWith #-}
489	sliceBeginWith ::
490	-- Monad m =>
491	(a -> Bool) -> Fold m a b -> Parser m a b
492	sliceBeginWith = undefined	×
493
494	-- \| See 'Streamly.Internal.Data.Parser.sliceSepByMax'.
495	--
496	-- /Internal/
497	--
498	{-# INLINABLE sliceSepByMax #-}
499	sliceSepByMax :: Monad m
500	=> (a -> Bool) -> Int -> Fold m a b -> Parser m a b
501	sliceSepByMax predicate cnt (Fold fstep finitial fextract) =	1✔
502	Parser step initial extract	1✔
503
504	where
505
506	initial = Tuple' 0 <$> liftInitialM finitial	1✔
507
508	step (Tuple' i r) a	1✔
509	\| not (predicate a) =	1✔
510	if i < cnt	×
511	then do	1✔
512	res <- liftStep fstep r a	1✔
513	let i1 = i + 1	1✔
514	s1 = Tuple' i1 res	1✔
515	return $ Partial 0 s1	1✔
516	else Done 1 <$> liftExtract fextract r	×
517	\| otherwise = Done 0 <$> liftExtract fextract r	×
518
519	extract (Tuple' _ r) = liftExtract fextract r	1✔
520
521	-- \| See 'Streamly.Internal.Data.Parser.wordBy'.
522	--
523	-- /Unimplemented/
524	--
525	{-# INLINABLE wordBy #-}
526	wordBy ::
527	-- Monad m =>
528	(a -> Bool) -> Fold m a b -> Parser m a b
529	wordBy = undefined	×
530
531	-- \| See 'Streamly.Internal.Data.Parser.groupBy'.
532	--
533	-- /Unimplemented/
534	--
535	{-# INLINABLE groupBy #-}
536	groupBy ::
537	-- Monad m =>
538	(a -> a -> Bool) -> Fold m a b -> Parser m a b
539	groupBy = undefined	×
540
541	-- XXX use an Unfold instead of a list?
542	-- XXX custom combinators for matching list, array and stream?
543	--
544	-- \| See 'Streamly.Internal.Data.Parser.eqBy'.
545	--
546	-- /Internal/
547	--
548	{-# INLINE eqBy #-}
549	eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
550	eqBy cmp str = Parser step initial extract	×
551
552	where
553
554	initial = return str	×
555
556	step [] _ = return $ Done 0 ()	×
557	step [x] a = return $	×
558	if x `cmp` a	×
559	then Done 0 ()	×
560	else Error "eqBy: failed, yet to match the last element"	×
561	step (x:xs) a = return $	×
562	if x `cmp` a	×
563	then Continue 0 xs	×
564	else Error $	×
565	"eqBy: failed, yet to match " ++ show (length xs + 1) ++ " elements"	×
566
567	extract xs = throwM $ ParseError $	×
568	"eqBy: end of input, yet to match " ++ show (length xs) ++ " elements"	×
569
570	-------------------------------------------------------------------------------
571	-- nested parsers
572	-------------------------------------------------------------------------------
573
574	-- \| See 'Streamly.Internal.Data.Parser.lookahead'.
575	--
576	-- /Internal/
577	--
578	{-# INLINE lookAhead #-}
579	lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
580	lookAhead (Parser step1 initial1 _) =	1✔
581	Parser step initial extract	1✔
582
583	where
584
585	initial = Tuple' 0 <$> initial1	1✔
586
587	step (Tuple' cnt st) a = do	1✔
588	r <- step1 st a	1✔
589	let cnt1 = cnt + 1	1✔
590	return $ case r of	1✔
591	Partial n s -> Continue n (Tuple' (cnt1 - n) s)	1✔
592	Continue n s -> Continue n (Tuple' (cnt1 - n) s)	×
593	Done _ b -> Done cnt1 b	1✔
594	Error err -> Error err	×
595
596	-- XXX returning an error let's us backtrack. To implement it in a way so
597	-- that it terminates on eof without an error then we need a way to
598	-- backtrack on eof, that will require extract to return 'Step' type.
599	extract (Tuple' n _) = throwM $ ParseError $	×
600	"lookAhead: end of input after consuming " ++ show n ++ " elements"	×
601
602	-------------------------------------------------------------------------------
603	-- Interleaving
604	-------------------------------------------------------------------------------
605	--
606	-- \| See 'Streamly.Internal.Data.Parser.deintercalate'.
607	--
608	-- /Unimplemented/
609	--
610	{-# INLINE deintercalate #-}
611	deintercalate ::
612	-- Monad m =>
613	Fold m a y -> Parser m x a
614	-> Fold m b z -> Parser m x b
615	-> Parser m x (y, z)
616	deintercalate = undefined	×
617
618	-------------------------------------------------------------------------------
619	-- Sequential Collection
620	-------------------------------------------------------------------------------
621	--
622	-- \| See 'Streamly.Internal.Data.Parser.sequence'.
623	--
624	-- /Unimplemented/
625	--
626	{-# INLINE sequence #-}
627	sequence ::
628	-- Foldable t =>
629	Fold m b c -> t (Parser m a b) -> Parser m a c
630	sequence _f _p = undefined	×
631
632	-------------------------------------------------------------------------------
633	-- Alternative Collection
634	-------------------------------------------------------------------------------
635	--
636	-- \| See 'Streamly.Internal.Data.Parser.choice'.
637	--
638	-- /Unimplemented/
639	--
640	{-# INLINE choice #-}
641	choice ::
642	-- Foldable t =>
643	t (Parser m a b) -> Parser m a b
644	choice _ps = undefined	×
645
646	-------------------------------------------------------------------------------
647	-- Sequential Repetition
648	-------------------------------------------------------------------------------
649	--
650	-- \| See 'Streamly.Internal.Data.Parser.many'.
651	--
652	-- /Internal/
653	--
654	{-# INLINE many #-}
655	many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
656	many = splitMany	1✔
657	-- many = countBetween 0 maxBound
658
659	-- \| See 'Streamly.Internal.Data.Parser.some'.
660	--
661	-- /Internal/
662	--
663	{-# INLINE some #-}
664	some :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
665	some = splitSome	×
666	-- some f p = many (takeGE 1 f) p
667	-- many = countBetween 1 maxBound
668
669	-- \| See 'Streamly.Internal.Data.Parser.countBetween'.
670	--
671	-- /Unimplemented/
672	--
673	{-# INLINE countBetween #-}
674	countBetween ::
675	-- MonadCatch m =>
676	Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
677	countBetween _m _n _f = undefined	×
678	-- countBetween m n f p = many (takeBetween m n f) p
679
680	-- \| See 'Streamly.Internal.Data.Parser.count'.
681	--
682	-- /Unimplemented/
683	--
684	{-# INLINE count #-}
685	count ::
686	-- MonadCatch m =>
687	Int -> Fold m b c -> Parser m a b -> Parser m a c
688	count n = countBetween n n	×
689	-- count n f p = many (takeEQ n f) p
690
691	data ManyTillState fs sr sl = ManyTillR Int fs sr \| ManyTillL fs sl
692
693	-- \| See 'Streamly.Internal.Data.Parser.manyTill'.
694	--
695	-- /Internal/
696	--
697	{-# INLINE manyTill #-}
698	manyTill :: MonadCatch m
699	=> Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
700	manyTill (Fold fstep finitial fextract)	×
701	(Parser stepL initialL extractL)
702	(Parser stepR initialR _) =
703	Parser step initial extract	×
704
705	where
706
707	initial = do	×
708	fs <- liftInitialM finitial	×
709	ManyTillR 0 fs <$> initialR	×
710
711	step (ManyTillR cnt fs st) a = do	×
712	r <- stepR st a	×
713	case r of	×
714	Partial n s -> return $ Partial n (ManyTillR 0 fs s)	×
715	Continue n s -> do	×
716	assert (cnt + 1 - n >= 0) (return ())	×
717	return $ Continue n (ManyTillR (cnt + 1 - n) fs s)	×
718	Done n _ -> do	×
719	b <- liftExtract fextract fs	×
720	return $ Done n b	×
721	Error _ -> do	×
722	rR <- initialL	×
723	return $ Continue (cnt + 1) (ManyTillL fs rR)	×
724
725	step (ManyTillL fs st) a = do	×
726	r <- stepL st a	×
727	case r of	×
728	Partial n s -> return $ Partial n (ManyTillL fs s)	×
729	Continue n s -> return $ Continue n (ManyTillL fs s)	×
730	Done n b -> do	×
731	fs1 <- liftStep fstep fs b	×
732	l <- initialR	×
733	return $ Partial n (ManyTillR 0 fs1 l)	×
734	Error err -> return $ Error err	×
735
736	extract (ManyTillL fs sR) = extractL sR >>= liftStep fstep fs >>= liftExtract fextract	×
737	extract (ManyTillR _ fs _) = liftExtract fextract fs	×

composewell / streamly / 2863

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous