3024

pending completion

Build # 3024

Build Type

Pull #625

travis-ci-com

Committed by

web-flow

Commit Message

<a href="https://github.com/composewell/streamly/commit/<a class=hub.com/composewell/streamly/commit/cc57cf142daaf496d75a9b860af21e1659d3ce26">cc57cf142<a href="https://github.com/composewell/streamly/commit/cc57cf142daaf496d75a9b860af21e1659d3ce26">">Merge </a><a class="double-link" href="https://github.com/composewell/streamly/commit/<a class="double-link" href="https://github.com/composewell/streamly/commit/1523140826b47d242fabce374efa1608630dca35">152314082</a>">152314082</a><a href="https://github.com/composewell/streamly/commit/cc57cf142daaf496d75a9b860af21e1659d3ce26"> into 9851d18f9">9851d18f9</a>

Pull Request Pull Request #625: Add maybe and either parsers

Run Details

29 of 29 new or added lines in 3 files covered. (100.0%)

3369 of 9408 relevant lines covered (35.81%)

0.36 hits per line

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

60.2

/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
    , any
    , all
    , yield
    , yieldM
    , die
    , dieM

    -- * Element parsers
    , peek
    , eof
    , satisfy
    , maybe
    , either

    -- * 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, maybe, either)
import Streamly.Internal.Data.Fold.Types (Fold(..))

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 = Partial 0 <$> fstep s a

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

-- | See 'Streamly.Internal.Data.Parser.maybe'.
--
-- /Internal/
--
{-# INLINE maybe #-}
maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
maybe parser = Parser step initial extract

    where

    initial = return ()

    step () a = return $
        case parser a of
            Just b -> Done 0 b
            Nothing -> Error "maybe: predicate failed"

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

-- | See 'Streamly.Internal.Data.Parser.either'.
--
-- /Internal/
--
{-# INLINE either #-}
either :: MonadThrow m => (a -> Either String b) -> Parser m a b
either parser = Parser step initial extract

    where

    initial = return ()

    step () a = return $
        case parser a of
            Right b -> Done 0 b
            Left err -> Error $ "either: " ++ err

    extract _ = throwM $ ParseError "either: 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 <$> finitial

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

    extract (Tuple' _ r) = 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 <$> finitial

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

    extract (Tuple' i r) =
        if n == i
        then 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 <$> finitial

    step (Tuple' i r) a = do
        res <- 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) = 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 fextract

    where

    initial = finitial

    step s a =
        if predicate a
        then Partial 0 <$> fstep s a
        else Done 1 <$> 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 <- fstep s a
            return $ Partial 0 (Just r)
        else do
            b <- fextract s
            return $ Done 1 b

    extract Nothing = throwM $ ParseError "takeWhile1: end of input"
    extract (Just s) = 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 fextract

    where

    initial = finitial
    step s a =
        if not (predicate a)
        then Partial 0 <$> fstep s a
        else Done 0 <$> 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 <$> finitial

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

    extract (Tuple' _ r) = 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 <- 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 <- 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 <- fstep fs b
                l <- initialR
                return $ Partial n (ManyTillR 0 fs1 l)
            Error err -> return $ Error err

    extract (ManyTillL fs sR) = extractL sR >>= fstep fs >>= fextract
    extract (ManyTillR _ fs _) = 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	, any
23	, all
24	, yield
25	, yieldM
26	, die
27	, dieM
28
29	-- * Element parsers
30	, peek
31	, eof
32	, satisfy
33	, maybe
34	, either
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, maybe, either)
165	import Streamly.Internal.Data.Fold.Types (Fold(..))
166
167	import Streamly.Internal.Data.Parser.ParserD.Tee
168	import Streamly.Internal.Data.Parser.ParserD.Types
169	import Streamly.Internal.Data.Strict
170
171	-------------------------------------------------------------------------------
172	-- Upgrade folds to parses
173	-------------------------------------------------------------------------------
174	--
175	-- \| See 'Streamly.Internal.Data.Parser.fromFold'.
176	--
177	-- /Internal/
178	--
179	{-# INLINE fromFold #-}
180	fromFold :: Monad m => Fold m a b -> Parser m a b
181	fromFold (Fold fstep finitial fextract) = Parser step finitial fextract	1✔
182
183	where
184
185	step s a = Partial 0 <$> fstep s a	1✔
186
187	-------------------------------------------------------------------------------
188	-- Terminating but not failing folds
189	-------------------------------------------------------------------------------
190	--
191	{-# INLINE any #-}
192	any :: Monad m => (a -> Bool) -> Parser m a Bool
193	any predicate = Parser step initial return	1✔
194
195	where
196
197	initial = return False	1✔
198
199	step s a = return (if s \|\| predicate a then Done 0 True else Partial 0 False)	1✔
200
201	{-# INLINABLE all #-}
202	all :: Monad m => (a -> Bool) -> Parser m a Bool
203	all predicate = Parser step initial return	1✔
204
205	where
206
207	initial = return True	1✔
208
209	step s a = return (if s && predicate a then Partial 0 True else Done 0 False)	1✔
210
211	-------------------------------------------------------------------------------
212	-- Failing Parsers
213	-------------------------------------------------------------------------------
214
215	-- \| See 'Streamly.Internal.Data.Parser.peek'.
216	--
217	-- /Internal/
218	--
219	{-# INLINABLE peek #-}
220	peek :: MonadThrow m => Parser m a a
221	peek = Parser step initial extract	1✔
222
223	where
224
225	initial = return ()	1✔
226
227	step () a = return $ Done 1 a	1✔
228
229	extract () = throwM $ ParseError "peek: end of input"	1✔
230
231	-- \| See 'Streamly.Internal.Data.Parser.eof'.
232	--
233	-- /Internal/
234	--
235	{-# INLINABLE eof #-}
236	eof :: Monad m => Parser m a ()
237	eof = Parser step initial return	1✔
238
239	where
240
241	initial = return ()	1✔
242
243	step () _ = return $ Error "eof: not at end of input"	1✔
244
245	-- \| See 'Streamly.Internal.Data.Parser.satisfy'.
246	--
247	-- /Internal/
248	--
249	{-# INLINE satisfy #-}
250	satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
251	satisfy predicate = Parser step initial extract	1✔
252
253	where
254
255	initial = return ()	1✔
256
257	step () a = return $	1✔
258	if predicate a	1✔
259	then Done 0 a	1✔
260	else Error "satisfy: predicate failed"	1✔
261
262	extract _ = throwM $ ParseError "satisfy: end of input"	1✔
263
264	-- \| See 'Streamly.Internal.Data.Parser.maybe'.
265	--
266	-- /Internal/
267	--
268	{-# INLINE maybe #-}
269	maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
270	maybe parser = Parser step initial extract	×
271
272	where
273
274	initial = return ()	×
275
276	step () a = return $	×
277	case parser a of	×
278	Just b -> Done 0 b	×
279	Nothing -> Error "maybe: predicate failed"	×
280
281	extract _ = throwM $ ParseError "maybe: end of input"	×
282
283	-- \| See 'Streamly.Internal.Data.Parser.either'.
284	--
285	-- /Internal/
286	--
287	{-# INLINE either #-}
288	either :: MonadThrow m => (a -> Either String b) -> Parser m a b
289	either parser = Parser step initial extract	×
290
291	where
292
293	initial = return ()	×
294
295	step () a = return $	×
296	case parser a of	×
297	Right b -> Done 0 b	×
298	Left err -> Error $ "either: " ++ err	×
299
300	extract _ = throwM $ ParseError "either: end of input"	×
301
302	-------------------------------------------------------------------------------
303	-- Taking elements
304	-------------------------------------------------------------------------------
305	--
306	-- \| See 'Streamly.Internal.Data.Parser.take'.
307	--
308	-- /Internal/
309	--
310	{-# INLINE take #-}
311	take :: Monad m => Int -> Fold m a b -> Parser m a b
312	take n (Fold fstep finitial fextract) = Parser step initial extract	1✔
313
314	where
315
316	initial = Tuple' 0 <$> finitial	1✔
317
318	step (Tuple' i r) a	1✔
319	\| i < n = do	1✔
320	res <- fstep r a	1✔
321	let i1 = i + 1	1✔
322	s1 = Tuple' i1 res	1✔
323	if i1 < n	1✔
324	then return $ Partial 0 s1	1✔
325	else Done 0 <$> fextract res	×
326	\| otherwise = Done 1 <$> fextract r	1✔
327
328	extract (Tuple' _ r) = fextract r	1✔
329
330	-- \| See 'Streamly.Internal.Data.Parser.takeEQ'.
331	--
332	-- /Internal/
333	--
334	{-# INLINE takeEQ #-}
335	takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
336	takeEQ cnt (Fold fstep finitial fextract) = Parser step initial extract	1✔
337
338	where
339
340	n = max cnt 0	1✔
341
342	initial = Tuple' 0 <$> finitial	1✔
343
344	step (Tuple' i r) a	1✔
345	\| i < n = do	1✔
346	res <- fstep r a	1✔
347	let i1 = i + 1	1✔
348	s1 = Tuple' i1 res	1✔
349	if i1 < n	1✔
350	then return (Continue 0 s1)	1✔
351	else Done 0 <$> fextract res	1✔
352	\| otherwise = Done 1 <$> fextract r	1✔
353
354	extract (Tuple' i r) =	1✔
355	if n == i	1✔
356	then fextract r	1✔
357	else throwM $ ParseError err	1✔
358
359	where
360
361	err =	1✔
362	"takeEQ: Expecting exactly " ++ show n	×
363	++ " elements, got " ++ show i	×
364
365	-- \| See 'Streamly.Internal.Data.Parser.takeGE'.
366	--
367	-- /Internal/
368	--
369	{-# INLINE takeGE #-}
370	takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
371	takeGE cnt (Fold fstep finitial fextract) = Parser step initial extract	1✔
372	where
373
374	n = max cnt 0	1✔
375
376	initial = Tuple' 0 <$> finitial	1✔
377
378	step (Tuple' i r) a = do	1✔
379	res <- fstep r a	1✔
380	let i1 = i + 1	1✔
381	s1 = Tuple' i1 res	1✔
382	return $	1✔
383	if i1 < n	1✔
384	then Continue 0 s1	1✔
385	else Partial 0 s1	1✔
386
387	extract (Tuple' i r) = fextract r >>= f	1✔
388
389	where
390
391	err =	1✔
392	"takeGE: Expecting at least " ++ show n	×
393	++ " elements, got only " ++ show i	×
394
395	f x =	1✔
396	if i >= n	1✔
397	then return x	1✔
398	else throwM $ ParseError err	1✔
399
400	-- \| See 'Streamly.Internal.Data.Parser.takeWhile'.
401	--
402	-- /Internal/
403	--
404	{-# INLINE takeWhile #-}
405	takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
406	takeWhile predicate (Fold fstep finitial fextract) =	1✔
407	Parser step initial fextract	1✔
408
409	where
410
411	initial = finitial	1✔
412
413	step s a =	1✔
414	if predicate a	1✔
415	then Partial 0 <$> fstep s a	1✔
416	else Done 1 <$> fextract s	1✔
417
418	-- \| See 'Streamly.Internal.Data.Parser.takeWhile1'.
419	--
420	-- /Internal/
421	--
422	{-# INLINE takeWhile1 #-}
423	takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
424	takeWhile1 predicate (Fold fstep finitial fextract) =	1✔
425	Parser step initial extract	1✔
426
427	where
428
429	initial = return Nothing	1✔
430
431	step Nothing a =	1✔
432	if predicate a	1✔
433	then do	1✔
434	s <- finitial	1✔
435	r <- fstep s a	1✔
436	return $ Partial 0 (Just r)	1✔
437	else return $ Error "takeWhile1: empty"	1✔
438	step (Just s) a =
439	if predicate a	1✔
440	then do	1✔
441	r <- fstep s a	1✔
442	return $ Partial 0 (Just r)	1✔
443	else do	1✔
444	b <- fextract s	1✔
445	return $ Done 1 b	1✔
446
447	extract Nothing = throwM $ ParseError "takeWhile1: end of input"	1✔
448	extract (Just s) = fextract s	1✔
449
450	-- \| See 'Streamly.Internal.Data.Parser.sliceSepBy'.
451	--
452	-- /Internal/
453	--
454	{-# INLINABLE sliceSepBy #-}
455	sliceSepBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
456	sliceSepBy predicate (Fold fstep finitial fextract) =	1✔
457	Parser step initial fextract	1✔
458
459	where
460
461	initial = finitial	1✔
462	step s a =	1✔
463	if not (predicate a)	1✔
464	then Partial 0 <$> fstep s a	1✔
465	else Done 0 <$> fextract s	1✔
466
467	-- \| See 'Streamly.Internal.Data.Parser.sliceEndWith'.
468	--
469	-- /Unimplemented/
470	--
471	{-# INLINABLE sliceEndWith #-}
472	sliceEndWith ::
473	-- Monad m =>
474	(a -> Bool) -> Fold m a b -> Parser m a b
475	sliceEndWith = undefined	×
476
477	-- \| See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
478	--
479	-- /Unimplemented/
480	--
481	{-# INLINABLE sliceBeginWith #-}
482	sliceBeginWith ::
483	-- Monad m =>
484	(a -> Bool) -> Fold m a b -> Parser m a b
485	sliceBeginWith = undefined	×
486
487	-- \| See 'Streamly.Internal.Data.Parser.sliceSepByMax'.
488	--
489	-- /Internal/
490	--
491	{-# INLINABLE sliceSepByMax #-}
492	sliceSepByMax :: Monad m
493	=> (a -> Bool) -> Int -> Fold m a b -> Parser m a b
494	sliceSepByMax predicate cnt (Fold fstep finitial fextract) =	1✔
495	Parser step initial extract	1✔
496
497	where
498
499	initial = Tuple' 0 <$> finitial	1✔
500
501	step (Tuple' i r) a	1✔
502	\| not (predicate a) =	1✔
503	if i < cnt	×
504	then do	1✔
505	res <- fstep r a	1✔
506	let i1 = i + 1	1✔
507	s1 = Tuple' i1 res	1✔
508	return $ Partial 0 s1	1✔
509	else Done 1 <$> fextract r	×
510	\| otherwise = Done 0 <$> fextract r	×
511
512	extract (Tuple' _ r) = fextract r	1✔
513
514	-- \| See 'Streamly.Internal.Data.Parser.wordBy'.
515	--
516	-- /Unimplemented/
517	--
518	{-# INLINABLE wordBy #-}
519	wordBy ::
520	-- Monad m =>
521	(a -> Bool) -> Fold m a b -> Parser m a b
522	wordBy = undefined	×
523
524	-- \| See 'Streamly.Internal.Data.Parser.groupBy'.
525	--
526	-- /Unimplemented/
527	--
528	{-# INLINABLE groupBy #-}
529	groupBy ::
530	-- Monad m =>
531	(a -> a -> Bool) -> Fold m a b -> Parser m a b
532	groupBy = undefined	×
533
534	-- XXX use an Unfold instead of a list?
535	-- XXX custom combinators for matching list, array and stream?
536	--
537	-- \| See 'Streamly.Internal.Data.Parser.eqBy'.
538	--
539	-- /Internal/
540	--
541	{-# INLINE eqBy #-}
542	eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
543	eqBy cmp str = Parser step initial extract	×
544
545	where
546
547	initial = return str	×
548
549	step [] _ = return $ Done 0 ()	×
550	step [x] a = return $	×
551	if x `cmp` a	×
552	then Done 0 ()	×
553	else Error "eqBy: failed, yet to match the last element"	×
554	step (x:xs) a = return $	×
555	if x `cmp` a	×
556	then Continue 0 xs	×
557	else Error $	×
558	"eqBy: failed, yet to match " ++ show (length xs + 1) ++ " elements"	×
559
560	extract xs = throwM $ ParseError $	×
561	"eqBy: end of input, yet to match " ++ show (length xs) ++ " elements"	×
562
563	-------------------------------------------------------------------------------
564	-- nested parsers
565	-------------------------------------------------------------------------------
566
567	-- \| See 'Streamly.Internal.Data.Parser.lookahead'.
568	--
569	-- /Internal/
570	--
571	{-# INLINE lookAhead #-}
572	lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
573	lookAhead (Parser step1 initial1 _) =	1✔
574	Parser step initial extract	1✔
575
576	where
577
578	initial = Tuple' 0 <$> initial1	1✔
579
580	step (Tuple' cnt st) a = do	1✔
581	r <- step1 st a	1✔
582	let cnt1 = cnt + 1	1✔
583	return $ case r of	1✔
584	Partial n s -> Continue n (Tuple' (cnt1 - n) s)	1✔
585	Continue n s -> Continue n (Tuple' (cnt1 - n) s)	×
586	Done _ b -> Done cnt1 b	1✔
587	Error err -> Error err	×
588
589	-- XXX returning an error let's us backtrack. To implement it in a way so
590	-- that it terminates on eof without an error then we need a way to
591	-- backtrack on eof, that will require extract to return 'Step' type.
592	extract (Tuple' n _) = throwM $ ParseError $	×
593	"lookAhead: end of input after consuming " ++ show n ++ " elements"	×
594
595	-------------------------------------------------------------------------------
596	-- Interleaving
597	-------------------------------------------------------------------------------
598	--
599	-- \| See 'Streamly.Internal.Data.Parser.deintercalate'.
600	--
601	-- /Unimplemented/
602	--
603	{-# INLINE deintercalate #-}
604	deintercalate ::
605	-- Monad m =>
606	Fold m a y -> Parser m x a
607	-> Fold m b z -> Parser m x b
608	-> Parser m x (y, z)
609	deintercalate = undefined	×
610
611	-------------------------------------------------------------------------------
612	-- Sequential Collection
613	-------------------------------------------------------------------------------
614	--
615	-- \| See 'Streamly.Internal.Data.Parser.sequence'.
616	--
617	-- /Unimplemented/
618	--
619	{-# INLINE sequence #-}
620	sequence ::
621	-- Foldable t =>
622	Fold m b c -> t (Parser m a b) -> Parser m a c
623	sequence _f _p = undefined	×
624
625	-------------------------------------------------------------------------------
626	-- Alternative Collection
627	-------------------------------------------------------------------------------
628	--
629	-- \| See 'Streamly.Internal.Data.Parser.choice'.
630	--
631	-- /Unimplemented/
632	--
633	{-# INLINE choice #-}
634	choice ::
635	-- Foldable t =>
636	t (Parser m a b) -> Parser m a b
637	choice _ps = undefined	×
638
639	-------------------------------------------------------------------------------
640	-- Sequential Repetition
641	-------------------------------------------------------------------------------
642	--
643	-- \| See 'Streamly.Internal.Data.Parser.many'.
644	--
645	-- /Internal/
646	--
647	{-# INLINE many #-}
648	many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
649	many = splitMany	1✔
650	-- many = countBetween 0 maxBound
651
652	-- \| See 'Streamly.Internal.Data.Parser.some'.
653	--
654	-- /Internal/
655	--
656	{-# INLINE some #-}
657	some :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
658	some = splitSome	×
659	-- some f p = many (takeGE 1 f) p
660	-- many = countBetween 1 maxBound
661
662	-- \| See 'Streamly.Internal.Data.Parser.countBetween'.
663	--
664	-- /Unimplemented/
665	--
666	{-# INLINE countBetween #-}
667	countBetween ::
668	-- MonadCatch m =>
669	Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
670	countBetween _m _n _f = undefined	×
671	-- countBetween m n f p = many (takeBetween m n f) p
672
673	-- \| See 'Streamly.Internal.Data.Parser.count'.
674	--
675	-- /Unimplemented/
676	--
677	{-# INLINE count #-}
678	count ::
679	-- MonadCatch m =>
680	Int -> Fold m b c -> Parser m a b -> Parser m a c
681	count n = countBetween n n	×
682	-- count n f p = many (takeEQ n f) p
683
684	data ManyTillState fs sr sl = ManyTillR Int fs sr \| ManyTillL fs sl
685
686	-- \| See 'Streamly.Internal.Data.Parser.manyTill'.
687	--
688	-- /Internal/
689	--
690	{-# INLINE manyTill #-}
691	manyTill :: MonadCatch m
692	=> Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
693	manyTill (Fold fstep finitial fextract)	×
694	(Parser stepL initialL extractL)
695	(Parser stepR initialR _) =
696	Parser step initial extract	×
697
698	where
699
700	initial = do	×
701	fs <- finitial	×
702	ManyTillR 0 fs <$> initialR	×
703
704	step (ManyTillR cnt fs st) a = do	×
705	r <- stepR st a	×
706	case r of	×
707	Partial n s -> return $ Partial n (ManyTillR 0 fs s)	×
708	Continue n s -> do	×
709	assert (cnt + 1 - n >= 0) (return ())	×
710	return $ Continue n (ManyTillR (cnt + 1 - n) fs s)	×
711	Done n _ -> do	×
712	b <- fextract fs	×
713	return $ Done n b	×
714	Error _ -> do	×
715	rR <- initialL	×
716	return $ Continue (cnt + 1) (ManyTillL fs rR)	×
717
718	step (ManyTillL fs st) a = do	×
719	r <- stepL st a	×
720	case r of	×
721	Partial n s -> return $ Partial n (ManyTillL fs s)	×
722	Continue n s -> return $ Continue n (ManyTillL fs s)	×
723	Done n b -> do	×
724	fs1 <- fstep fs b	×
725	l <- initialR	×
726	return $ Partial n (ManyTillR 0 fs1 l)	×
727	Error err -> return $ Error err	×
728
729	extract (ManyTillL fs sR) = extractL sR >>= fstep fs >>= fextract	×
730	extract (ManyTillR _ fs _) = fextract fs	×

composewell / streamly / 3024

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