mirror of
https://github.com/composewell/streamly.git
synced 2024-10-26 19:50:19 +03:00
Add sliceBeginWith, tests and benchmarks
This commit is contained in:
parent
b6a07525eb
commit
fb9f05e4fb
@ -72,6 +72,10 @@ takeEQ value = IP.parse (PR.takeEQ value FL.drain)
|
||||
drainWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
|
||||
drainWhile value = IP.parse (PR.drainWhile (<= value))
|
||||
|
||||
{-# INLINE sliceBeginWith #-}
|
||||
sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m ()
|
||||
sliceBeginWith value = IP.parse (PR.sliceBeginWith (>= value) FL.drain)
|
||||
|
||||
{-# INLINE takeWhile #-}
|
||||
takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
|
||||
takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)
|
||||
@ -284,6 +288,7 @@ o_1_space_serial value =
|
||||
, benchIOSink value "takeEQ" $ takeEQ value
|
||||
, benchIOSink value "takeWhile" $ takeWhile value
|
||||
, benchIOSink value "drainWhile" $ drainWhile value
|
||||
, benchIOSink value "sliceBeginWith" $ sliceBeginWith value
|
||||
, benchIOSink value "groupBy" $ groupBy
|
||||
, benchIOSink value "groupByRolling" $ groupByRolling
|
||||
, benchIOSink value "wordBy" $ wordBy value
|
||||
|
@ -63,6 +63,10 @@ benchIOSink value name f =
|
||||
drainWhile :: MonadThrow m => (a -> Bool) -> PR.Parser m a ()
|
||||
drainWhile p = PR.takeWhile p FL.drain
|
||||
|
||||
{-# INLINE sliceBeginWith #-}
|
||||
sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m()
|
||||
sliceBeginWith value = IP.parseD (PR.sliceBeginWith (>= value) FL.drain)
|
||||
|
||||
{-# INLINE takeWhile #-}
|
||||
takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()
|
||||
takeWhile value = IP.parseD (drainWhile (<= value))
|
||||
@ -216,6 +220,7 @@ moduleName = "Data.Parser.ParserD"
|
||||
o_1_space_serial :: Int -> [Benchmark]
|
||||
o_1_space_serial value =
|
||||
[ benchIOSink value "takeWhile" $ takeWhile value
|
||||
, benchIOSink value "sliceBeginWith" $ sliceBeginWith value
|
||||
, benchIOSink value "groupBy" $ groupBy
|
||||
, benchIOSink value "groupByRolling" $ groupByRolling
|
||||
, benchIOSink value "wordBy" $ wordBy value
|
||||
|
@ -507,22 +507,41 @@ sliceSepWith _cond = undefined -- K.toParserK . D.sliceSepBy cond
|
||||
|
||||
-- | 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
|
||||
-- stream and we continue collecting. The succeeding element is treated as a
|
||||
-- prefix separator which is kept in the output segement.
|
||||
-- the predicate succeeds on the first element itself then the parser does not
|
||||
-- terminate there. The succeeding element in the leading position
|
||||
-- is treated as a prefix separator which is kept in the output segment.
|
||||
--
|
||||
-- * Stops - when the predicate succeeds in non-leading position.
|
||||
-- * Fails - never.
|
||||
--
|
||||
-- S.splitWithPrefix pred f = S.parseMany (PR.sliceBeginWith pred f)
|
||||
--
|
||||
-- /Unimplemented/
|
||||
-- Examples: -
|
||||
--
|
||||
-- @
|
||||
-- sliceBeginWithOdd ls = S.parse prsr (S.fromList ls)
|
||||
-- where prsr = P.sliceBeginWith odd FL.toList
|
||||
-- @
|
||||
--
|
||||
-- >>> sliceBeginWithOdd [2, 4, 6, 3]
|
||||
-- > [2,4,6]
|
||||
--
|
||||
-- >>> sliceBeginWithOdd [3, 5, 7, 4]
|
||||
-- > [3]
|
||||
--
|
||||
-- >>> sliceBeginWithOdd [3, 4, 6, 8, 5]
|
||||
-- > [3,4,6,8]
|
||||
--
|
||||
-- >>> sliceBeginWithOdd []
|
||||
-- > []
|
||||
--
|
||||
-- /Internal/
|
||||
--
|
||||
{-# INLINABLE sliceBeginWith #-}
|
||||
sliceBeginWith ::
|
||||
-- Monad m =>
|
||||
MonadCatch m =>
|
||||
(a -> Bool) -> Fold m a b -> Parser m a b
|
||||
sliceBeginWith = undefined
|
||||
sliceBeginWith cond = K.toParserK . D.sliceBeginWith cond
|
||||
|
||||
-- | Like 'sliceSepBy' but the separator elements can be escaped using an
|
||||
-- escape char determined by the second predicate.
|
||||
|
@ -535,13 +535,36 @@ sliceSepByP cond (Parser pstep pinitial pextract) =
|
||||
|
||||
-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
|
||||
--
|
||||
-- /Unimplemented/
|
||||
-- /Internal/
|
||||
--
|
||||
{-# INLINABLE sliceBeginWith #-}
|
||||
sliceBeginWith ::
|
||||
-- Monad m =>
|
||||
(a -> Bool) -> Fold m a b -> Parser m a b
|
||||
sliceBeginWith = undefined
|
||||
data SliceBeginWithState s = Left' s | Right' s
|
||||
|
||||
{-# INLINE sliceBeginWith #-}
|
||||
sliceBeginWith :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
|
||||
sliceBeginWith cond (Fold fstep finitial fextract) =
|
||||
|
||||
Parser step initial extract
|
||||
|
||||
where
|
||||
|
||||
initial = Left' <$> finitial
|
||||
|
||||
{-# INLINE process #-}
|
||||
process s a = do
|
||||
res <- fstep s a
|
||||
return
|
||||
$ case res of
|
||||
FL.Partial s1 -> Partial 0 (Right' s1)
|
||||
FL.Done b -> Done 0 b
|
||||
|
||||
step (Left' s) a = process s a
|
||||
step (Right' s) a =
|
||||
if not (cond a)
|
||||
then process s a
|
||||
else Done 1 <$> fextract s
|
||||
|
||||
extract (Left' s) = fextract s
|
||||
extract (Right' s) = fextract s
|
||||
|
||||
data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
|
||||
|
||||
|
@ -323,6 +323,23 @@ sliceSepByP =
|
||||
prsr = P.many FL.toList (P.satisfy (const True))
|
||||
tkwhl ls = Prelude.takeWhile (not . predicate) ls
|
||||
|
||||
sliceBeginWith :: Property
|
||||
sliceBeginWith =
|
||||
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
|
||||
case S.parse parser (S.fromList ls) of
|
||||
Right parsed_list ->
|
||||
if not $ Prelude.null ls
|
||||
then
|
||||
let tls = Prelude.takeWhile (not . predicate) (tail ls)
|
||||
in checkListEqual parsed_list $
|
||||
if predicate (head ls)
|
||||
then head ls : tls
|
||||
else Prelude.takeWhile (not . predicate) ls
|
||||
else property $ Prelude.null parsed_list
|
||||
Left _ -> property False
|
||||
where
|
||||
predicate = odd
|
||||
parser = P.sliceBeginWith predicate FL.toList
|
||||
|
||||
takeWhile :: Property
|
||||
takeWhile =
|
||||
@ -696,6 +713,8 @@ main =
|
||||
-- prop "Fail when stream length exceeded" lookAheadFail
|
||||
-- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
|
||||
prop "P.sliceSepByP test" Main.sliceSepByP
|
||||
prop ("P.sliceBeginWith pred = head : Prelude.takeWhile (not . pred)"
|
||||
++ " tail") sliceBeginWith
|
||||
prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
|
||||
prop ("P.takeWhile1 = Prelude.takeWhile if taken something,"
|
||||
++ " else check why failed") takeWhile1
|
||||
|
@ -292,7 +292,6 @@ lookAhead =
|
||||
where
|
||||
list_length = Prelude.length ls
|
||||
|
||||
|
||||
takeWhile :: Property
|
||||
takeWhile =
|
||||
forAll (listOf (chooseInt (0, 1))) $ \ ls ->
|
||||
|
Loading…
Reference in New Issue
Block a user