2993

pending completion

Build # 2993

Build Type

Pull #599

travis-ci-com

Committed by

web-flow

Commit Message

<a href="https://github.com/composewell/streamly/commit/<a class=hub.com/composewell/streamly/commit/cfa3fc43f66920c09b0b7958ebe26e39bba0ccdc">cfa3fc43f<a href="https://github.com/composewell/streamly/commit/cfa3fc43f66920c09b0b7958ebe26e39bba0ccdc">">Merge </a><a class="double-link" href="https://github.com/composewell/streamly/commit/<a class="double-link" href="https://github.com/composewell/streamly/commit/813d79376bcdee5409802da55dae13cf55f75cc3">813d79376</a>">813d79376</a><a href="https://github.com/composewell/streamly/commit/cfa3fc43f66920c09b0b7958ebe26e39bba0ccdc"> into ef7c6d963">ef7c6d963</a>

Pull Request Pull Request #599: Implement fromParserK to convert CPS style ParserK to direct style ParserD

Run Details

242 of 242 new or added lines in 4 files covered. (100.0%)

3378 of 9381 relevant lines covered (36.01%)

0.36 hits per line

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

65.24

/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

    -- * 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(..))

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"

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

composewell / streamly / 2993

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