e4e1d25 · streamly · git.iko.soy

git.iko.soy/streamly

make sliceBeginWith fail when first element fails predicate

commite4e1d25647b696b28ee5df74f8d177889d102173 authorAnurag Hooda <anuraghooda@composewell.com> dateFri 5 Feb 2021, 00:50 (6 years ago) parentfb9f05e

4 files changed+38−18

compare with master

unifiedsplit

benchmark/Streamly/Benchmark/Data/Parser.hs+5−1 benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs+7−2 src/Streamly/Internal/Data/Parser/ParserD.hs+11−2 test/Streamly/Test/Data/Parser.hs+15−13

benchmark/Streamly/Benchmark/Data/Parser.hs+5−1

@@ -16,6 +16,7 @@ import Control.DeepSeq (NFData(..))

1616import Control.Monad.Catch (MonadCatch)

1717import Data.Foldable (asum)

1818import Data.Functor (($>))

19+import Data.Maybe (fromMaybe)

1920import Data.Monoid (Sum(..))

2021import System.Random (randomRIO)

2122import Prelude

@@ -74,7 +75,10 @@ drainWhile value = IP.parse (PR.drainWhile (<= value))

7475

7576{-# INLINE sliceBeginWith #-}

7677sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m ()

77−sliceBeginWith value = IP.parse (PR.sliceBeginWith (>= value) FL.drain)

78+sliceBeginWith value stream = do

79+ stream1 <- return . fromMaybe (S.yield (value + 1)) =<< S.tail stream

80+ let stream2 = value `S.cons` stream1

81+ IP.parse (PR.sliceBeginWith (== value) FL.drain) stream2

7882

7983{-# INLINE takeWhile #-}

8084takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()

benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs+7−2

@@ -6,6 +6,7 @@

66-- Maintainer : streamly@composewell.com

88{-# LANGUAGE FlexibleContexts #-}

9+{-# LANGUAGE ScopedTypeVariables #-}

910{-# OPTIONS_GHC -fspec-constr-recursive=4 #-}

1011

1112module Main

@@ -17,6 +18,7 @@ import Control.DeepSeq (NFData(..))

1718import Control.Monad.Catch (MonadCatch, MonadThrow)

1819import Data.Foldable (asum)

1920import Data.Functor (($>))

21+import Data.Maybe (fromMaybe)

2022import System.Random (randomRIO)

2123import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)

2224

@@ -64,8 +66,11 @@ drainWhile :: MonadThrow m => (a -> Bool) -> PR.Parser m a ()

6466drainWhile p = PR.takeWhile p FL.drain

6567

6668{-# INLINE sliceBeginWith #-}

67−sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m()

68−sliceBeginWith value = IP.parseD (PR.sliceBeginWith (>= value) FL.drain)

69+sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m ()

70+sliceBeginWith value stream = do

71+ stream1 <- return . fromMaybe (S.yield (value + 1)) =<< S.tail stream

72+ let stream2 = value `S.cons` stream1

73+ IP.parseD (PR.sliceBeginWith (== value) FL.drain) stream2

6974

7075{-# INLINE takeWhile #-}

7176takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()

src/Streamly/Internal/Data/Parser/ParserD.hs+11−2

@@ -547,7 +547,12 @@ sliceBeginWith cond (Fold fstep finitial fextract) =

547547

548548 where

549549

550− initial = Left' <$> finitial

550+ initial = do

551+ res <- finitial

552+ return $

553+ case res of

554+ FL.Partial s -> Left' s

555+ FL.Done _ -> error "sliceBeginWith : bad finitial"

551556

552557 {-# INLINE process #-}

553558 process s a = do

@@ -557,7 +562,11 @@ sliceBeginWith cond (Fold fstep finitial fextract) =

557562 FL.Partial s1 -> Partial 0 (Right' s1)

558563 FL.Done b -> Done 0 b

559564

560− step (Left' s) a = process s a

565+ step (Left' s) a =

566+ if cond a

567+ then process s a

568+ else error $ "sliceBeginWith : slice begins with an element which"

569+ ++ "fails the predicate"

561570 step (Right' s) a =

562571 if not (cond a)

563572 then process s a

test/Streamly/Test/Data/Parser.hs+15−13

@@ -326,20 +326,22 @@ sliceSepByP =

326326sliceBeginWith :: Property

327327sliceBeginWith =

328328 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->

329− case S.parse parser (S.fromList ls) of

330− Right parsed_list ->

331− if not $ Prelude.null ls

332− then

333− let tls = Prelude.takeWhile (not . predicate) (tail ls)

329+ let ls1 = 1:ls

330+ in

331+ case S.parse parser (S.fromList ls1) of

332+ Right parsed_list ->

333+ if not $ Prelude.null ls1

334+ then

335+ let tls = Prelude.takeWhile (not . predicate) (tail ls1)

334336 in checkListEqual parsed_list $

335− if predicate (head ls)

336− then head ls : tls

337− else Prelude.takeWhile (not . predicate) ls

338− else property $ Prelude.null parsed_list

339− Left _ -> property False

340− where

341− predicate = odd

342− parser = P.sliceBeginWith predicate FL.toList

337+ if predicate (head ls1)

338+ then head ls1 : tls

339+ else Prelude.takeWhile (not . predicate) ls1

340+ else property $ Prelude.null parsed_list

341+ Left _ -> property False

342+ where

343+ predicate = odd

344+ parser = P.sliceBeginWith predicate FL.toList

343345

344346takeWhile :: Property

345347takeWhile =