ilyakooo0/streamly
1
0
Fork 0
mirror of https://github.com/ilyakooo0/streamly.git synced 2024-10-06 05:07:07 +03:00
Code Issues Packages Projects Releases Wiki Activity

Remove redundant parsers, update docs

Browse Source 
Remove the parsers that are covered by terminating folds.
This commit is contained in:
Harendra Kumar 2020-12-10 20:18:26 +00:00
parent 82efd3a5bc
commit d5af0bfb5d
10 changed files with 227 additions and 538 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
benchmark/Streamly/Benchmark/Data/Parser.hs
View File

@ -15,6 +15,7 @@ module Main
import Control.DeepSeq (NFData(..))
import Control.Monad.Catch (MonadCatch)
import Data.Foldable (asum)
import Data.Functor (($>))
import Data.Monoid (Sum(..))
import System.Random (randomRIO)
import Prelude
@ -59,22 +60,14 @@ benchIOSink value name f =
-- Parsers
-------------------------------------------------------------------------------
{-# INLINE any #-}
any :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
any value = IP.parse (PR.any (> value))
{-# INLINE all #-}
all :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
all value = IP.parse (PR.all (<= value))
{-# INLINE take #-}
take :: MonadCatch m => Int -> SerialT m a -> m ()
take value = IP.parse (PR.take value FL.drain)
{-# INLINE takeEQ #-}
takeEQ :: MonadCatch m => Int -> SerialT m a -> m ()
takeEQ value = IP.parse (PR.takeEQ value FL.drain)
{-# INLINE drainWhile #-}
drainWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
drainWhile value = IP.parse (PR.drainWhile (<= value))
{-# INLINE takeWhile #-}
takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)
@ -106,57 +99,91 @@ manyTill value =
{-# INLINE splitAp #-}
splitAp :: MonadCatch m
=> Int -> SerialT m Int -> m (Bool, Bool)
=> Int -> SerialT m Int -> m ((), ())
splitAp value =
IP.parse ((,) <$> PR.all (<= (value `div` 2)) <*> PR.any (> value))
IP.parse
((,)
<$> PR.drainWhile (<= (value `div` 2))
<*> PR.drainWhile (<= value)
)
{-# INLINE splitApBefore #-}
splitApBefore :: MonadCatch m
=> Int -> SerialT m Int -> m Bool
=> Int -> SerialT m Int -> m ()
splitApBefore value =
IP.parse (PR.all (<= (value `div` 2)) *> PR.any (> value))
IP.parse
( PR.drainWhile (<= (value `div` 2))
*> PR.drainWhile (<= value)
)
{-# INLINE splitApAfter #-}
splitApAfter :: MonadCatch m
=> Int -> SerialT m Int -> m Bool
=> Int -> SerialT m Int -> m ()
splitApAfter value =
IP.parse (PR.all (<= (value `div` 2)) <* PR.any (> value))
IP.parse
( PR.drainWhile (<= (value `div` 2))
<* PR.drainWhile (<= value)
)
{-# INLINE splitWith #-}
splitWith :: MonadCatch m
=> Int -> SerialT m Int -> m (Bool, Bool)
=> Int -> SerialT m Int -> m ((), ())
splitWith value =
IP.parse (PR.splitWith (,) (PR.all (<= (value `div` 2))) (PR.any (> value)))
IP.parse
(PR.splitWith (,)
(PR.drainWhile (<= (value `div` 2)))
(PR.drainWhile (<= value))
)
{-# INLINE split_ #-}
split_ :: MonadCatch m
=> Int -> SerialT m Int -> m Bool
=> Int -> SerialT m Int -> m ()
split_ value =
IP.parse (PR.split_ (PR.all (<= (value `div` 2))) (PR.any (> value)))
IP.parse
(PR.split_
(PR.drainWhile (<= (value `div` 2)))
(PR.drainWhile (<= value))
)
{-# INLINE teeAllAny #-}
teeAllAny :: (MonadCatch m, Ord a)
=> a -> SerialT m a -> m (Bool, Bool)
teeAllAny :: MonadCatch m
=> Int -> SerialT m Int -> m ((), ())
teeAllAny value =
IP.parse (PR.teeWith (,) (PR.all (<= value)) (PR.any (> value)))
IP.parse
(PR.teeWith (,)
(PR.drainWhile (<= value))
(PR.drainWhile (<= value))
)
{-# INLINE teeFstAllAny #-}
teeFstAllAny :: (MonadCatch m, Ord a)
=> a -> SerialT m a -> m (Bool, Bool)
teeFstAllAny :: MonadCatch m
=> Int -> SerialT m Int -> m ((), ())
teeFstAllAny value =
IP.parse (PR.teeWithFst (,) (PR.all (<= value)) (PR.any (> value)))
IP.parse
(PR.teeWithFst (,)
(PR.drainWhile (<= value))
(PR.drainWhile (<= value))
)
{-# INLINE shortestAllAny #-}
shortestAllAny :: (MonadCatch m, Ord a)
=> a -> SerialT m a -> m Bool
shortestAllAny :: MonadCatch m
=> Int -> SerialT m Int -> m ()
shortestAllAny value =
IP.parse (PR.shortest (PR.all (<= value)) (PR.any (> value)))
IP.parse
(PR.shortest
(PR.drainWhile (<= value))
(PR.drainWhile (<= value))
)
{-# INLINE longestAllAny #-}
longestAllAny :: (MonadCatch m, Ord a)
=> a -> SerialT m a -> m Bool
longestAllAny :: MonadCatch m
=> Int -> SerialT m Int -> m ()
longestAllAny value =
IP.parse (PR.longest (PR.all (<= value)) (PR.any (> value)))
IP.parse
(PR.longest
(PR.drainWhile (<= value))
(PR.drainWhile (<= value))
)
-------------------------------------------------------------------------------
-- Parsers in which -fspec-constr-recursive=16 is problematic
@ -169,7 +196,7 @@ longestAllAny value =
{-# INLINE lookAhead #-}
lookAhead :: MonadCatch m => Int -> SerialT m Int -> m ()
lookAhead value =
IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) *> pure ())
IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
{-# INLINE sequenceA #-}
sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
@ -208,7 +235,7 @@ parseMany :: MonadCatch m => SerialT m Int -> m ()
parseMany =
S.drain
. S.map getSum
. IP.parseMany (PR.take 2 FL.mconcat)
. IP.parseMany (PR.fromFold $ FL.ltake 2 FL.mconcat)
. S.map Sum
{-# INLINE parseIterate #-}
@ -216,7 +243,7 @@ parseIterate :: MonadCatch m => SerialT m Int -> m ()
parseIterate =
S.drain
. S.map getSum
. IP.parseIterate (\b -> (PR.take 2 (FL.sconcat b))) (Sum 0)
. IP.parseIterate (PR.fromFold . FL.ltake 2 . FL.sconcat) (Sum 0)
. S.map Sum
-------------------------------------------------------------------------------
@ -228,11 +255,9 @@ moduleName = "Data.Parser"
o_1_space_serial :: Int -> [Benchmark]
o_1_space_serial value =
[ benchIOSink value "any" $ any value
, benchIOSink value "all" $ all value
, benchIOSink value "take" $ take value
, benchIOSink value "takeEQ" $ takeEQ value
[ benchIOSink value "takeEQ" $ takeEQ value
, benchIOSink value "takeWhile" $ takeWhile value
, benchIOSink value "drainWhile" $ drainWhile value
, benchIOSink value "splitAp" $ splitAp value
, benchIOSink value "splitApBefore" $ splitApBefore value
, benchIOSink value "splitApAfter" $ splitApAfter value
@ -284,12 +309,6 @@ main = do
where
allBenchmarks value =
[ bgroup (o_1_space_prefix moduleName) $ concat
[
o_1_space_serial value
]
, bgroup (o_n_heap_prefix moduleName) $ concat
[
o_n_heap_serial value
]
[ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
, bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
]

87
benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs
View File

@ -16,6 +16,7 @@ module Main
import Control.DeepSeq (NFData(..))
import Control.Monad.Catch (MonadCatch, MonadThrow)
import Data.Foldable (asum)
import Data.Functor (($>))
import System.Random (randomRIO)
import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
@ -58,21 +59,13 @@ benchIOSink value name f =
-- Parsers
-------------------------------------------------------------------------------
{-# INLINE any #-}
any :: (MonadThrow m, Ord a) => a -> SerialT m a -> m Bool
any value = IP.parseD (PR.any (> value))
{-# INLINE all #-}
all :: (MonadThrow m, Ord a) => a -> SerialT m a -> m Bool
all value = IP.parseD (PR.all (<= value))
{-# INLINE take #-}
take :: MonadThrow m => Int -> SerialT m a -> m ()
take value = IP.parseD (PR.take value FL.drain)
{-# INLINE drainWhile #-}
drainWhile :: MonadThrow m => (a -> Bool) -> PR.Parser m a ()
drainWhile p = PR.takeWhile p FL.drain
{-# INLINE takeWhile #-}
takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()
takeWhile value = IP.parseD (PR.takeWhile (<= value) FL.drain)
takeWhile value = IP.parseD (drainWhile (<= value))
{-# INLINE many #-}
many :: MonadCatch m => SerialT m Int -> m Int
@ -103,33 +96,53 @@ manyTill value =
{-# INLINE splitAllAny #-}
splitAllAny :: MonadThrow m
=> Int -> SerialT m Int -> m (Bool, Bool)
=> Int -> SerialT m Int -> m ((), ())
splitAllAny value =
IP.parseD ((,) <$> PR.all (<= (value `div` 2)) <*> PR.any (> value))
IP.parseD
((,)
<$> drainWhile (<= (value `div` 2))
<*> drainWhile (<= value)
)
{-# INLINE teeAllAny #-}
teeAllAny :: (MonadThrow m, Ord a)
=> a -> SerialT m a -> m (Bool, Bool)
teeAllAny :: MonadThrow m
=> Int -> SerialT m Int -> m ((), ())
teeAllAny value =
IP.parseD (PR.teeWith (,) (PR.all (<= value)) (PR.any (> value)))
IP.parseD
(PR.teeWith (,)
(drainWhile (<= value))
(drainWhile (<= value))
)
{-# INLINE teeFstAllAny #-}
teeFstAllAny :: (MonadThrow m, Ord a)
=> a -> SerialT m a -> m (Bool, Bool)
teeFstAllAny :: MonadThrow m
=> Int -> SerialT m Int -> m ((), ())
teeFstAllAny value =
IP.parseD (PR.teeWithFst (,) (PR.all (<= value)) (PR.any (> value)))
IP.parseD
(PR.teeWithFst (,)
(drainWhile (<= value))
(drainWhile (<= value))
)
{-# INLINE shortestAllAny #-}
shortestAllAny :: (MonadThrow m, Ord a)
=> a -> SerialT m a -> m Bool
shortestAllAny :: MonadThrow m
=> Int -> SerialT m Int -> m ()
shortestAllAny value =
IP.parseD (PR.shortest (PR.all (<= value)) (PR.any (> value)))
IP.parseD
(PR.shortest
(drainWhile (<= value))
(drainWhile (<= value))
)
{-# INLINE longestAllAny #-}
longestAllAny :: (MonadCatch m, Ord a)
=> a -> SerialT m a -> m Bool
longestAllAny :: MonadCatch m
=> Int -> SerialT m Int -> m ()
longestAllAny value =
IP.parseD (PR.longest (PR.all (<= value)) (PR.any (> value)))
IP.parseD
(PR.longest
(drainWhile (<= value))
(drainWhile (<= value))
)
-------------------------------------------------------------------------------
-- Parsers in which -fspec-constr-recursive=16 is problematic
@ -142,7 +155,7 @@ longestAllAny value =
{-# INLINE lookAhead #-}
lookAhead :: MonadThrow m => Int -> SerialT m Int -> m ()
lookAhead value =
IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) *> pure ())
IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
{-# INLINE sequenceA_ #-}
sequenceA_ :: MonadThrow m => Int -> SerialT m Int -> m ()
@ -181,10 +194,7 @@ moduleName = "Data.Parser.ParserD"
o_1_space_serial :: Int -> [Benchmark]
o_1_space_serial value =
[ benchIOSink value "any" $ any value
, benchIOSink value "all" $ all value
, benchIOSink value "take" $ take value
, benchIOSink value "takeWhile" $ takeWhile value
[ benchIOSink value "takeWhile" $ takeWhile value
, benchIOSink value "split (all,any)" $ splitAllAny value
, benchIOSink value "many" many
, benchIOSink value "some" some
@ -228,16 +238,7 @@ main = do
where
allBenchmarks value =
[ bgroup (o_1_space_prefix moduleName) $ concat
[
o_1_space_serial value
]
, bgroup (o_n_heap_prefix moduleName) $ concat
[
o_n_heap_serial value
]
, bgroup (o_n_space_prefix moduleName) $ concat
[
o_n_space_serial value
]
[ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
, bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
, bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
]

41
benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs
View File

@ -69,30 +69,6 @@ benchIOSink value name f =
satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
satisfy = PR.toParserK . PRD.satisfy
{-# INLINE any #-}
any :: MonadCatch m => (a -> Bool) -> PR.Parser m a Bool
any = PR.toParserK . PRD.any
{-# INLINE anyK #-}
anyK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
anyK value = PARSE_OP (any (> value))
{-# INLINE all #-}
all :: MonadCatch m => (a -> Bool) -> PR.Parser m a Bool
all = PR.toParserK . PRD.all
{-# INLINE allK #-}
allK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
allK value = PARSE_OP (all (<= value))
{-# INLINE take #-}
take :: MonadCatch m => Int -> PR.Parser m a ()
take value = PR.toParserK $ PRD.take value FL.drain
{-# INLINE takeK #-}
takeK :: MonadCatch m => Int -> SerialT m a -> m ()
takeK value = PARSE_OP (take value)
{-# INLINE takeWhile #-}
takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
takeWhile p = PR.toParserK $ PRD.takeWhile p FL.drain
@ -103,9 +79,9 @@ takeWhileK value = PARSE_OP (takeWhile (<= value))
{-# INLINE splitApp #-}
splitApp :: MonadCatch m
=> Int -> SerialT m Int -> m (Bool, Bool)
=> Int -> SerialT m Int -> m ((), ())
splitApp value =
PARSE_OP ((,) <$> any (>= (value `div` 2)) <*> any (> value))
PARSE_OP ((,) <$> takeWhile (<= (value `div` 2)) <*> takeWhile (<= value))
{-# INLINE sequenceA #-}
sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
@ -157,10 +133,7 @@ moduleName = "Data.Parser.ParserK"
o_1_space_serial :: Int -> [Benchmark]
o_1_space_serial value =
[ benchIOSink value "any" $ anyK value
, benchIOSink value "all" $ allK value
, benchIOSink value "take" $ takeK value
, benchIOSink value "takeWhile" $ takeWhileK value
[ benchIOSink value "takeWhile" $ takeWhileK value
, benchIOSink value "splitApp" $ splitApp value
]
@ -187,10 +160,6 @@ main = do
where
allBenchmarks value =
[ bgroup (o_1_space_prefix moduleName) $ concat
[ o_1_space_serial value
]
, bgroup (o_n_heap_prefix moduleName) $ concat
[ o_n_heap_serial value
]
[ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
, bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
]

223
src/Streamly/Internal/Data/Parser.hs
View File

@ -54,8 +54,6 @@ module Streamly.Internal.Data.Parser
-- First order parsers
-- * Accumulators
, fromFold
, any
, all
, yield
, yieldM
, die
@ -75,8 +73,7 @@ module Streamly.Internal.Data.Parser
-- | Grab a sequence of input elements without inspecting them
, takeBetween
, take -- takeBetween 0 n
-- $take
-- , take -- takeBetween 0 n
, takeEQ -- takeBetween n n
, takeGE -- takeBetween n maxBound
@ -86,11 +83,9 @@ module Streamly.Internal.Data.Parser
, takeWhile
-- $takeWhile
, takeWhile1
, drainWhile
, sliceSepByP
, sliceSepBy
, sliceSepByMax
, sliceEndWith
, sliceBeginWith
, sliceSepWith
, escapedSliceSepBy
@ -134,7 +129,7 @@ module Streamly.Internal.Data.Parser
-- * N-ary Combinators
-- ** Sequential Collection
, sequence
, concatSequence
, concatMap
-- ** Sequential Repetition
@ -206,6 +201,7 @@ import Prelude
import Streamly.Internal.Data.Fold.Types (Fold(..))
import Streamly.Internal.Data.Parser.ParserK.Types (Parser)
import qualified Streamly.Internal.Data.Fold as FL
import qualified Streamly.Internal.Data.Parser.ParserD as D
import qualified Streamly.Internal.Data.Parser.ParserK.Types as K
@ -225,22 +221,6 @@ fromFold = K.toParserK . D.fromFold
-- Terminating but not failing folds
-------------------------------------------------------------------------------
--
-- |
-- >>> S.parse (PR.any (== 0)) $ S.fromList [1,0,1]
-- > True
--
{-# INLINE any #-}
any :: MonadCatch m => (a -> Bool) -> Parser m a Bool
any = K.toParserK . D.any
-- |
-- >>> S.parse (PR.all (== 0)) $ S.fromList [1,0,1]
-- > False
--
{-# INLINE all #-}
all :: MonadCatch m => (a -> Bool) -> Parser m a Bool
all = K.toParserK . D.all
-- This is the dual of stream "yield".
--
-- | A parser that always yields a pure value without consuming any input.
@ -377,35 +357,6 @@ takeBetween :: -- MonadCatch m =>
Int -> Int -> Fold m a b -> Parser m a b
takeBetween _m _n = undefined -- K.toParserK . D.takeBetween m n
--
-- $take
-- Note: this is called takeP in some parser libraries.
--
-- TODO Once we have terminating folds, this Parse should get replaced by Fold.
-- Alternatively, we can name it "chunkOf" and the corresponding time domain
-- combinator as "intervalOf" or even "chunk" and "interval".
-- | Take at most @n@ input elements and fold them using the supplied fold.
--
-- Stops after @n@ elements.
-- Never fails.
--
-- >>> S.parse (PR.take 1 FL.toList) $ S.fromList [1]
-- [1]
--
-- >>> S.parse (PR.take (-1) FL.toList) $ S.fromList [1]
-- []
--
-- @
-- S.chunksOf n f = S.parseMany (FL.take n f)
-- @
--
-- /Internal/
--
{-# INLINE take #-}
take :: MonadCatch m => Int -> Fold m a b -> Parser m a b
take n = K.toParserK . D.take n
-- | Stops after taking exactly @n@ input elements.
--
-- * Stops - after consuming @n@ elements.
@ -423,8 +374,9 @@ takeEQ n = K.toParserK . D.takeEQ n
-- | Take at least @n@ input elements, but can collect more.
--
-- * Stops - never.
-- * Fails - if the stream end before producing @n@ elements.
-- * Stops - when the collecting fold stops.
-- * Fails - if the stream or the collecting fold ends before producing @n@
-- elements.
--
-- >>> S.parse (PR.takeGE 4 FL.toList) $ S.fromList [1,0,1]
-- > "takeGE: Expecting at least 4 elements, got only 3"
@ -465,7 +417,7 @@ takeWhileP _cond = undefined -- K.toParserK . D.takeWhileP cond
-- | Collect stream elements until an element fails the predicate. The element
-- on which the predicate fails is returned back to the input stream.
--
-- * Stops - when the predicate fails.
-- * Stops - when the predicate fails or the collecting fold stops.
-- * Fails - never.
--
-- >>> S.parse (PR.takeWhile (== 0) FL.toList) $ S.fromList [0,0,1,0,1]
@ -491,9 +443,19 @@ takeWhile cond = K.toParserK . D.takeWhile cond
takeWhile1 :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
takeWhile1 cond = K.toParserK . D.takeWhile1 cond
-- | Like 'sliceSepBy' but uses a 'Parser' instead of a 'Fold' to collect the
-- input. @sliceSepByP cond parser@ parses a slice of the input using @parser@
-- until @cond@ succeeds or the parser stops.
-- | Drain the input as long as the predicate succeeds, running the effects and
-- discarding the results.
--
-- This is also called @skipWhile@ in some parsing libraries.
--
-- /Internal/
--
{-# INLINE drainWhile #-}
drainWhile :: MonadCatch m => (a -> Bool) -> Parser m a ()
drainWhile p = takeWhile p FL.drain
-- | @sliceSepBy cond parser@ parses a slice of the input using @parser@ until
-- @cond@ succeeds or the parser stops.
--
-- This is a generalized slicing parser which can be used to implement other
-- parsers e.g.:
@ -505,59 +467,10 @@ takeWhile1 cond = K.toParserK . D.takeWhile1 cond
--
-- /Unimplemented/
--
{-# INLINABLE sliceSepByP #-}
sliceSepByP :: -- MonadCatch m =>
(a -> Bool) -> Parser m a b -> Parser m a b
sliceSepByP _cond = undefined -- K.toParserK . D.sliceSepByP cond
-- Note: Keep this consistent with S.splitOn. In fact we should eliminate
-- S.splitOn in favor of the parser.
--
-- | Split on an infixed separator element, dropping the separator. Splits the
-- stream on separator elements determined by the supplied predicate, separator
-- is considered as infixed between two segments, if one side of the separator
-- is missing then it is parsed as an empty stream. The supplied 'Fold' is
-- applied on the split segments. With '-' representing non-separator elements
-- and '.' as separator, 'splitOn' splits as follows:
--
-- @
-- "--.--" => "--" "--"
-- "--." => "--" ""
-- ".--" => "" "--"
-- @
--
-- @PR.sliceSepBy (== x)@ is an inverse of @S.intercalate (S.yield x)@
--
-- Let's use the following definition for illustration:
--
-- > splitOn p = PR.many FL.toList $ PR.sliceSepBy p (FL.toList)
-- > splitOn' p = S.parse (splitOn p) . S.fromList
--
-- >>> splitOn' (== '.') ""
-- [""]
--
-- >>> splitOn' (== '.') "."
-- ["",""]
--
-- >>> splitOn' (== '.') ".a"
-- > ["","a"]
--
-- >>> splitOn' (== '.') "a."
-- > ["a",""]
--
-- >>> splitOn' (== '.') "a.b"
-- > ["a","b"]
--
-- >>> splitOn' (== '.') "a..b"
-- > ["a","","b"]
--
-- * Stops - when the predicate succeeds.
-- * Fails - never.
--
-- /Internal/
{-# INLINABLE sliceSepBy #-}
sliceSepBy :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
sliceSepBy cond = K.toParserK . D.sliceSepBy cond
sliceSepBy :: -- MonadCatch m =>
(a -> Bool) -> Parser m a b -> Parser m a b
sliceSepBy _cond = undefined -- K.toParserK . D.sliceSepBy cond
-- | Like 'sliceSepBy' but does not drop the separator element, instead
-- separator is emitted as a separate element in the output.
@ -568,23 +481,6 @@ sliceSepWith :: -- MonadCatch m =>
(a -> Bool) -> Fold m a b -> Parser m a b
sliceSepWith _cond = undefined -- K.toParserK . D.sliceSepBy cond
-- | Collect stream elements until an element succeeds the predicate. Also take
-- the element on which the predicate succeeded. The succeeding element is
-- treated as a suffix separator which is kept in the output segement.
--
-- * Stops - when the predicate succeeds.
-- * Fails - never.
--
-- S.splitWithSuffix pred f = S.parseMany (PR.sliceEndWith pred f)
--
-- /Unimplemented/
--
{-# INLINABLE sliceEndWith #-}
sliceEndWith ::
-- Monad m =>
(a -> Bool) -> Fold m a b -> Parser m a b
sliceEndWith = undefined
-- | Collect stream elements until an elements passes the predicate, return the
-- last element on which the predicate succeeded back to the input stream. If
-- the predicate succeeds on the first element itself then it is kept in the
@ -604,44 +500,6 @@ sliceBeginWith ::
(a -> Bool) -> Fold m a b -> Parser m a b
sliceBeginWith = undefined
-- | Like 'sliceSepBy' but terminates a parse even before the separator
-- is encountered if its size exceeds the specified maximum limit.
--
-- > take n = PR.sliceSepByMax (const True) n
-- > sliceSepBy p = PR.sliceSepByMax p maxBound
--
-- Let's use the following definitions for illustration:
--
-- > splitOn p n = PR.many FL.toList $ PR.sliceSepByMax p n (FL.toList)
-- > splitOn' p n = S.parse (splitOn p n) . S.fromList
--
-- >>> splitOn' (== '.') 0 ""
-- [""]
--
-- >>> splitOn' (== '.') 0 "a"
-- infinite list of empty strings
--
-- >>> splitOn' (== '.') 3 "hello.world"
-- ["hel","lo","wor","ld"]
--
-- If the separator is found and the limit is reached at the same time then it
-- behaves just like 'sliceSepBy' i.e. the separator is dropped.
--
-- >>> splitOn' (== '.') 0 "."
-- ["",""]
--
-- >>> splitOn' (== '.') 0 ".."
-- ["","",""]
--
-- * Stops - when the predicate succeeds or the limit is reached.
-- * Fails - never.
--
-- /Internal/
{-# INLINABLE sliceSepByMax #-}
sliceSepByMax :: MonadCatch m
=> (a -> Bool) -> Int -> Fold m a b -> Parser m a b
sliceSepByMax cond cnt = K.toParserK . D.sliceSepByMax cond cnt
-- | Like 'sliceSepBy' but the separator elements can be escaped using an
-- escape char determined by the second predicate.
--
@ -911,18 +769,19 @@ deintercalate = undefined
-- Sequential Collection
-------------------------------------------------------------------------------
--
-- | @sequence f t@ collects sequential parses of parsers in the container @t@
-- using the fold @f@. Fails if the input ends or any of the parsers fail.
-- | @concatSequence f t@ collects sequential parses of parsers in the
-- container @t@ using the fold @f@. Fails if the input ends or any of the
-- parsers fail.
--
-- This is same as 'Data.Traversable.sequence' but more efficient.
--
-- /Unimplemented/
--
{-# INLINE sequence #-}
sequence ::
{-# INLINE concatSequence #-}
concatSequence ::
-- Foldable t =>
Fold m b c -> t (Parser m a b) -> Parser m a c
sequence _f _p = undefined
concatSequence _f _p = undefined
-- | Map a 'Parser' returning function on the result of a 'Parser'.
--
@ -974,10 +833,11 @@ manyP :: -- MonadCatch m =>
Parser m b c -> Parser m a b -> Parser m a c
manyP _f _p = undefined -- K.toParserK $ D.manyP f (K.fromParserK p)
-- | Collect zero or more parses. Apply the parser repeatedly on the input
-- stream, stop when the parser fails, accumulate zero or more parse results
-- using the supplied 'Fold'. This parser never fails, in case the first
-- application of parser fails it returns an empty result.
-- | Collect zero or more parses. Apply the supplied parser repeatedly on the
-- input stream and push the parse results to a downstream fold.
--
-- Stops: when the downstream fold stops or the parser fails.
-- Fails: never, produces zero or more results.
--
-- Compare with 'Control.Applicative.many'.
--
@ -988,10 +848,15 @@ many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
many f p = K.toParserK $ D.many f (K.fromParserK p)
-- many = countBetween 0 maxBound
-- Note: many1 would perhaps be a better name for this and consistent with
-- other names like takeWhile1. But we retain the name "some" for
-- compatibility.
--
-- | Collect one or more parses. Apply the supplied parser repeatedly on the
-- input stream and accumulate the parse results as long as the parser
-- succeeds, stop when it fails. This parser fails if not even one result is
-- collected.
-- input stream and push the parse results to a downstream fold.
--
-- Stops: when the downstream fold stops or the parser fails.
-- Fails: if it stops without producing a single result.
--
-- @some fld parser = many (takeGE 1 fld) parser@
--
@ -1054,6 +919,8 @@ manyTillP _f _p1 _p2 = undefined
-- @test@ is discarded and the output of @collect@ is accumulated by the
-- supplied fold. The parser fails if @collect@ fails.
--
-- Stops when the fold @f@ stops.
--
-- /Internal/
--
{-# INLINE manyTill #-}

77
src/Streamly/Internal/Data/Parser/ParserD.hs
View File

@ -19,8 +19,6 @@ module Streamly.Internal.Data.Parser.ParserD
-- First order parsers
-- * Accumulators
, fromFold
, any
, all
, yield
, yieldM
, die
@ -45,7 +43,6 @@ module Streamly.Internal.Data.Parser.ParserD
-- 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
@ -57,9 +54,7 @@ module Streamly.Internal.Data.Parser.ParserD
, takeWhile
, takeWhile1
, sliceSepBy
, sliceSepByMax
-- , sliceSepByBetween
, sliceEndWith
, sliceBeginWith
-- , sliceSepWith
--
@ -164,7 +159,6 @@ import Streamly.Internal.Data.Fold.Types (Fold(..))
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
import qualified Streamly.Internal.Data.Fold.Types as FL
import qualified Streamly.Internal.Data.Fold as FL
import Prelude hiding
(any, all, take, takeWhile, sequence, concatMap, maybe, either)
@ -192,19 +186,6 @@ fromFold (Fold fstep finitial fextract) = Parser step finitial fextract
FL.Partial s1 -> Partial 0 s1
FL.Done b -> Done 0 b
-------------------------------------------------------------------------------
-- Terminating but not failing folds
-------------------------------------------------------------------------------
--
{-# INLINE any #-}
any :: Monad m => (a -> Bool) -> Parser m a Bool
any predicate = fromFold $ FL.any predicate
{-# INLINABLE all #-}
all :: Monad m => (a -> Bool) -> Parser m a Bool
all predicate = fromFold $ FL.all predicate
-------------------------------------------------------------------------------
-- Failing Parsers
-------------------------------------------------------------------------------
@ -300,16 +281,6 @@ either parser = Parser step initial extract
-- Taking elements
-------------------------------------------------------------------------------
-- It will be inconsistent with other takeish combinators.
-- This is takeLE
-- | See 'Streamly.Internal.Data.Parser.take'.
--
-- /Internal/
--
{-# INLINE take #-}
take :: Monad m => Int -> Fold m a b -> Parser m a b
take n fld = fromFold $ FL.ltake n fld
-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
--
-- /Internal/
@ -340,6 +311,7 @@ takeEQ cnt (Fold fstep finitial fextract) = Parser step initial extract
<$> case res of
FL.Partial s -> fextract s
FL.Done b -> return b
-- XXX we should not reach here when initial returns Step type
-- reachable only when n == 0
| otherwise = Done 1 <$> fextract r
@ -420,7 +392,6 @@ takeWhile predicate (Fold fstep finitial fextract) =
FL.Done b -> Done 0 b
else Done 1 <$> fextract s
-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
--
-- /Internal/
@ -443,7 +414,7 @@ takeWhile1 predicate (Fold fstep finitial fextract) =
$ case sr of
FL.Partial r -> Partial 0 (Just r)
FL.Done b -> Done 0 b
else return $ Error err
else return $ Error "takeWhile1: predicate failed on first element"
step (Just s) a =
if predicate a
then do
@ -455,28 +426,16 @@ takeWhile1 predicate (Fold fstep finitial fextract) =
b <- fextract s
return $ Done 1 b
extract Nothing = throwM $ ParseError err
extract Nothing = throwM $ ParseError "takeWhile1: end of input"
extract (Just s) = fextract s
err = "takeWhile1: end of input"
-- | See 'Streamly.Internal.Data.Parser.sliceSepBy'.
--
-- /Internal/
--
{-# INLINABLE sliceSepBy #-}
sliceSepBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
sliceSepBy predicate fld = fromFold $ FL.sliceSepBy predicate fld
-- | See 'Streamly.Internal.Data.Parser.sliceEndWith'.
--
-- /Unimplemented/
--
{-# INLINABLE sliceEndWith #-}
sliceEndWith ::
-- Monad m =>
(a -> Bool) -> Fold m a b -> Parser m a b
sliceEndWith = undefined
sliceSepBy :: -- MonadCatch m =>
(a -> Bool) -> Parser m a b -> Parser m a b
sliceSepBy _cond = undefined
-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
--
@ -488,15 +447,6 @@ sliceBeginWith ::
(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 p n = sliceSepBy p . FL.ltake n
-- | See 'Streamly.Internal.Data.Parser.wordBy'.
--
-- /Unimplemented/
@ -709,6 +659,7 @@ manyTill (Fold fstep finitial fextract)
Error _ -> do
rR <- initialL
return $ Continue (cnt + 1) (ManyTillL 0 fs rR)
-- XXX the cnt is being used only by the assert
step (ManyTillL cnt fs st) a = do
r <- stepL st a
case r of
@ -717,17 +668,17 @@ manyTill (Fold fstep finitial fextract)
assert (cnt + 1 - n >= 0) (return ())
return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
Done n b -> do
sfs1 <- fstep fs b
case sfs1 of
FL.Partial fs1 -> do
fs1 <- fstep fs b
case fs1 of
FL.Partial s -> do
l <- initialR
return $ Partial n (ManyTillR 0 fs1 l)
FL.Done fb -> return $ Done n fb
return $ Partial n (ManyTillR 0 s l)
FL.Done b1 -> return $ Done n b1
Error err -> return $ Error err
extract (ManyTillL _ fs sR) = do
res <- extractL sR >>= fstep fs
case res of
FL.Partial sres -> fextract sres
FL.Done bres -> return bres
FL.Partial s -> fextract s
FL.Done b -> return b
extract (ManyTillR _ fs _) = fextract fs

18
src/Streamly/Internal/Data/Parser/ParserD/Types.hs
View File

@ -122,8 +122,8 @@ module Streamly.Internal.Data.Parser.ParserD.Types
, die
, dieM
, splitSome
, splitMany
, splitSome -- parseSome?
, splitMany -- parseMany?
, alt
, concatMap
)
@ -274,6 +274,8 @@ yieldM b = Parser (\_ _ -> Done 1 <$> b) -- step
{-# ANN type SeqParseState Fuse #-}
data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr
-- | See 'Streamly.Internal.Data.Parser.splitWith'.
--
-- Note: this implementation of splitWith is fast because of stream fusion but
-- has quadratic time complexity, because each composition adds a new branch
-- that each subsequent parse's input element has to go through, therefore, it
@ -281,8 +283,6 @@ data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr
-- compositions the performance starts dipping rapidly beyond a CPS style
-- unfused implementation.
--
-- | See 'Streamly.Internal.Data.Parser.splitWith'.
--
-- /Internal/
--
{-# INLINE splitWith #-}
@ -430,7 +430,6 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
extract (AltParseR sR) = extractR sR
extract (AltParseL _ sL) = extractL sL
-- XXX We are ignoring the Error?
-- | See documentation of 'Streamly.Internal.Data.Parser.many'.
--
-- /Internal/
@ -453,17 +452,14 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
let cnt1 = cnt + 1
case r of
Partial n s -> do
-- XXX Combine assert with the next statement
assert (cnt1 - n >= 0) (return ())
return $ Continue n (Tuple3' s (cnt1 - n) fs)
Continue n s -> do
-- XXX Combine assert with the next statement
assert (cnt1 - n >= 0) (return ())
return $ Continue n (Tuple3' s (cnt1 - n) fs)
Done n b -> do
s <- initial1
fs1 <- fstep fs b
-- XXX Combine assert with the next statement
assert (cnt1 - n >= 0) (return ())
return
$ case fs1 of
@ -484,8 +480,6 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
FL.Partial s1 -> fextract s1
FL.Done b1 -> return b1
-- XXX Unwrap Either into their own constructors?
-- XXX I think haskell automatically does this though. Need to check.
-- | See documentation of 'Streamly.Internal.Data.Parser.some'.
--
-- /Internal/
@ -505,6 +499,7 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
{-# INLINE step #-}
step (Tuple3' st cnt (Left fs)) a = do
r <- step1 st a
-- In the Left state, count is used only for the assert
let cnt1 = cnt + 1
case r of
Partial n s -> do
@ -514,6 +509,7 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
assert (cnt1 - n >= 0) (return ())
return $ Continue n (Tuple3' s (cnt1 - n) (Left fs))
Done n b -> do
assert (cnt1 - n >= 0) (return ())
s <- initial1
fs1 <- fstep fs b
return
@ -532,9 +528,9 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
assert (cnt1 - n >= 0) (return ())
return $ Continue n (Tuple3' s (cnt1 - n) (Right fs))
Done n b -> do
assert (cnt1 - n >= 0) (return ())
s <- initial1
fs1 <- fstep fs b
assert (cnt1 - n >= 0) (return ())
return
$ case fs1 of
FL.Partial s1 -> Partial n (Tuple3' s 0 (Right s1))

4
src/Streamly/Internal/FileSystem/Event/Linux.hs
View File

@ -783,7 +783,9 @@ readOneEvent cfg wt@(Watch _ wdMap) = do
-- XXX sliceSepByMax drops the separator so assumes a null
-- terminated path, we should use a takeWhile nested inside a
-- takeP
pth <- PR.sliceSepByMax (== 0) pathLen (A.writeN pathLen)
pth <-
PR.fromFold
$ FL.sliceSepByMax (== 0) pathLen (A.writeN pathLen)
let remaining = pathLen - A.length pth - 1
when (remaining /= 0) $ PR.takeEQ remaining FL.drain
return pth

2
streamly.cabal
View File

@ -694,11 +694,13 @@ test-suite Data.Parser
ghc-options: -O2
type: exitcode-stdio-1.0
main-is: Streamly/Test/Data/Parser.hs
other-modules: Streamly.Test.Common
test-suite Data.Parser.ParserD
import: test-options
type: exitcode-stdio-1.0
main-is: Streamly/Test/Data/Parser/ParserD.hs
other-modules: Streamly.Test.Common
test-suite Data.Array
import: test-options

115
test/Streamly/Test/Data/Parser.hs
View File

@ -1,16 +1,14 @@
module Main (main) where
import Control.Exception (SomeException(..), displayException)
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import Data.List ((\\))
import Data.Word (Word8, Word32, Word64)
import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)
import Test.Hspec (Spec, hspec, describe)
import Test.Hspec.QuickCheck
import Test.QuickCheck
(arbitrary, forAll, choose, elements, Property, property, listOf,
vectorOf, counterexample, Gen, suchThat)
import Test.QuickCheck.Monadic (monadicIO, PropertyM, assert, monitor, run)
(arbitrary, forAll, elements, Property, property, listOf,
vectorOf, Gen, suchThat)
import Test.QuickCheck.Monadic (monadicIO, assert, run)
import Prelude hiding (sequence)
@ -52,30 +50,6 @@ max_value = 10000
max_length :: Int
max_length = 1000
listEquals :: (Show a, Eq a, MonadIO m)
=> ([a] -> [a] -> Bool) -> [a] -> [a] -> PropertyM m ()
listEquals eq parsed_list list = do
when (not $ parsed_list `eq` list) $ liftIO $ putStrLn $
"parsed list " ++ show parsed_list
++ "\nlist " ++ show list
++ "\nparsed list \\\\ list " ++ show (parsed_list \\ list)
++ "\nlist \\\\ parsed list " ++ show (list \\ parsed_list)
when (not $ parsed_list `eq` list) $
monitor
(counterexample $
"parsed list " ++ show parsed_list
++ "\nlist " ++ show list
++ "\nparsed list \\\\ list " ++ show (parsed_list \\ list)
++ "\nlist \\\\ parsed list " ++ show (list \\ parsed_list)
)
assert (parsed_list `eq` list)
checkListEqual :: (Show a, Eq a) => [a] -> [a] -> Property
checkListEqual ls_1 ls_2 = monadicIO (listEquals (==) ls_1 ls_2)
chooseInt :: (Int, Int) -> Gen Int
chooseInt = choose
-- Accumulator Tests
fromFold :: Property
@ -85,20 +59,6 @@ fromFold =
Right is_equal -> is_equal
Left _ -> False
any :: Property
any =
forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
case S.parse (P.any (> mid_value)) (S.fromList ls) of
Right r -> r == (Prelude.any (> mid_value) ls)
Left _ -> False
all :: Property
all =
forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
case S.parse (P.all (> mid_value)) (S.fromList ls) of
Right r -> r == (Prelude.all (> mid_value) ls)
Left _ -> False
yield :: Property
yield =
forAll (chooseInt (min_value, max_value)) $ \x ->
@ -195,14 +155,6 @@ satisfy =
-- Sequence Parsers Tests
take :: Property
take =
forAll (chooseInt (min_value, max_value)) $ \n ->
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
case S.parse (P.take n FL.toList) (S.fromList ls) of
Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
Left _ -> property False
takeEQPass :: Property
takeEQPass =
forAll (chooseInt (min_value, max_value)) $ \n ->
@ -268,8 +220,6 @@ nLessThanEqual0 tk ltk =
takeProperties :: Spec
takeProperties =
describe "take combinators when n <= 0/" $ do
prop "take n FL.toList = []" $
nLessThanEqual0 P.take (\_ -> const [])
prop "takeEQ n FL.toList = []" $
nLessThanEqual0 P.takeEQ (\_ -> const [])
prop "takeGE n FL.toList xs = xs" $
@ -350,25 +300,6 @@ takeWhile1 =
where
predicate = (== 0)
sliceSepBy :: Property
sliceSepBy =
forAll (listOf (chooseInt (0, 1))) $ \ls ->
case S.parse (P.sliceSepBy predicate FL.toList) (S.fromList ls) of
Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile (not . predicate) ls)
Left _ -> property False
where
predicate = (== 1)
sliceSepByMax :: Property
sliceSepByMax =
forAll (chooseInt (min_value, max_value)) $ \n ->
forAll (listOf (chooseInt (0, 1))) $ \ls ->
case S.parse (P.sliceSepByMax predicate n FL.toList) (S.fromList ls) of
Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))
Left _ -> property False
where
predicate = (== 1)
-- splitWithPass :: Property
-- splitWithPass =
-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
@ -474,7 +405,8 @@ many =
forAll (listOf (chooseInt (0, 1))) $ \ls ->
let fldstp conL currL = return $ FL.Partial $ conL ++ currL
concatFold = FL.Fold fldstp (return []) return
prsr = P.many concatFold $ P.sliceSepBy (== 1) FL.toList
prsr = P.many concatFold
$ P.fromFold $ FL.sliceSepBy (== 1) FL.toList
in
case S.parse prsr (S.fromList ls) of
Right res_list -> checkListEqual res_list (Prelude.filter (== 0) ls)
@ -492,7 +424,8 @@ some =
let
ls = 0 : genLs
concatFold = FL.Fold (\concatList curr_list -> return $ FL.Partial $ concatList ++ curr_list) (return []) return
prsr = P.some concatFold $ P.sliceSepBy (== 1) FL.toList
prsr = P.some concatFold
$ P.fromFold $ FL.sliceSepBy (== 1) FL.toList
in
case S.parse prsr (S.fromList ls) of
Right res_list -> res_list == Prelude.filter (== 0) ls
@ -515,9 +448,9 @@ applicative =
forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->
forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
let parser =
(,)
<$> P.take (length list1) FL.toList
<*> P.take (length list2) FL.toList
(,)
<$> P.fromFold (FL.ltake (length list1) FL.toList)
<*> P.fromFold (FL.ltake (length list2) FL.toList)
in monadicIO $ do
(olist1, olist2) <-
run $ S.parse parser (S.fromList $ list1 ++ list2)
@ -529,11 +462,11 @@ applicative =
sequence :: Property
sequence =
forAll (vectorOf 11 (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0))) $ \ ins ->
let parsers = fmap (\xs -> P.take (length xs) FL.toList) ins
let p xs = P.fromFold (FL.ltake (length xs) FL.toList)
in monadicIO $ do
outs <- run $
S.parse
(Prelude.sequence parsers)
(Prelude.sequence $ fmap p ins)
(S.fromList $ concat ins)
listEquals (==) outs ins
@ -544,9 +477,9 @@ monad =
forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->
forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
let parser = do
olist1 <- P.take (length list1) FL.toList
olist2 <- P.take (length list2) FL.toList
return (olist1, olist2)
olist1 <- P.fromFold (FL.ltake (length list1) FL.toList)
olist2 <- P.fromFold (FL.ltake (length list2) FL.toList)
return (olist1, olist2)
in monadicIO $ do
(olist1, olist2) <-
run $ S.parse parser (S.fromList $ list1 ++ list2)
@ -562,12 +495,11 @@ parseMany =
forAll (chooseInt (1,100)) $ \len ->
forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
monadicIO $ do
outs <-
( run
$ S.toList
$ S.parseMany
(P.take len FL.toList) (S.fromList $ concat ins)
)
outs <- do
let p = P.fromFold $ FL.ltake len FL.toList
run
$ S.toList
$ S.parseMany p (S.fromList $ concat ins)
listEquals (==) outs ins
-------------------------------------------------------------------------------
@ -653,8 +585,6 @@ main =
describe "test for accumulator" $ do
prop "P.fromFold FL.sum = FL.sum" fromFold
prop "P.any = Prelude.any" Main.any
prop "P.all = Prelude.all" Main.all
prop "yield value provided" yield
prop "yield monadic value provided" yieldM
prop "fail err = Left (SomeException (ParseError err))" parserFail
@ -670,7 +600,6 @@ main =
prop "check first element exists and satisfies predicate" satisfy
describe "test for sequence parser" $ do
prop "P.take = Prelude.take" Main.take
prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ
prop "P.takeGE n ls = ls when len >= n" takeGEPass
@ -680,8 +609,6 @@ main =
-- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
prop "P.takeWhile = Prelude.takeWhile if taken something, else check why failed" takeWhile1
prop "P.sliceSepBy = Prelude.takeWhile (not . predicate)" sliceSepBy
prop "P.sliceSepByMax n predicate = Prelude.take n (Prelude.takeWhile (not . predicate))" sliceSepByMax
-- prop "" splitWithPass
-- prop "" splitWithFailLeft
-- prop "" splitWithFailRight

81
test/Streamly/Test/Data/Parser/ParserD.hs
View File

@ -1,17 +1,14 @@
module Main (main) where
import Control.Exception (SomeException(..))
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import Data.List ((\\))
import Data.Word (Word8, Word32, Word64)
import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)
import Test.Hspec (Spec, hspec, describe)
import Test.Hspec.QuickCheck
import Test.QuickCheck
(arbitrary, forAll, choose, elements, Property,
property, listOf, vectorOf, counterexample, (.&&.), Gen, suchThat)
import Test.QuickCheck.Monadic
(monadicIO, PropertyM, assert, monitor, run)
(arbitrary, forAll, elements, Property,
property, listOf, vectorOf, (.&&.), Gen, suchThat)
import Test.QuickCheck.Monadic (monadicIO, assert, run)
import qualified Streamly.Internal.Data.Parser.ParserD as P
import qualified Streamly.Internal.Data.Stream.IsStream as S
@ -52,30 +49,6 @@ max_value = 10000
max_length :: Int
max_length = 1000
listEquals :: (Show a, Eq a, MonadIO m)
=> ([a] -> [a] -> Bool) -> [a] -> [a] -> PropertyM m ()
listEquals eq parsed_list list = do
when (not $ parsed_list `eq` list) $ liftIO $ putStrLn $
"parsed list " ++ show parsed_list
++ "\nlist " ++ show list
++ "\nparsed list \\\\ list " ++ show (parsed_list \\ list)
++ "\nlist \\\\ parsed list " ++ show (list \\ parsed_list)
when (not $ parsed_list `eq` list) $
monitor
(counterexample $
"parsed list " ++ show parsed_list
++ "\nlist " ++ show list
++ "\nparsed list \\\\ list " ++ show (parsed_list \\ list)
++ "\nlist \\\\ parsed list " ++ show (list \\ parsed_list)
)
assert (parsed_list `eq` list)
checkListEqual :: (Show a, Eq a) => [a] -> [a] -> Property
checkListEqual ls_1 ls_2 = monadicIO (listEquals (==) ls_1 ls_2)
chooseInt :: (Int, Int) -> Gen Int
chooseInt = choose
-- Accumulator Tests
fromFold :: Property
@ -87,20 +60,6 @@ fromFold =
Right is_equal -> is_equal
Left _ -> False
any :: Property
any =
forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
case S.parseD (P.any (> mid_value)) (S.fromList ls) of
Right r -> r == (Prelude.any (> mid_value) ls)
Left _ -> False
all :: Property
all =
forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
case S.parseD (P.all (> mid_value)) (S.fromList ls) of
Right r -> r == (Prelude.all (> mid_value) ls)
Left _ -> False
yield :: Property
yield =
forAll (chooseInt (min_value, max_value)) $ \x ->
@ -192,7 +151,7 @@ take :: Property
take =
forAll (chooseInt (min_value, max_value)) $ \n ->
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
case S.parseD (P.take n FL.toList) (S.fromList ls) of
case S.parseD (P.fromFold $ FL.ltake n FL.toList) (S.fromList ls) of
Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
Left _ -> property False
@ -261,8 +220,6 @@ nLessThanEqual0 tk ltk =
takeProperties :: Spec
takeProperties =
describe "take combinators when n <= 0/" $ do
prop "take n FL.toList = []" $
nLessThanEqual0 P.take (\_ -> const [])
prop "takeEQ n FL.toList = []" $
nLessThanEqual0 P.takeEQ (\_ -> const [])
prop "takeGE n FL.toList xs = xs" $
@ -275,7 +232,7 @@ lookAheadPass :: Property
lookAheadPass =
forAll (chooseInt (min_value, max_value)) $ \n ->
let
takeWithoutConsume = P.lookAhead $ P.take n FL.toList
takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.ltake n FL.toList
parseTwice = do
parsed_list_1 <- takeWithoutConsume
parsed_list_2 <- takeWithoutConsume
@ -291,7 +248,7 @@ lookAhead :: Property
lookAhead =
forAll (chooseInt (min_value, max_value)) $ \n ->
let
takeWithoutConsume = P.lookAhead $ P.take n FL.toList
takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.ltake n FL.toList
parseTwice = do
parsed_list_1 <- takeWithoutConsume
parsed_list_2 <- takeWithoutConsume
@ -333,7 +290,7 @@ takeWhile1 =
sliceSepBy :: Property
sliceSepBy =
forAll (listOf (chooseInt (0, 1))) $ \ls ->
case S.parseD (P.sliceSepBy predicate FL.toList) (S.fromList ls) of
case S.parseD (P.fromFold $ FL.sliceSepBy predicate FL.toList) (S.fromList ls) of
Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile (not . predicate) ls)
Left _ -> property False
where
@ -343,7 +300,7 @@ sliceSepByMax :: Property
sliceSepByMax =
forAll (chooseInt (min_value, max_value)) $ \n ->
forAll (listOf (chooseInt (0, 1))) $ \ls ->
case S.parseD (P.sliceSepByMax predicate n FL.toList) (S.fromList ls) of
case S.parseD (P.fromFold $ FL.sliceSepByMax predicate n FL.toList) (S.fromList ls) of
Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))
Left _ -> property False
where
@ -383,7 +340,7 @@ teeWithPass =
forAll (chooseInt (min_value, max_value)) $ \n ->
forAll (listOf (chooseInt (0, 1))) $ \ls ->
let
prsr = P.take n FL.toList
prsr = P.fromFold $ FL.ltake n FL.toList
in
case S.parseD (P.teeWith (,) prsr prsr) (S.fromList ls) of
Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
@ -480,7 +437,7 @@ many =
let fldstp conL currL = return $ FL.Partial (conL ++ currL)
concatFold =
FL.Fold fldstp (return []) return
prsr = P.many concatFold $ P.sliceSepBy (== 1) FL.toList
prsr = P.many concatFold $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList
in case S.parseD prsr (S.fromList ls) of
Right res_list ->
checkListEqual res_list (Prelude.filter (== 0) ls)
@ -498,7 +455,7 @@ some =
$ \ls ->
let fldstp conL currL = return $ FL.Partial $ conL ++ currL
concatFold = FL.Fold fldstp (return []) return
prsr = P.some concatFold $ P.sliceSepBy (== 1) FL.toList
prsr = P.some concatFold $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList
in case S.parseD prsr (S.fromList ls) of
Right res_list -> res_list == Prelude.filter (== 0) ls
Left _ -> False
@ -521,8 +478,8 @@ applicative =
forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
let parser =
(,)
<$> P.take (length list1) FL.toList
<*> P.take (length list2) FL.toList
<$> P.fromFold (FL.ltake (length list1) FL.toList)
<*> P.fromFold (FL.ltake (length list2) FL.toList)
in monadicIO $ do
(olist1, olist2) <-
run $ S.parseD parser (S.fromList $ list1 ++ list2)
@ -534,7 +491,7 @@ applicative =
sequence :: Property
sequence =
forAll (vectorOf 11 (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0))) $ \ ins ->
let parsers = fmap (\xs -> P.take (length xs) FL.toList) ins
let parsers = fmap (\xs -> P.fromFold $ FL.ltake (length xs) FL.toList) ins
in monadicIO $ do
outs <- run $
S.parseD
@ -549,8 +506,8 @@ monad =
forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->
forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
let parser = do
olist1 <- P.take (length list1) FL.toList
olist2 <- P.take (length list2) FL.toList
olist1 <- P.fromFold (FL.ltake (length list1) FL.toList)
olist2 <- P.fromFold (FL.ltake (length list2) FL.toList)
return (olist1, olist2)
in monadicIO $ do
(olist1, olist2) <-
@ -571,7 +528,7 @@ parseMany =
( run
$ S.toList
$ S.parseManyD
(P.take len FL.toList) (S.fromList $ concat ins)
(P.fromFold $ FL.ltake len FL.toList) (S.fromList $ concat ins)
)
listEquals (==) outs ins
@ -657,8 +614,6 @@ main =
describe "test for accumulator" $ do
prop "P.fromFold FL.sum = FL.sum" fromFold
prop "P.any = Prelude.any" Main.any
prop "P.all = Prelude.all" Main.all
prop "yield value provided" yield
prop "yield monadic value provided" yieldM
prop "always fail" die