diff --git a/benchmark/Streamly/Benchmark/Data/Parser.hs b/benchmark/Streamly/Benchmark/Data/Parser.hs index f476093e..6abc9fa4 100644 --- a/benchmark/Streamly/Benchmark/Data/Parser.hs +++ b/benchmark/Streamly/Benchmark/Data/Parser.hs @@ -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) ] diff --git a/benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs b/benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs index 7275cef2..4327685c 100644 --- a/benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs +++ b/benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs @@ -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) ] diff --git a/benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs b/benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs index e7309847..82294e85 100644 --- a/benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs +++ b/benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs @@ -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) ] diff --git a/src/Streamly/Internal/Data/Parser.hs b/src/Streamly/Internal/Data/Parser.hs index 4ebd6819..1a667c46 100644 --- a/src/Streamly/Internal/Data/Parser.hs +++ b/src/Streamly/Internal/Data/Parser.hs @@ -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 #-} diff --git a/src/Streamly/Internal/Data/Parser/ParserD.hs b/src/Streamly/Internal/Data/Parser/ParserD.hs index ae3f5645..2d5fa4dc 100644 --- a/src/Streamly/Internal/Data/Parser/ParserD.hs +++ b/src/Streamly/Internal/Data/Parser/ParserD.hs @@ -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 diff --git a/src/Streamly/Internal/Data/Parser/ParserD/Types.hs b/src/Streamly/Internal/Data/Parser/ParserD/Types.hs index f24844f2..245481ec 100644 --- a/src/Streamly/Internal/Data/Parser/ParserD/Types.hs +++ b/src/Streamly/Internal/Data/Parser/ParserD/Types.hs @@ -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)) diff --git a/src/Streamly/Internal/FileSystem/Event/Linux.hs b/src/Streamly/Internal/FileSystem/Event/Linux.hs index 61d6995d..076d1eeb 100644 --- a/src/Streamly/Internal/FileSystem/Event/Linux.hs +++ b/src/Streamly/Internal/FileSystem/Event/Linux.hs @@ -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 diff --git a/streamly.cabal b/streamly.cabal index e8bb6520..1404e679 100644 --- a/streamly.cabal +++ b/streamly.cabal @@ -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 diff --git a/test/Streamly/Test/Data/Parser.hs b/test/Streamly/Test/Data/Parser.hs index 8f2340a2..138e9642 100644 --- a/test/Streamly/Test/Data/Parser.hs +++ b/test/Streamly/Test/Data/Parser.hs @@ -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 diff --git a/test/Streamly/Test/Data/Parser/ParserD.hs b/test/Streamly/Test/Data/Parser/ParserD.hs index d1f4b201..38a8e4fe 100644 --- a/test/Streamly/Test/Data/Parser/ParserD.hs +++ b/test/Streamly/Test/Data/Parser/ParserD.hs @@ -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