2772

pending completion

Build # 2772

Build Type

Pull #568

travis-ci-com

Committed by

web-flow

Commit Message

<a href="https://github.com/composewell/streamly/commit/<a class=hub.com/composewell/streamly/commit/c4fd129ec0d55233805c3398c61330713bc0f9bd">c4fd129ec<a href="https://github.com/composewell/streamly/commit/c4fd129ec0d55233805c3398c61330713bc0f9bd">">Merge </a><a class="double-link" href="https://github.com/composewell/streamly/commit/<a class="double-link" href="https://github.com/composewell/streamly/commit/a6baf596cf141fd5d0f1c28e32e31c8c109c1fdd">a6baf596c</a>">a6baf596c</a><a href="https://github.com/composewell/streamly/commit/c4fd129ec0d55233805c3398c61330713bc0f9bd"> into 70fb99217">70fb99217</a>

Pull Request Pull Request #568: Fix take, takeEQ, sliceSepByMax.

Run Details

21 of 21 new or added lines in 1 file covered. (100.0%)

3306 of 8916 relevant lines covered (37.08%)

0.37 hits per line

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

54.04

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

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

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

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

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

-------------------------------------------------------------------------------
-- 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
        then Done 0 True
        else
            if 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
        then
            if predicate a
            then Partial 0 True
            else Done 0 False
        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' n <$> finitial

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

    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 n (Fold fstep finitial fextract) = Parser step initial extract

    where

    initial = Tuple' n <$> finitial

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

    extract (Tuple' i r) =
        if i == 0
        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 n (Fold fstep finitial fextract) = Parser step initial extract

    where

    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' cnt <$> finitial

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

composewell / streamly / 2772

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