c076966 · streamly · git.iko.soy

git.iko.soy/streamly

Change the type of parser "extract" to Step

commitc0769668d946e0c88a01e6fd234c4aef3bb3e5c7 authorHarendra Kumar <harendra@composewell.com> dateThu 11 Aug 2022, 14:59 (4 years ago) parent805016f

17 files changed+1092−459

compare with master

unifiedsplit

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

@@ -275,6 +275,7 @@ takeEndBy_ :: MonadCatch m

275275 => Int -> Stream m Int -> m()

276276takeEndBy_ value = Stream.parse (PR.takeEndBy_ (>= value) (PR.fromFold Fold.drain))

277277

278+{-

278279{-# INLINE teeAllAny #-}

279280teeAllAny :: MonadCatch m

280281 => Int -> Stream m Int -> m ((), ())

@@ -314,6 +315,7 @@ longestAllAny value =

314315 (PR.dropWhile (<= value))

315316 (PR.dropWhile (<= value))

316317 )

318+-}

317319

318320parseManyChunksOfSum :: Int -> Handle -> IO Int

319321parseManyChunksOfSum n inh =

@@ -379,11 +381,13 @@ choiceAsum value =

379381 Stream.parse (asum (replicate value (PR.satisfy (< 0)))

380382 AP.<|> PR.satisfy (> 0))

381383

384+{-

382385{-# INLINE choice #-}

383386choice :: MonadCatch m => Int -> Stream m Int -> m Int

384387choice value =

385388 Stream.parse

386389 (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))

390+-}

387391

388392-------------------------------------------------------------------------------

389393-- Stream transformation

@@ -450,10 +454,12 @@ o_1_space_serial value =

450454 , benchIOSink value "many (wordBy even)" $ manyWordByEven

451455 , benchIOSink value "some" some

452456 , benchIOSink value "manyTill" $ manyTill value

457+ {-

453458 , benchIOSink value "tee" $ teeAllAny value

454459 , benchIOSink value "teeFst" $ teeFstAllAny value

455460 , benchIOSink value "shortest" $ shortestAllAny value

456461 , benchIOSink value "longest" $ longestAllAny value

462+ -}

457463 , benchIOSink value "parseBreak (recursive)" parseBreak

458464 , benchIOSink value "parseMany (take 1)" (parseMany 1)

459465 , benchIOSink value "parseMany (take all)" (parseMany value)

@@ -495,7 +501,7 @@ o_n_heap_serial value =

495501 , benchIOSink value "split_" $ split_ value

496502 -- XXX why O(n) heap?

497503 , benchIOSink value "choice (asum)" $ choiceAsum value

498− , benchIOSink value "choice" $ choice value

504+ -- , benchIOSink value "choice" $ choice value

499505

500506 -- These show non-linear time complexity.

501507 -- They accumulate the results in a list.

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

@@ -157,6 +157,7 @@ serialWith value =

157157 <*> drainWhile (<= value)

158158 )

159159

160+{-

160161{-# INLINE teeAllAny #-}

161162teeAllAny :: MonadThrow m

162163 => Int -> Stream m Int -> m ((), ())

@@ -196,6 +197,7 @@ longestAllAny value =

196197 (drainWhile (<= value))

197198 (drainWhile (<= value))

198199 )

200+-}

199201

200202{-# INLINE sequenceParser #-}

201203sequenceParser :: MonadCatch m => Stream m Int -> m ()

@@ -310,11 +312,13 @@ choiceAsum value =

310312 Stream.parseD (asum (replicate value (PR.satisfy (< 0)))

311313 AP.<|> PR.satisfy (> 0))

312314

315+{-

313316{-# INLINE choice #-}

314317choice :: MonadCatch m => Int -> Stream m Int -> m Int

315318choice value =

316319 Stream.parseD

317320 (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))

321+-}

318322

319323-------------------------------------------------------------------------------

320324-- Benchmarks

@@ -338,10 +342,12 @@ o_1_space_serial value =

338342 , benchIOSink value "some" some

339343 , benchIOSink value "takeEndBy_" $ takeEndBy_ value

340344 , benchIOSink value "manyTill" $ manyTill value

345+ {-

341346 , benchIOSink value "tee (all,any)" $ teeAllAny value

342347 , benchIOSink value "teeFst (all,any)" $ teeFstAllAny value

343348 , benchIOSink value "shortest (all,any)" $ shortestAllAny value

344349 , benchIOSink value "longest (all,any)" $ longestAllAny value

350+ -}

345351 , benchIOSink value "sequenceParser" sequenceParser

346352 ]

347353

@@ -398,7 +404,7 @@ o_n_space_serial value =

398404 , benchIOSink value "sequence/100" $ sequence (value `div` 100)

399405 , benchIOSink value "sequence_/100" $ sequence_ (value `div` 100)

400406 , benchIOSink value "choice (asum)/100" $ choiceAsum (value `div` 100)

401− , benchIOSink value "choice/100" $ choice (value `div` 100)

407+ -- , benchIOSink value "choice/100" $ choice (value `div` 100)

402408 ]

403409

404410-------------------------------------------------------------------------------

core/src/Streamly/Internal/Data/Array/Stream/Fold/Foreign.hs+30−8

@@ -60,6 +60,7 @@ import Control.Applicative (liftA2)

6060import Control.Exception (assert)

6161import Control.Monad.Catch (MonadThrow)

6262import Control.Monad.IO.Class (MonadIO(..))

63+import Data.Bifunctor (first)

6364import Streamly.Internal.Data.Unboxed (peekWith, sizeOf, Unboxed)

6465import GHC.Types (SPEC(..))

6566import Streamly.Internal.Data.Array.Unboxed.Mut.Type (touch)

@@ -100,7 +101,7 @@ newtype ArrayFold m a b = ArrayFold (ParserD.Parser m (Array a) b)

100101fromFold :: forall m a b. (MonadIO m, Unboxed a) =>

101102 Fold.Fold m a b -> ArrayFold m a b

102103fromFold (Fold.Fold fstep finitial fextract) =

103− ArrayFold (ParserD.Parser step initial fextract)

104+ ArrayFold (ParserD.Parser step initial (fmap (Done 0) . fextract))

104105

105106 where

106107

@@ -308,13 +309,21 @@ take n (ArrayFold (ParserD.Parser step1 initial1 extract1)) =

308309

309310 where

310311

312+ -- XXX Need to make the Initial type Step to remove this

313+ iextract s = do

314+ r <- extract1 s

315+ return $ case r of

316+ Done _ b -> IDone b

317+ Error err -> IError err

318+ _ -> error "Bug: ArrayFold take invalid state in initial"

319+

311320 initial = do

312321 res <- initial1

313322 case res of

314323 IPartial s ->

315324 if n > 0

316325 then return $ IPartial $ Tuple' n s

317− else IDone <$> extract1 s

326+ else iextract s

318327 IDone b -> return $ IDone b

319328 IError err -> return $ IError err

320329

@@ -323,8 +332,16 @@ take n (ArrayFold (ParserD.Parser step1 initial1 extract1)) =

323332 let i2 = i1 + j

324333 in if i2 > 0

325334 then return $ st j (Tuple' i2 s)

326− else Done 0 <$> extract1 s -- i2 == i1 == j == 0

327−

335+ else do

336+ -- i2 == i1 == j == 0

337+ r <- extract1 s

338+ return $ case r of

339+ Error err -> Error err

340+ Done n1 b -> Done n1 b

341+ Continue n1 s1 -> Continue n1 (Tuple' i2 s1)

342+ Partial _ _ -> error "Partial in extract"

343+

344+ -- Tuple' (how many more items to take) (fold state)

328345 step (Tuple' i r) arr = do

329346 let len = Array.length arr

330347 i1 = i - len

@@ -339,15 +356,20 @@ take n (ArrayFold (ParserD.Parser step1 initial1 extract1)) =

339356 else do

340357 let !(Array contents start _) = arr

341358 end = INDEX_OF(start,i,a)

359+ -- Supply only the required slice of array

342360 arr1 = Array contents start end

343− remaining = negate i1

361+ remaining = negate i1 -- i1 is negative here

344362 res <- step1 r arr1

345363 case res of

346− Partial 0 s -> Done remaining <$> extract1 s

364+ Partial 0 s ->

365+ ParserD.bimapOverrideCount

366+ remaining (Tuple' 0) id <$> extract1 s

347367 Partial j s -> return $ Partial (remaining + j) (Tuple' j s)

348− Continue 0 s -> Done remaining <$> extract1 s

368+ Continue 0 s ->

369+ ParserD.bimapOverrideCount

370+ remaining (Tuple' 0) id <$> extract1 s

349371 Continue j s -> return $ Continue (remaining + j) (Tuple' j s)

350372 Done j b -> return $ Done (remaining + j) b

351373 Error err -> return $ Error err

352374

353− extract (Tuple' _ r) = extract1 r

375+ extract (Tuple' i r) = first (Tuple' i) <$> extract1 r

core/src/Streamly/Internal/Data/Array/Stream/Mut/Foreign.hs+2−2

@@ -239,8 +239,8 @@ compactLEParserD n = ParserD.Parser step initial extract

239239 buf2 <- MArray.splice buf1 arr

240240 return $ ParserD.Partial 0 (Just buf2)

241241

242− extract Nothing = return MArray.nil

243− extract (Just buf) = return buf

242+ extract Nothing = return $ ParserD.Done 0 MArray.nil

243+ extract (Just buf) = return $ ParserD.Done 0 buf

244244

245245 functionPath =

246246 "Streamly.Internal.Data.Array.Stream.Mut.Foreign.compactLEParserD"

core/src/Streamly/Internal/Data/Parser.hs+11−1

@@ -148,11 +148,13 @@ module Streamly.Internal.Data.Parser

148148 , serialWith

149149 , split_

150150

151+{-

151152 -- ** Parallel Applicatives

152153 , teeWith

153154 , teeWithFst

154155 , teeWithMin

155156 -- , teeTill -- like manyTill but parallel

157+-}

156158

157159 -- ** Sequential Interleaving

158160 -- Use two folds, run a primary parser, its rejected values go to the

@@ -182,10 +184,12 @@ module Streamly.Internal.Data.Parser

182184 -- ** Sequential Alternative

183185 , alt

184186

187+{-

185188 -- ** Parallel Alternatives

186189 , shortest

187190 , longest

188191 -- , fastest

192+-}

189193

190194 -- * N-ary Combinators

191195 -- ** Sequential Collection

@@ -228,7 +232,7 @@ module Streamly.Internal.Data.Parser

228232 -- , fastestN -- first N successful in time

229233 -- , choiceN -- first N successful in position

230234 -- @

231− , choice -- first successful in position

235+ -- , choice -- first successful in position

232236

233237 -- ** Repeated Alternatives

234238 , retryMaxTotal

@@ -1110,6 +1114,7 @@ serialWith f p1 p2 =

11101114split_ :: MonadCatch m => Parser m x a -> Parser m x b -> Parser m x b

11111115split_ p1 p2 = D.toParserK $ D.split_ (D.fromParserK p1) (D.fromParserK p2)

11121116

1117+{-

11131118-- | @teeWith f p1 p2@ distributes its input to both @p1@ and @p2@ until both

11141119-- of them succeed or anyone of them fails and combines their output using @f@.

11151120-- The parser succeeds if both the parsers succeed.

@@ -1143,6 +1148,7 @@ teeWithMin :: MonadCatch m

11431148 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c

11441149teeWithMin f p1 p2 =

11451150 D.toParserK $ D.teeWithMin f (D.fromParserK p1) (D.fromParserK p2)

1151+-}

11461152

11471153-- | Sequential alternative. Apply the input to the first parser and return the

11481154-- result if the parser succeeds. If the first parser fails then backtrack and

@@ -1165,6 +1171,7 @@ teeWithMin f p1 p2 =

11651171alt :: MonadCatch m => Parser m x a -> Parser m x a -> Parser m x a

11661172alt p1 p2 = D.toParserK $ D.alt (D.fromParserK p1) (D.fromParserK p2)

11671173

1174+{-

11681175-- | Shortest alternative. Apply both parsers in parallel but choose the result

11691176-- from the one which consumed least input i.e. take the shortest succeeding

11701177-- parse.

@@ -1186,6 +1193,7 @@ shortest p1 p2 = D.toParserK $ D.shortest (D.fromParserK p1) (D.fromParserK p2)

11861193longest :: MonadCatch m

11871194 => Parser m x a -> Parser m x a -> Parser m x a

11881195longest p1 p2 = D.toParserK $ D.longest (D.fromParserK p1) (D.fromParserK p2)

1196+-}

11891197

11901198-- | Run a parser without consuming the input.

11911199--

@@ -1246,6 +1254,7 @@ concatMap :: MonadCatch m

12461254 => (b -> Parser m a c) -> Parser m a b -> Parser m a c

12471255concatMap f p = D.toParserK $ D.concatMap (D.fromParserK . f) (D.fromParserK p)

12481256

1257+{-

12491258-------------------------------------------------------------------------------

12501259-- Alternative Collection

12511260-------------------------------------------------------------------------------

@@ -1261,6 +1270,7 @@ concatMap f p = D.toParserK $ D.concatMap (D.fromParserK . f) (D.fromParserK p)

12611270choice ::

12621271 (Functor t, Foldable t, MonadCatch m) => t (Parser m a b) -> Parser m a b

12631272choice ps = D.toParserK $ D.choice $ D.fromParserK <$> ps

1273+-}

12641274

12651275-------------------------------------------------------------------------------

12661276-- Sequential Repetition

core/src/Streamly/Internal/Data/Parser/ParserD.hs+223−144

@@ -109,11 +109,13 @@ module Streamly.Internal.Data.Parser.ParserD

109109 , serialWith

110110 , split_

111111

112+ {-

112113 -- ** Parallel Applicatives

113114 , teeWith

114115 , teeWithFst

115116 , teeWithMin

116117 -- , teeTill -- like manyTill but parallel

118+ -}

117119

118120 -- ** Sequential Interleaving

119121 -- Use two folds, run a primary parser, its rejected values go to the

@@ -124,11 +126,12 @@ module Streamly.Internal.Data.Parser.ParserD

124126 -- ** Sequential Alternative

125127 , alt

126128

129+ {-

127130 -- ** Parallel Alternatives

128131 , shortest

129132 , longest

130133 -- , fastest

131−

134+ -}

132135 -- * N-ary Combinators

133136 -- ** Sequential Collection

134137 , sequence

@@ -180,7 +183,7 @@ module Streamly.Internal.Data.Parser.ParserD

180183 -- , longestN

181184 -- , fastestN -- first N successful in time

182185 -- , choiceN -- first N successful in position

183− , choice -- first successful in position

186+ -- , choice -- first successful in position

184187

185188 -- -- ** Repeated Alternatives

186189 -- , retryMax -- try N times

@@ -216,7 +219,7 @@ import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D

216219import Prelude hiding

217220 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span

218221 , zip, filter)

219−import Streamly.Internal.Data.Parser.ParserD.Tee

222+-- import Streamly.Internal.Data.Parser.ParserD.Tee

220223import Streamly.Internal.Data.Parser.ParserD.Type

221224

222225--

@@ -250,7 +253,7 @@ instance Exception ParserToFoldError

250253--

251254{-# INLINE toFold #-}

252255toFold :: MonadThrow m => Parser m a b -> Fold m a b

253−toFold (Parser pstep pinitial pextract) = Fold step initial pextract

256+toFold (Parser pstep pinitial pextract) = Fold step initial extract

254257

255258 where

256259

@@ -272,6 +275,15 @@ toFold (Parser pstep pinitial pextract) = Fold step initial pextract

272275 Done n _ -> throwM $ DoneError n

273276 Error err -> throwM $ ErrorError err

274277

278+ extract st = do

279+ r <- pextract st

280+ case r of

281+ Done 0 b -> return b

282+ Partial n _ -> throwM $ PartialError n

283+ Continue n _ -> throwM $ ContinueError n

284+ Done n _ -> throwM $ DoneError n

285+ Error err -> throwM $ ErrorError err

286+

275287-------------------------------------------------------------------------------

276288-- Upgrade folds to parses

277289-------------------------------------------------------------------------------

@@ -282,7 +294,7 @@ toFold (Parser pstep pinitial pextract) = Fold step initial pextract

282294--

283295{-# INLINE fromFold #-}

284296fromFold :: Monad m => Fold m a b -> Parser m a b

285−fromFold (Fold fstep finitial fextract) = Parser step initial fextract

297+fromFold (Fold fstep finitial fextract) = Parser step initial extract

286298

287299 where

288300

@@ -300,13 +312,16 @@ fromFold (Fold fstep finitial fextract) = Parser step initial fextract

300312 FL.Partial s1 -> Partial 0 s1

301313 FL.Done b -> Done 0 b

302314

315+ extract = fmap (Done 0) . fextract

316+

303317-- | Convert Maybe returning folds to error returning parsers.

304318--

305319-- /Pre-release/

306320--

307321{-# INLINE fromFoldMaybe #-}

308−fromFoldMaybe :: MonadThrow m => String -> Fold m a (Maybe b) -> Parser m a b

309−fromFoldMaybe errMsg (Fold fstep finitial fextract) = Parser step initial extract

322+fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser m a b

323+fromFoldMaybe errMsg (Fold fstep finitial fextract) =

324+ Parser step initial extract

310325

311326 where

312327

@@ -333,8 +348,8 @@ fromFoldMaybe errMsg (Fold fstep finitial fextract) = Parser step initial extrac

333348 extract s = do

334349 res <- fextract s

335350 case res of

336− Just x -> return x

337− Nothing -> throwM $ ParseError errMsg

351+ Just x -> return $ Done 0 x

352+ Nothing -> return $ Error errMsg

338353

339354-------------------------------------------------------------------------------

340355-- Failing Parsers

@@ -345,7 +360,7 @@ fromFoldMaybe errMsg (Fold fstep finitial fextract) = Parser step initial extrac

345360-- /Pre-release/

346361--

347362{-# INLINE peek #-}

348−peek :: MonadThrow m => Parser m a a

363+peek :: Monad m => Parser m a a

349364peek = Parser step initial extract

350365

351366 where

@@ -354,7 +369,7 @@ peek = Parser step initial extract

354369

355370 step () a = return $ Done 1 a

356371

357− extract () = throwM $ ParseError "peek: end of input"

372+ extract () = return $ Error "peek: end of input"

358373

359374-- | See 'Streamly.Internal.Data.Parser.eof'.

360375--

@@ -362,7 +377,7 @@ peek = Parser step initial extract

362377--

363378{-# INLINE eof #-}

364379eof :: Monad m => Parser m a ()

365−eof = Parser step initial return

380+eof = Parser step initial extract

366381

367382 where

368383

@@ -370,6 +385,8 @@ eof = Parser step initial return

370385

371386 step () _ = return $ Error "eof: not at end of input"

372387

388+ extract () = return $ Done 0 ()

389+

373390-- | See 'Streamly.Internal.Data.Parser.next'.

374391--

375392-- /Pre-release/

@@ -377,10 +394,14 @@ eof = Parser step initial return

377394{-# INLINE next #-}

378395next :: Monad m => Parser m a (Maybe a)

379396next = Parser step initial extract

397+

380398 where

399+

381400 initial = pure $ IPartial ()

382− step _ a = pure $ Done 0 (Just a)

383− extract _ = pure Nothing

401+

402+ step () a = pure $ Done 0 (Just a)

403+

404+ extract () = pure $ Done 0 Nothing

384405

385406-- | See 'Streamly.Internal.Data.Parser.either'.

386407--

@@ -399,7 +420,7 @@ either f = Parser step initial extract

399420 Right b -> Done 0 b

400421 Left err -> Error err

401422

402− extract _ = throwM $ ParseError "end of input"

423+ extract () = return $ Error "end of input"

403424

404425-- | See 'Streamly.Internal.Data.Parser.maybe'.

405426--

@@ -422,7 +443,7 @@ maybe parserF = Parser step initial extract

422443 Just b -> Done 0 b

423444 Nothing -> Error "maybe: predicate failed"

424445

425− extract _ = throwM $ ParseError "maybe: end of input"

446+ extract () = return $ Error "maybe: end of input"

426447

427448-- | See 'Streamly.Internal.Data.Parser.satisfy'.

428449--

@@ -445,7 +466,7 @@ satisfy predicate = Parser step initial extract

445466 then Done 0 a

446467 else Error "satisfy: predicate failed"

447468

448− extract _ = throwM $ ParseError "satisfy: end of input"

469+ extract () = return $ Error "satisfy: end of input"

449470

450471-------------------------------------------------------------------------------

451472-- Taking elements

@@ -460,7 +481,7 @@ data Tuple'Fused a b = Tuple'Fused !a !b deriving Show

460481-- /Pre-release/

461482--

462483{-# INLINE takeBetween #-}

463−takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b

484+takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser m a b

464485takeBetween low high (Fold fstep finitial fextract) =

465486

466487 Parser step initial (extract streamErr)

@@ -492,7 +513,7 @@ takeBetween low high (Fold fstep finitial fextract) =

492513 if i1 < high

493514 -- XXX ideally this should be a Continue instead

494515 then return $ IPartial s1

495− else IDone <$> extract foldErr s1

516+ else iextract foldErr s1

496517 FL.Done b ->

497518 return

498519 $ if i1 >= low

@@ -501,7 +522,7 @@ takeBetween low high (Fold fstep finitial fextract) =

501522

502523 initial = do

503524 when (low >= 0 && high >= 0 && low > high)

504− $ throwM $ ParseError invalidRange

525+ $ error invalidRange

505526

506527 finitial >>= inext (-1)

507528

@@ -514,7 +535,7 @@ takeBetween low high (Fold fstep finitial fextract) =

514535 let s1 = Tuple'Fused i1 s

515536 if i1 < high

516537 then return $ Continue 0 s1

517− else Done 0 <$> extract foldErr s1

538+ else extract foldErr s1

518539 FL.Done b ->

519540 return

520541 $ if i1 >= low

@@ -524,15 +545,20 @@ takeBetween low high (Fold fstep finitial fextract) =

524545 step (Tuple'Fused i s) a = fstep s a >>= snext i

525546

526547 extract f (Tuple'Fused i s)

527− | i >= low && i <= high = fextract s

528− | otherwise = throwM $ ParseError (f i)

548+ | i >= low && i <= high = fmap (Done 0) (fextract s)

549+ | otherwise = return $ Error (f i)

550+

551+ -- XXX Need to make Initial return type Step to deduplicate this

552+ iextract f (Tuple'Fused i s)

553+ | i >= low && i <= high = fmap IDone (fextract s)

554+ | otherwise = return $ IError (f i)

529555

530556-- | See 'Streamly.Internal.Data.Parser.takeEQ'.

531557--

532558-- /Pre-release/

533559--

534560{-# INLINE takeEQ #-}

535−takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b

561+takeEQ :: Monad m => Int -> Fold m a b -> Parser m a b

536562takeEQ n (Fold fstep finitial fextract) = Parser step initial extract

537563

538564 where

@@ -576,10 +602,10 @@ takeEQ n (Fold fstep finitial fextract) = Parser step initial extract

576602 i1 = i + 1

577603

578604 extract (Tuple' i r)

579− | i == 0 && cnt == 0 = fextract r

605+ | i == 0 && cnt == 0 = fmap (Done 0) $ fextract r

580606 | otherwise =

581− throwM

582− $ ParseError

607+ return

608+ $ Error

583609 $ "takeEQ: Expecting exactly " ++ show cnt

584610 ++ " elements, input terminated on " ++ show i

585611

@@ -588,12 +614,13 @@ takeEQ n (Fold fstep finitial fextract) = Parser step initial extract

588614-- /Pre-release/

589615--

590616{-# INLINE takeGE #-}

591−takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b

617+takeGE :: Monad m => Int -> Fold m a b -> Parser m a b

592618takeGE n (Fold fstep finitial fextract) = Parser step initial extract

593619

594620 where

595621

596622 cnt = max n 0

623+

597624 initial = do

598625 res <- finitial

599626 return $ case res of

@@ -628,10 +655,10 @@ takeGE n (Fold fstep finitial fextract) = Parser step initial extract

628655 i1 = i + 1

629656

630657 extract (Tuple' i r)

631− | i >= cnt = fextract r

658+ | i >= cnt = fmap (Done 0) $ fextract r

632659 | otherwise =

633− throwM

634− $ ParseError

660+ return

661+ $ Error

635662 $ "takeGE: Expecting at least " ++ show cnt

636663 ++ " elements, input terminated on " ++ show i

637664

@@ -653,7 +680,14 @@ takeWhileP predicate (Parser pstep pinitial pextract) =

653680 step s a =

654681 if predicate a

655682 then pstep s a

656− else Done 1 <$> pextract s

683+ else do

684+ r <- pextract s

685+ -- XXX need a map on count

686+ case r of

687+ Error err -> return $ Error err

688+ Done n s1 -> return $ Done (n + 1) s1

689+ Partial _ _ -> error "Bug: takeWhileP: Partial in extract"

690+ Continue n s1 -> return $ Continue (n + 1) s1

657691

658692-- | See 'Streamly.Internal.Data.Parser.takeWhile'.

659693--

@@ -662,7 +696,7 @@ takeWhileP predicate (Parser pstep pinitial pextract) =

662696{-# INLINE takeWhile #-}

663697takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b

664698takeWhile predicate (Fold fstep finitial fextract) =

665− Parser step initial fextract

699+ Parser step initial extract

666700

667701 where

668702

@@ -682,12 +716,14 @@ takeWhile predicate (Fold fstep finitial fextract) =

682716 FL.Done b -> Done 0 b

683717 else Done 1 <$> fextract s

684718

719+ extract s = fmap (Done 0) (fextract s)

720+

685721-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.

686722--

687723-- /Pre-release/

688724--

689725{-# INLINE takeWhile1 #-}

690−takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b

726+takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b

691727takeWhile1 predicate (Fold fstep finitial fextract) =

692728 Parser step initial extract

693729

@@ -721,15 +757,18 @@ takeWhile1 predicate (Fold fstep finitial fextract) =

721757 b <- fextract s

722758 return $ Done 1 b

723759

724− extract (Left' _) = throwM $ ParseError "takeWhile1: end of input"

725− extract (Right' s) = fextract s

760+ extract (Left' _) = return $ Error "takeWhile1: end of input"

761+ extract (Right' s) = fmap (Done 0) (fextract s)

726762

727763-------------------------------------------------------------------------------

728764-- Separators

729765-------------------------------------------------------------------------------

730766

767+data FramedEscState s =

768+ FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int

769+

731770{-# INLINE takeFramedByGeneric #-}

732−takeFramedByGeneric :: MonadThrow m =>

771+takeFramedByGeneric :: Monad m =>

733772 Maybe (a -> Bool)

734773 -> Maybe (a -> Bool)

735774 -> Maybe (a -> Bool)

@@ -812,7 +851,7 @@ takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =

812851 step (FrameEscGo s n) a = processCheckEsc s a n

813852 step (FrameEscEsc s n) a = process s a n

814853

815− err = throwM . ParseError

854+ err = return . Error

816855

817856 extract (FrameEscInit _) =

818857 err "takeFramedByGeneric: empty token"

@@ -820,7 +859,7 @@ takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =

820859 case begin of

821860 Just _ ->

822861 case end of

823− Nothing -> fextract s

862+ Nothing -> fmap (Done 0) $ fextract s

824863 Just _ -> err "takeFramedByGeneric: missing frame end"

825864 Nothing -> err "takeFramedByGeneric: missing closing frame"

826865 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"

@@ -830,7 +869,7 @@ takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =

830869-- /Pre-release/

831870--

832871{-# INLINE takeEndBy #-}

833−takeEndBy :: MonadCatch m => (a -> Bool) -> Parser m a b -> Parser m a b

872+takeEndBy :: Monad m => (a -> Bool) -> Parser m a b -> Parser m a b

834873takeEndBy cond (Parser pstep pinitial pextract) =

835874

836875 Parser step initial pextract

@@ -850,7 +889,7 @@ takeEndBy cond (Parser pstep pinitial pextract) =

850889-- /Pre-release/

851890--

852891{-# INLINE takeEndByEsc #-}

853−takeEndByEsc :: MonadCatch m =>

892+takeEndByEsc :: Monad m =>

854893 (a -> Bool) -> (a -> Bool) -> Parser m a b -> Parser m a b

855894takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =

856895

@@ -866,37 +905,32 @@ takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =

866905 else do

867906 res <- pstep s a

868907 if not (isSep a)

869− then return $ mapStateStep Left' res

870− else extractStep pextract res

908+ then return $ first Left' res

909+ else fmap (first Left') $ extractStep pextract res

871910

872911 step (Right' s) a = do

873912 res <- pstep s a

874− return $ mapStateStep Left' res

913+ return $ first Left' res

875914

876− extract (Left' s) = pextract s

915+ extract (Left' s) = fmap (first Left') $ pextract s

877916 extract (Right' _) =

878− throwM $ ParseError "takeEndByEsc: trailing escape"

917+ return $ Error "takeEndByEsc: trailing escape"

879918

880919-- | See 'Streamly.Internal.Data.Parser.takeEndBy_'.

881920--

882921-- /Pre-release/

883922--

884923{-# INLINE takeEndBy_ #-}

885−takeEndBy_ :: MonadCatch m =>

886− (a -> Bool) -> Parser m a b -> Parser m a b

924+takeEndBy_ :: (a -> Bool) -> Parser m a b -> Parser m a b

887925takeEndBy_ cond (Parser pstep pinitial pextract) =

888926

889− Parser step initial pextract

927+ Parser step pinitial pextract

890928

891929 where

892930

893− initial = pinitial

894−

895931 step s a =

896932 if cond a

897− then do

898− res <- pextract s

899− return $ Done 0 res

933+ then pextract s

900934 else pstep s a

901935

902936-- | See 'Streamly.Internal.Data.Parser.takeStartBy'.

@@ -936,14 +970,11 @@ takeStartBy cond (Fold fstep finitial fextract) =

936970 then process s a

937971 else Done 1 <$> fextract s

938972

939− extract (Left' s) = fextract s

940− extract (Right' s) = fextract s

941−

942−data FramedEscState s =

943− FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int

973+ extract (Left' s) = fmap (Done 0) $ fextract s

974+ extract (Right' s) = fmap (Done 0) $ fextract s

944975

945976{-# INLINE takeFramedByEsc_ #-}

946−takeFramedByEsc_ :: MonadThrow m =>

977+takeFramedByEsc_ :: Monad m =>

947978 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b

948979takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =

949980

@@ -985,7 +1016,7 @@ takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =

9851016 else process s a (n - 1)

9861017 step (FrameEscEsc s n) a = process s a n

9871018

988− err = throwM . ParseError

1019+ err = return . Error

9891020

9901021 extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"

9911022 extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"

@@ -994,7 +1025,7 @@ takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =

9941025data FramedState s = FrameInit !s | FrameGo !s Int

9951026

9961027{-# INLINE takeFramedBy_ #-}

997−takeFramedBy_ :: MonadThrow m =>

1028+takeFramedBy_ :: Monad m =>

9981029 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b

9991030takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =

10001031

@@ -1029,7 +1060,7 @@ takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =

10291060 | n == 0 = Done 0 <$> fextract s

10301061 | otherwise = process s a (n - 1)

10311062

1032− err = throwM . ParseError

1063+ err = return . Error

10331064

10341065 extract (FrameInit _) = err "takeFramedBy_: empty token"

10351066 extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"

@@ -1080,9 +1111,9 @@ wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract

10801111 then Done 1 b

10811112 else Partial 0 $ WBRight b

10821113

1083− extract (WBLeft s) = fextract s

1084− extract (WBWord s) = fextract s

1085− extract (WBRight b) = return b

1114+ extract (WBLeft s) = fmap (Done 0) $ fextract s

1115+ extract (WBWord s) = fmap (Done 0) $ fextract s

1116+ extract (WBRight b) = return (Done 0 b)

10861117

10871118data WordFramedState s b =

10881119 WordFramedSkipPre !s

@@ -1093,7 +1124,7 @@ data WordFramedState s b =

10931124-- | See 'Streamly.Internal.Data.Parser.wordFramedBy'

10941125--

10951126{-# INLINE wordFramedBy #-}

1096−wordFramedBy :: MonadCatch m =>

1127+wordFramedBy :: Monad m =>

10971128 (a -> Bool) -- ^ Escape

10981129 -> (a -> Bool) -- ^ left quote

10991130 -> (a -> Bool) -- ^ right quote

@@ -1163,16 +1194,16 @@ wordFramedBy isEsc isBegin isEnd isSep

11631194 then Done 1 b

11641195 else Partial 0 $ WordFramedSkipPost b

11651196

1166− err = throwM . ParseError

1197+ err = return . Error

11671198

1168− extract (WordFramedSkipPre s) = fextract s

1199+ extract (WordFramedSkipPre s) = fmap (Done 0) $ fextract s

11691200 extract (WordFramedWord s n) =

11701201 if n == 0

1171− then fextract s

1202+ then fmap (Done 0) $ fextract s

11721203 else err "wordFramedBy: missing frame end"

11731204 extract (WordFramedEsc _ _) =

11741205 err "wordFramedBy: trailing escape"

1175− extract (WordFramedSkipPost b) = return b

1206+ extract (WordFramedSkipPost b) = return (Done 0 b)

11761207

11771208data WordQuotedState s b a =

11781209 WordQuotedSkipPre !s

@@ -1183,7 +1214,7 @@ data WordQuotedState s b a =

11831214 | WordQuotedSkipPost !b

11841215

11851216{-# INLINE wordQuotedBy #-}

1186−wordQuotedBy :: (MonadCatch m, Eq a) =>

1217+wordQuotedBy :: (Monad m, Eq a) =>

11871218 Bool -- ^ keep the quotes in the output

11881219 -> (a -> Bool) -- ^ Escape

11891220 -> (a -> Bool) -- ^ left quote

@@ -1270,19 +1301,19 @@ wordQuotedBy keepQuotes isEsc isBegin isEnd toRight isSep

12701301 then Done 1 b

12711302 else Partial 0 $ WordQuotedSkipPost b

12721303

1273− err = throwM . ParseError

1304+ err = return . Error

12741305

1275− extract (WordQuotedSkipPre s) = fextract s

1276− extract (WordUnquotedWord s) = fextract s

1306+ extract (WordQuotedSkipPre s) = fmap (Done 0) $ fextract s

1307+ extract (WordUnquotedWord s) = fmap (Done 0) $ fextract s

12771308 extract (WordQuotedWord s n _) =

12781309 if n == 0

1279− then fextract s

1310+ then fmap (Done 0) $ fextract s

12801311 else err "wordQuotedBy: missing frame end"

12811312 extract WordQuotedEsc {} =

12821313 err "wordQuotedBy: trailing escape"

12831314 extract (WordUnquotedEsc _) =

12841315 err "wordQuotedBy: trailing escape"

1285− extract (WordQuotedSkipPost b) = return b

1316+ extract (WordQuotedSkipPost b) = return (Done 0 b)

12861317

12871318{-# ANN type GroupByState Fuse #-}

12881319data GroupByState a s

@@ -1318,8 +1349,8 @@ groupBy eq (Fold fstep finitial fextract) = Parser step initial extract

13181349 then grouper s a0 a

13191350 else Done 1 <$> fextract s

13201351

1321− extract (GroupByInit s) = fextract s

1322− extract (GroupByGrouping _ s) = fextract s

1352+ extract (GroupByInit s) = fmap (Done 0) $ fextract s

1353+ extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s

13231354

13241355-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.

13251356--

@@ -1350,8 +1381,8 @@ groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract

13501381 then grouper s a

13511382 else Done 1 <$> fextract s

13521383

1353− extract (GroupByInit s) = fextract s

1354− extract (GroupByGrouping _ s) = fextract s

1384+ extract (GroupByInit s) = fmap (Done 0) $ fextract s

1385+ extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s

13551386

13561387{-# ANN type GroupByStatePair Fuse #-}

13571388data GroupByStatePair a s1 s2

@@ -1361,7 +1392,7 @@ data GroupByStatePair a s1 s2

13611392 | GroupByGroupingPairR !a !s1 !s2

13621393

13631394{-# INLINE groupByRollingEither #-}

1364−groupByRollingEither :: MonadCatch m =>

1395+groupByRollingEither :: Monad m =>

13651396 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)

13661397groupByRollingEither

13671398 eq

@@ -1432,14 +1463,14 @@ groupByRollingEither

14321463 then grouperR2 s1 s2 a

14331464 else Done 1 . Right <$> fextract2 s2

14341465

1435− extract (GroupByInitPair s1 _) = Left <$> fextract1 s1

1436− extract (GroupByGroupingPairL _ s1 _) = Left <$> fextract1 s1

1437− extract (GroupByGroupingPairR _ _ s2) = Right <$> fextract2 s2

1466+ extract (GroupByInitPair s1 _) = Done 0 . Left <$> fextract1 s1

1467+ extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> fextract1 s1

1468+ extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> fextract2 s2

14381469 extract (GroupByGroupingPair a s1 _) = do

14391470 res <- fstep1 s1 a

14401471 case res of

1441− FL.Done b -> return $ Left b

1442− FL.Partial s11 -> Left <$> fextract1 s11

1472+ FL.Done b -> return $ Done 0 (Left b)

1473+ FL.Partial s11 -> Done 0 . Left <$> fextract1 s11

14431474

14441475-- XXX use an Unfold instead of a list?

14451476-- XXX custom combinators for matching list, array and stream?

@@ -1450,7 +1481,7 @@ groupByRollingEither

14501481-- /Pre-release/

14511482--

14521483{-# INLINE eqBy #-}

1453−eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()

1484+eqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser m a ()

14541485eqBy cmp str = Parser step initial extract

14551486

14561487 where

@@ -1473,15 +1504,15 @@ eqBy cmp str = Parser step initial extract

14731504 ++ show (length xs + 1) ++ " elements"

14741505

14751506 extract xs =

1476− throwM

1477− $ ParseError

1507+ return

1508+ $ Error

14781509 $ "eqBy: end of input, yet to match "

14791510 ++ show (length xs) ++ " elements"

14801511

14811512-- XXX rename to streamBy?

14821513-- | Like eqBy but uses a stream instead of a list

14831514{-# INLINE matchBy #-}

1484−matchBy :: MonadThrow m => (a -> a -> Bool) -> D.Stream m a -> Parser m a ()

1515+matchBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser m a ()

14851516matchBy cmp (D.Stream sstep state) = Parser step initial extract

14861517

14871518 where

@@ -1515,7 +1546,7 @@ matchBy cmp (D.Stream sstep state) = Parser step initial extract

15151546 D.Stop -> Done 1 ()

15161547 D.Skip s -> Continue 1 (Nothing', s)

15171548

1518− extract _ = throwM $ ParseError "match: end of input"

1549+ extract _ = return $ Error "match: end of input"

15191550

15201551-------------------------------------------------------------------------------

15211552-- Transformations on input

@@ -1585,7 +1616,7 @@ zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =

15851616 return $ Done 1 x

15861617 D.Skip s -> return $ Continue 1 (Nothing', s, fs)

15871618

1588− extract _ = throwM $ ParseError "zipWithM: end of input"

1619+ extract _ = return $ Error "zipWithM: end of input"

15891620

15901621-- | Zip the input of a fold with a stream.

15911622--

@@ -1701,7 +1732,7 @@ takeP lim (Parser pstep pinitial pextract) = Parser step initial extract

17011732 IPartial s ->

17021733 if lim > 0

17031734 then return $ IPartial $ Tuple' 0 s

1704− else IDone <$> pextract s

1735+ else iextract s

17051736 IDone b -> return $ IDone b

17061737 IError e -> return $ IError e

17071738

@@ -1714,23 +1745,25 @@ takeP lim (Parser pstep pinitial pextract) = Parser step initial extract

17141745 assertM(cnt1 >= 0)

17151746 if cnt1 < lim

17161747 then return $ Partial 0 $ Tuple' cnt1 s

1717− else Done 0 <$> pextract s

1748+ else do

1749+ r1 <- pextract s

1750+ return $ case r1 of

1751+ Done n b -> Done n b

1752+ Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)

1753+ Error err -> Error err

1754+ Partial _ _ -> error "takeP: Partial in extract"

1755+

17181756 Continue 0 s -> do

17191757 assertM(cnt1 >= 0)

17201758 if cnt1 < lim

17211759 then return $ Continue 0 $ Tuple' cnt1 s

1722− -- XXX This should error out?

1723− -- If designed properly, this will probably error out.

1724− -- "pextract" should error out

1725− --

1726− -- By Harendra,

1727− --

1728− -- This is a tricky case, we have the following options:

1729− -- 1. Done 0 with extract as you have written

1730− -- 2. Done n, will require buffering elements

1731− -- 3. Use a backtracking fold and not a parser, once we have

1732− -- backtracking in folds

1733− else Done 0 <$> pextract s

1760+ else do

1761+ r1 <- pextract s

1762+ return $ case r1 of

1763+ Done n b -> Done n b

1764+ Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)

1765+ Error err -> Error err

1766+ Partial _ _ -> error "takeP: Partial in extract"

17341767 Partial n s -> do

17351768 let taken = cnt1 - n

17361769 assertM(taken >= 0)

@@ -1742,14 +1775,28 @@ takeP lim (Parser pstep pinitial pextract) = Parser step initial extract

17421775 Done n b -> return $ Done n b

17431776 Error str -> return $ Error str

17441777

1745− extract (Tuple' _ r) = pextract r

1778+ extract (Tuple' cnt r) = do

1779+ r1 <- pextract r

1780+ return $ case r1 of

1781+ Done n b -> Done n b

1782+ Continue n s1 -> Continue n (Tuple' (cnt - n) s1)

1783+ Error err -> Error err

1784+ Partial _ _ -> error "takeP: Partial in extract"

1785+

1786+ -- XXX Need to make the Initial type Step to remove this

1787+ iextract s = do

1788+ r <- pextract s

1789+ return $ case r of

1790+ Done _ b -> IDone b

1791+ Error err -> IError err

1792+ _ -> error "Bug: takeP invalid state in initial"

17461793

17471794-- | See 'Streamly.Internal.Data.Parser.lookahead'.

17481795--

17491796-- /Pre-release/

17501797--

17511798{-# INLINE lookAhead #-}

1752−lookAhead :: MonadThrow m => Parser m a b -> Parser m a b

1799+lookAhead :: Monad m => Parser m a b -> Parser m a b

17531800lookAhead (Parser step1 initial1 _) = Parser step initial extract

17541801

17551802 where

@@ -1775,8 +1822,8 @@ lookAhead (Parser step1 initial1 _) = Parser step initial extract

17751822 -- that it terminates on eof without an error then we need a way to

17761823 -- backtrack on eof, that will require extract to return 'Step' type.

17771824 extract (Tuple' n _) =

1778− throwM

1779− $ ParseError

1825+ return

1826+ $ Error

17801827 $ "lookAhead: end of input after consuming "

17811828 ++ show n ++ " elements"

17821829

@@ -1859,18 +1906,29 @@ deintercalate

18591906 else error "deintercalate: infinite loop"

18601907 Error err -> return $ Error err

18611908

1909+ {-# INLINE processResult #-}

1910+ processResult n fs r = do

1911+ res <- fstep fs r

1912+ case res of

1913+ FL.Partial fs1 -> fmap (Done n) $ fextract fs1

1914+ FL.Done c -> return (Done n c)

1915+

18621916 extract (DeintercalateL fs sL) = do

18631917 r <- extractL sL

1864− res <- fstep fs (Left r)

1865− case res of

1866− FL.Partial fs1 -> fextract fs1

1867− FL.Done c -> return c

1868− extract (DeintercalateR fs sR _) = do

1918+ case r of

1919+ Done n b -> processResult n fs (Left b)

1920+ Error err -> return $ Error err

1921+ Continue n s -> return $ Continue n (DeintercalateL fs s)

1922+ Partial _ _ -> error "Partial in extract"

1923+

1924+ extract (DeintercalateR fs sR consumed) = do

18691925 r <- extractR sR

1870− res <- fstep fs (Right r)

1871− case res of

1872− FL.Partial fs1 -> fextract fs1

1873− FL.Done c -> return c

1926+ case r of

1927+ Done n b -> processResult n fs (Right b)

1928+ Error err -> return $ Error err

1929+ -- XXX Review consumed

1930+ Continue n s -> return $ Continue n (DeintercalateR fs s consumed)

1931+ Partial _ _ -> error "Partial in extract"

18741932

18751933data SepByState fs sp ss =

18761934 SepByInit !fs !sp

@@ -1879,7 +1937,7 @@ data SepByState fs sp ss =

18791937-- This is a special case of deintercalate and can be easily implemented in

18801938-- terms of deintercalate.

18811939{-# INLINE sepBy #-}

1882−sepBy :: MonadCatch m =>

1940+sepBy :: Monad m =>

18831941 Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c

18841942sepBy

18851943 (Fold fstep finitial fextract)

@@ -1938,11 +1996,17 @@ sepBy

19381996

19391997 extract (SepByInit fs sp) = do

19401998 r <- pextract sp

1941− res <- fstep fs r

1942− case res of

1943− FL.Partial fs1 -> fextract fs1

1944− FL.Done c -> return c

1945− extract (SepBySeparator fs _ _) = fextract fs

1999+ case r of

2000+ Done n b -> do

2001+ res <- fstep fs b

2002+ case res of

2003+ FL.Partial fs1 -> fmap (Done n) $ fextract fs1

2004+ FL.Done c -> return (Done n c)

2005+ Error err -> return $ Error err

2006+ Continue n s -> return $ Continue n (SepByInit fs s)

2007+ Partial _ _ -> error "Partial in extract"

2008+

2009+ extract (SepBySeparator fs _ _) = fmap (Done 0) $ fextract fs

19462010

19472011-------------------------------------------------------------------------------

19482012-- Sequential Collection

@@ -1950,7 +2014,7 @@ sepBy

19502014--

19512015-- | See 'Streamly.Internal.Data.Parser.sequence'.

19522016{-# INLINE sequence #-}

1953−sequence :: MonadThrow m =>

2017+sequence :: Monad m =>

19542018 Fold m b c -> D.Stream m (Parser m a b) -> Parser m a c

19552019sequence (Fold fstep finitial fextract) (D.Stream sstep sstate) =

19562020 Parser step initial extract

@@ -2006,27 +2070,33 @@ sequence (Fold fstep finitial fextract) (D.Stream sstep sstate) =

20062070 FL.Done c -> return $ Done 1 c

20072071 IError err -> return $ Error err

20082072

2009− extract (Nothing', _, fs) = fextract fs

2010− extract (Just' (Parser _ pinit pextr), _, fs) = do

2073+ extract (Nothing', _, fs) = fmap (Done 0) $ fextract fs

2074+ extract (Just' (Parser pstep pinit pextr), ss, fs) = do

20112075 ps <- pinit

20122076 case ps of

20132077 IPartial ps1 -> do

2014− b <- pextr ps1

2015− fres <- fstep fs b

2016− case fres of

2017− FL.Partial fs1 -> fextract fs1

2018− FL.Done c -> return c

2078+ r <- pextr ps1

2079+ case r of

2080+ Done n b -> do

2081+ res <- fstep fs b

2082+ case res of

2083+ FL.Partial fs1 -> fmap (Done n) $ fextract fs1

2084+ FL.Done c -> return (Done n c)

2085+ Error err -> return $ Error err

2086+ Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)

2087+ Partial _ _ -> error "Partial in extract"

20192088 IDone b -> do

20202089 fres <- fstep fs b

20212090 case fres of

2022− FL.Partial fs1 -> fextract fs1

2023− FL.Done c -> return c

2024− IError err -> throwM $ ParseError err

2091+ FL.Partial fs1 -> fmap (Done 0) $ fextract fs1

2092+ FL.Done c -> return (Done 0 c)

2093+ IError err -> return $ Error err

20252094

20262095-------------------------------------------------------------------------------

20272096-- Alternative Collection

20282097-------------------------------------------------------------------------------

20292098

2099+{-

20302100-- | See 'Streamly.Internal.Data.Parser.choice'.

20312101--

20322102-- /Broken/

@@ -2034,6 +2104,7 @@ sequence (Fold fstep finitial fextract) (D.Stream sstep sstate) =

20342104{-# INLINE choice #-}

20352105choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b

20362106choice = foldl1 shortest

2107+-}

20372108

20382109-------------------------------------------------------------------------------

20392110-- Sequential Repetition

@@ -2049,7 +2120,7 @@ manyP _p _f = undefined

20492120-- /Pre-release/

20502121--

20512122{-# INLINE many #-}

2052−many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c

2123+many :: Monad m => Parser m a b -> Fold m b c -> Parser m a c

20532124many = splitMany

20542125-- many = countBetween 0 maxBound

20552126

@@ -2058,7 +2129,7 @@ many = splitMany

20582129-- /Pre-release/

20592130--

20602131{-# INLINE some #-}

2061−some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c

2132+some :: Monad m => Parser m a b -> Fold m b c -> Parser m a c

20622133some = splitSome

20632134-- some p f = manyP p (takeGE 1 f)

20642135-- some = countBetween 1 maxBound

@@ -2168,9 +2239,17 @@ manyTill (Fold fstep finitial fextract)

21682239 FL.Done b1 -> return $ Done n b1

21692240 Error err -> return $ Error err

21702241

2171− extract (ManyTillL _ fs sR) = do

2172− res <- extractL sR >>= fstep fs

2242+ extract (ManyTillL cnt fs sR) = do

2243+ res <- extractL sR

21732244 case res of

2174− FL.Partial s -> fextract s

2175− FL.Done b -> return b

2176− extract (ManyTillR _ fs _) = fextract fs

2245+ Done n b -> do

2246+ r <- fstep fs b

2247+ case r of

2248+ FL.Partial fs1 -> fmap (Done n) $ fextract fs1

2249+ FL.Done c -> return (Done n c)

2250+ Error err -> return $ Error err

2251+ Continue n s -> do

2252+ assertM(n == cnt)

2253+ return $ Continue n (ManyTillL 0 fs s)

2254+ Partial _ _ -> error "Partial in extract"

2255+ extract (ManyTillR _ fs _) = fmap (Done 0) $ fextract fs

core/src/Streamly/Internal/Data/Parser/ParserD/Tee.hs+4

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

2626

2727module Streamly.Internal.Data.Parser.ParserD.Tee

2828 (

29+ {-

2930 -- Parallel zipped

3031 teeWith

3132 , teeWithFst

@@ -34,9 +35,11 @@ module Streamly.Internal.Data.Parser.ParserD.Tee

3435 -- Parallel alternatives

3536 , shortest

3637 , longest

38+ -}

3739 )

3840where

3941

42+{-

4043import Control.Exception (assert)

4144import Control.Monad.Catch (MonadCatch, try)

4245import Prelude

@@ -611,3 +614,4 @@ longest (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

611614 Right b -> return b

612615 TeePair (_, StepResult _, _, _) (_, StepResult _, _, _) ->

613616 error "unreachable"

617+-}

core/src/Streamly/Internal/Data/Parser/ParserD/Type.hs+321−237

@@ -169,8 +169,8 @@ module Streamly.Internal.Data.Parser.ParserD.Type

169169 -- * Types

170170 Initial (..)

171171 , Step (..)

172− , mapStateStep

173172 , extractStep

173+ , bimapOverrideCount

174174 , Parser (..)

175175 , ParseError (..)

176176 , rmapM

@@ -180,8 +180,6 @@ module Streamly.Internal.Data.Parser.ParserD.Type

180180 , toParserK

181181

182182 -- * Constructors

183− , parser

184− , parserM

185183

186184 , fromPure

187185 , fromEffect

@@ -201,8 +199,8 @@ module Streamly.Internal.Data.Parser.ParserD.Type

201199 , lmapM

202200 , filter

203201

204− , noErrorUnsafeSplit_

205202 , noErrorUnsafeSplitWith

203+ , noErrorUnsafeSplit_

206204 , noErrorUnsafeConcatMap

207205 )

208206where

@@ -215,7 +213,6 @@ import Control.Monad (MonadPlus(..), (>=>))

215213import Control.Monad.IO.Class (MonadIO, liftIO)

216214import Control.Monad.Reader.Class (MonadReader, ask, local)

217215import Control.Monad.State.Class (MonadState, get, put)

218−import Control.Monad.Catch (MonadCatch, try, throwM, MonadThrow)

219216import Data.Bifunctor (Bifunctor(..))

220217import Fusion.Plugin.Types (Fuse(..))

221218import Streamly.Internal.Data.Fold.Type (Fold(..), toList)

@@ -230,6 +227,7 @@ import Prelude hiding (concatMap, filter)

230227-- >>> :m

231228-- >>> :set -package streamly

232229-- >>> import Control.Applicative ((<|>))

230+-- >>> import Data.Bifunctor (second)

233231-- >>> import Prelude hiding (concatMap)

234232-- >>> import qualified Streamly.Prelude as Stream

235233-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream (parse)

@@ -269,21 +267,9 @@ instance Bifunctor Initial where

269267 bimap _ g (IDone b) = IDone (g b)

270268 bimap _ _ (IError err) = IError err

271269

272− {-# INLINE first #-}

273− first f (IPartial a) = IPartial (f a)

274− first _ (IDone x) = IDone x

275− first _ (IError err) = IError err

276−

277− {-# INLINE second #-}

278− second _ (IPartial x) = IPartial x

279− second f (IDone a) = IDone (f a)

280− second _ (IError err) = IError err

281−

282270-- | Maps a function over the result held by 'IDone'.

283271--

284−-- @

285−-- fmap = 'second'

286−-- @

272+-- >>> fmap = second

287273--

288274-- /Internal/

289275--

@@ -297,7 +283,7 @@ instance Functor (Initial s) where

297283-- Done Int (Either String b)

298284--

299285-- In this case Error may also have a "leftover" return. This means that after

300−-- serveral successful partial results the last segment parsing failed and we

286+-- several successful partial results the last segment parsing failed and we

301287-- are returning the leftover of that. The driver may choose to restart from

302288-- the last segment where this parser failed or from the beginning.

303289--

@@ -335,19 +321,20 @@ instance Functor (Initial s) where

335321{-# ANN type Step Fuse #-}

336322data Step s b =

337323 Partial !Int !s

338− -- ^ @Partial count state@. The following hold:

324+ -- ^ @Partial count state@. The following hold on Partial result:

339325 --

340326 -- 1. @extract@ on @state@ would succeed and give a result.

341− -- 2. Current input stream position is reset to @current position - count@.

342− -- 3. All input before the new current position is dropped. The parser can

327+ -- 2. Input stream position is reset to @current position - count@.

328+ -- 3. All input before the new position is dropped. The parser can

343329 -- never backtrack beyond this position.

344330

345331 | Continue !Int !s

346− -- ^ @Continue count state@. The following hold:

332+ -- ^ @Continue count state@. The following hold on a Continue result:

347333 --

348− -- 1. @extract@ on @state@ would give the last 'Partial' result or throw

349− -- 'ParseError' if there is none.

350− -- 2. Current input stream position is reset to @current position - count@.

334+ -- 1. If there was a 'Partial' result in past, @extract@ on @state@ would

335+ -- give that result as 'Done' otherwise it may return 'Error' or

336+ -- 'Continue'.

337+ -- 2. Input stream position is reset to @current position - count@.

351338 -- 3. the input is retained in a backtrack buffer.

352339

353340 | Done !Int !b

@@ -363,33 +350,50 @@ data Step s b =

363350 -- The parsing operation may backtrack to the beginning and try another

364351 -- alternative.

365352

353+-- | Map first function over the state and second over the result.

354+instance Bifunctor Step where

355+ {-# INLINE bimap #-}

356+ bimap f g step =

357+ case step of

358+ Partial n s -> Partial n (f s)

359+ Continue n s -> Continue n (f s)

360+ Done n b -> Done n (g b)

361+ Error err -> Error err

362+

363+-- | Bimap discarding the count, and using the supplied count instead.

364+bimapOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1

365+bimapOverrideCount n f g step =

366+ case step of

367+ Partial _ s -> Partial n (f s)

368+ Continue _ s -> Continue n (f s)

369+ Done _ b -> Done n (g b)

370+ Error err -> Error err

371+

372+-- | fmap = second

366373instance Functor (Step s) where

367374 {-# INLINE fmap #-}

368− fmap _ (Partial n s) = Partial n s

369− fmap _ (Continue n s) = Continue n s

370− fmap f (Done n b) = Done n (f b)

371− fmap _ (Error err) = Error err

375+ fmap = second

376+

377+{-# INLINE assertStepCount #-}

378+assertStepCount :: Int -> Step s b -> Step s b

379+assertStepCount i step =

380+ case step of

381+ Partial n _ -> assert (i == n) step

382+ Continue n _ -> assert (i == n) step

383+ Done n _ -> assert (i == n) step

384+ Error _ -> step

372385

373386-- | Map an extract function over the state of Step

374387--

375388{-# INLINE extractStep #-}

376−extractStep :: Monad m => (s -> m b) -> Step s b -> m (Step s1 b)

389+extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b)

377390extractStep f res =

378391 case res of

379− Partial n s1 -> Done n <$> f s1

392+ Partial n s1 -> assertStepCount n <$> f s1

380393 Done n b -> return $ Done n b

381− Continue n s1 -> Done n <$> f s1

394+ Continue n s1 -> assertStepCount n <$> f s1

382395 Error err -> return $ Error err

383396

384−{-# INLINE mapStateStep #-}

385−mapStateStep :: (s -> s1) -> Step s b -> Step s1 b

386−mapStateStep f res =

387− case res of

388− Partial n s1 -> Partial n $ f s1

389− Done n b -> Done n b

390− Continue n s1 -> Continue n $ f s1

391− Error err -> Error err

392−

393397-- | Map a monadic function over the result @b@ in @Step s b@.

394398--

395399-- /Internal/

@@ -415,13 +419,18 @@ mapMStep f res =

415419-- /Pre-release/

416420--

417421data Parser m a b =

418− forall s. Parser (s -> a -> m (Step s b)) (m (Initial s b)) (s -> m b)

419−

420−-- | This exception is used for two purposes:

421−--

422−-- * When a parser ultimately fails, the user of the parser is intimated via

423−-- this exception.

424−-- * When the "extract" function of a parser needs to throw an error.

422+ forall s. Parser

423+ (s -> a -> m (Step s b))

424+ -- Initial cannot return "Partial/Done n" or "Continue". Continue 0 is

425+ -- same as Partial 0. In other words it cannot backtrack.

426+ (m (Initial s b))

427+ -- Extract can only return Partial or Continue n. In other words it can

428+ -- only backtrack or return partial result/error. But we do not return

429+ -- result in Partial, therefore, we have to use Done instead of Partial.

430+ (s -> m (Step s b))

431+

432+-- | This exception is used when a parser ultimately fails, the user of the

433+-- parser is intimated via this exception.

425434--

426435-- /Pre-release/

427436--

@@ -434,13 +443,14 @@ instance Exception ParseError where

434443instance Functor m => Functor (Parser m a) where

435444 {-# INLINE fmap #-}

436445 fmap f (Parser step1 initial1 extract) =

437− Parser step initial (fmap2 f extract)

446+ Parser step initial (fmap3 f extract)

438447

439448 where

440449

441450 initial = fmap2 f initial1

442451 step s b = fmap2 f (step1 s b)

443452 fmap2 g = fmap (fmap g)

453+ fmap3 g = fmap2 (fmap g)

444454

445455-------------------------------------------------------------------------------

446456-- Convert direct style 'Parser' to CPS style 'K.Parser'

@@ -457,40 +467,52 @@ instance Functor m => Functor (Parser m a) where

457467--

458468{-# INLINE_NORMAL parseDToK #-}

459469parseDToK

460− :: MonadCatch m

470+ :: Monad m

461471 => (s -> a -> m (Step s b))

462472 -> m (Initial s b)

463− -> (s -> m b)

473+ -> (s -> m (Step s b))

464474 -> Int

465475 -> (Int, Int)

466476 -> ((Int, Int) -> K.Parse b -> m (K.Step m a r))

467477 -> m (K.Step m a r)

468478

479+-- Non 'Alternative' case.

469480parseDToK pstep initial extract leftover (0, _) cont = do

470481 res <- initial

471482 case res of

472483 IPartial r -> return $ K.Continue leftover (parseCont (return r))

473− IDone b -> cont (0,0) (K.Success 0 b)

474− IError err -> cont (0,0) (K.Failure err)

484+ IDone b -> cont state (K.Success 0 b)

485+ IError err -> cont state (K.Failure err)

475486

476487 where

477488

489+ -- The continuation is called with (0,0) state i.e. Alternative level

490+ -- is 0 and the used count is 0. Alternative level is 0 because the level

491+ -- passed in the argument above is 0, the "used" count is 0 because it is

492+ -- not useful when Alternative level is 0. We should probably use a Maybe

493+ -- type for the state but that might impact performance, need to measure.

494+ state = (0,0)

495+

478496 parseCont pst (Just x) = do

479497 r <- pst

480498 pRes <- pstep r x

481499 case pRes of

482− Done n b -> cont (0,0) (K.Success n b)

483− Error err -> cont (0,0) (K.Failure err)

500+ Done n b -> cont state (K.Success n b)

501+ Error err -> cont state (K.Failure err)

484502 Partial n pst1 -> return $ K.Partial n (parseCont (return pst1))

485503 Continue n pst1 -> return $ K.Continue n (parseCont (return pst1))

486504

487505 parseCont acc Nothing = do

488506 pst <- acc

489− r <- try $ extract pst

507+ r <- extract pst

490508 case r of

491− Left (e :: ParseError) -> cont (0,0) (K.Failure (displayException e))

492− Right b -> cont (0,0) (K.Success 0 b)

509+ Done n b -> cont state (K.Success n b)

510+ Error err -> cont state (K.Failure err)

511+ Partial _ _ -> error "Bug: parseDToK Partial unreachable"

512+ Continue n pst1 -> return $ K.Continue n (parseCont (return pst1))

493513

514+-- 'Alternative' case. Used count needs to be maintained when inside an

515+-- Alternative.

494516parseDToK pstep initial extract leftover (level, count) cont = do

495517 res <- initial

496518 case res of

@@ -518,18 +540,25 @@ parseDToK pstep initial extract leftover (level, count) cont = do

518540 return $ K.Continue n (parseCont (cnt1 - n) (return pst1))

519541 parseCont cnt acc Nothing = do

520542 pst <- acc

521− r <- try $ extract pst

543+ r <- extract pst

522544 let s = (level, cnt)

523545 case r of

524− Left (e :: ParseError) -> cont s (K.Failure (displayException e))

525− Right b -> cont s (K.Success 0 b)

546+ Done n b -> do

547+ assertM(n <= cnt)

548+ cont s (K.Success n b)

549+ Partial _ _ -> error "Bug: parseDToK Partial unreachable"

550+ Error e ->

551+ cont s (K.Failure e)

552+ Continue n pst1 -> do

553+ assertM(n <= cnt)

554+ return $ K.Continue n (parseCont (cnt - n) (return pst1))

526555

527556-- | Convert a direct style 'Parser' to a CPS style 'K.Parser'.

528557--

529558-- /Pre-release/

530559--

531560{-# INLINE_LATE toParserK #-}

532−toParserK :: MonadCatch m => Parser m a b -> K.Parser m a b

561+toParserK :: Monad m => Parser m a b -> K.Parser m a b

533562toParserK (Parser step initial extract) =

534563 K.MkParser $ parseDToK step initial extract

535564

@@ -549,14 +578,14 @@ parserDone _ (K.Failure e) = return $ K.Error e

549578--

550579-- /Pre-release/

551580--

552−extractParse :: MonadThrow m => (Maybe a -> m (K.Step m a b)) -> m b

581+extractParse :: Monad m => (Maybe a -> m (K.Step m a b)) -> m (Step s b)

553582extractParse cont = do

554583 r <- cont Nothing

555584 case r of

556− K.Done _ b -> return b

585+ K.Done n b -> return (Done n b)

557586 K.Partial _ _ -> error "Bug: extractParse got Partial"

558587 K.Continue _ cont1 -> extractParse cont1

559− K.Error e -> throwM $ ParseError e

588+ K.Error e -> return $ Error e

560589

561590data FromParserK b c = FPKDone !Int !b | FPKCont c

562591

@@ -568,13 +597,13 @@ data FromParserK b c = FPKDone !Int !b | FPKCont c

568597-- /Pre-release/

569598--

570599{-# INLINE_LATE fromParserK #-}

571−fromParserK :: MonadThrow m => K.Parser m a b -> Parser m a b

572−fromParserK parser0 = Parser step initial extract

600+fromParserK :: Monad m => K.Parser m a b -> Parser m a b

601+fromParserK parser = Parser step initial extract

573602

574603 where

575604

576605 initial = do

577− r <- K.runParser parser0 0 (0,0) parserDone

606+ r <- K.runParser parser 0 (0,0) parserDone

578607 return $ case r of

579608 K.Done n b -> IPartial $ FPKDone n b

580609 K.Error e -> IError e

@@ -596,7 +625,7 @@ fromParserK parser0 = Parser step initial extract

596625 K.Continue n cont1 -> Continue n (FPKCont cont1)

597626

598627 -- Note, we can only reach FPKDone and FPKError from "initial".

599− extract (FPKDone _ b) = return b

628+ extract (FPKDone n b) = return (Done n b)

600629 extract (FPKCont cont) = extractParse cont

601630

602631#ifndef DISABLE_FUSION

@@ -606,30 +635,6 @@ fromParserK parser0 = Parser step initial extract

606635 forall s. fromParserK (toParserK s) = s #-}

607636#endif

608637

609−------------------------------------------------------------------------------

610−-- General parser constructors

611−------------------------------------------------------------------------------

612−

613−-- | Make a parser using a parsing step and a starting value.

614−--

615−-- /Pre-release/

616−--

617−{-# INLINE parser #-}

618−parser :: Monad m => (b -> a -> Step b b) -> Initial b b -> Parser m a b

619−parser step initial =

620− Parser (\s a -> return $ step s a) (return initial) return

621−

622−-- | Like 'parser' but with a monadic step function.

623−--

624−-- >>> parserM step initial = ParserD.Parser step initial return

625−--

626−-- /Pre-release/

627−--

628−{-# INLINE parserM #-}

629−parserM ::

630− Monad m => (b -> a -> m (Step b b)) -> m (Initial b b) -> Parser m a b

631−parserM step initial = Parser step initial return

632−

633638------------------------------------------------------------------------------

634639-- Mapping on the output

635640------------------------------------------------------------------------------

@@ -639,12 +644,14 @@ parserM step initial = Parser step initial return

639644-- /Pre-release/

640645{-# INLINE rmapM #-}

641646rmapM :: Monad m => (b -> m c) -> Parser m a b -> Parser m a c

642−rmapM f (Parser step initial extract) = Parser step1 initial1 (extract >=> f)

647+rmapM f (Parser step initial extract) =

648+ Parser step1 initial1 (extract >=> mapMStep f)

643649

644650 where

645651

646652 initial1 = do

647653 res <- initial

654+ -- this is mapM f over result

648655 case res of

649656 IPartial x -> return $ IPartial x

650657 IDone a -> IDone <$> f a

@@ -686,7 +693,7 @@ data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr

686693-- /Pre-release/

687694--

688695{-# INLINE serialWith #-}

689−serialWith :: MonadThrow m

696+serialWith :: Monad m

690697 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c

691698serialWith func (Parser stepL initialL extractL)

692699 (Parser stepR initialR extractR) =

@@ -695,11 +702,13 @@ serialWith func (Parser stepL initialL extractL)

695702 where

696703

697704 initial = do

705+ -- XXX We can use bimap here if we make this a Step type

698706 resL <- initialL

699707 case resL of

700708 IPartial sl -> return $ IPartial $ SeqParseL sl

701709 IDone bl -> do

702710 resR <- initialR

711+ -- XXX We can use bimap here if we make this a Step type

703712 return $ case resR of

704713 IPartial sr -> IPartial $ SeqParseR (func bl) sr

705714 IDone br -> IDone (func bl br)

@@ -712,6 +721,7 @@ serialWith func (Parser stepL initialL extractL)

712721 -- Important: Please do not use Applicative here. See

713722 -- https://github.com/composewell/streamly/issues/1033 and the problem

714723 -- defined in split_ for more info.

724+ -- XXX Use bimap

715725 resL <- stepL st a

716726 case resL of

717727 -- Note: We need to buffer the input for a possible Alternative

@@ -721,6 +731,8 @@ serialWith func (Parser stepL initialL extractL)

721731 Partial n s -> return $ Continue n (SeqParseL s)

722732 Continue n s -> return $ Continue n (SeqParseL s)

723733 Done n b -> do

734+ -- XXX Use bimap if we make this a Step type

735+ -- fmap (bimap (SeqParseR (func b)) (func b)) initialR

724736 initR <- initialR

725737 return $ case initR of

726738 IPartial sr -> Continue n $ SeqParseR (func b) sr

@@ -728,26 +740,41 @@ serialWith func (Parser stepL initialL extractL)

728740 IError err -> Error err

729741 Error err -> return $ Error err

730742

731− step (SeqParseR f st) a = do

732− resR <- stepR st a

733− return $ case resR of

734− Partial n s -> Partial n (SeqParseR f s)

735− Continue n s -> Continue n (SeqParseR f s)

736− Done n b -> Done n (f b)

737− Error err -> Error err

743+ step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a)

738744

739− extract (SeqParseR f sR) = fmap f (extractR sR)

745+ extract (SeqParseR f sR) = fmap (bimap (SeqParseR f) f) (extractR sR)

740746 extract (SeqParseL sL) = do

747+ -- XXX Use bimap here

741748 rL <- extractL sL

742− res <- initialR

743− case res of

744− IPartial sR -> do

745− rR <- extractR sR

746− return $ func rL rR

747− IDone rR -> return $ func rL rR

748− IError err -> throwM $ ParseError err

749+ case rL of

750+ Done n bL -> do

751+ -- XXX Use bimap here if we use Step type in Initial

752+ iR <- initialR

753+ case iR of

754+ IPartial sR -> do

755+ fmap

756+ (bimap (SeqParseR (func bL)) (func bL))

757+ (extractR sR)

758+ IDone bR -> return $ Done n $ func bL bR

759+ IError err -> return $ Error err

760+ Error err -> return $ Error err

761+ Partial _ _ -> error "Bug: serialWith extract 'Partial'"

762+ Continue n s -> return $ Continue n (SeqParseL s)

749763

750−-- | Works correctly only if the first parser is guaranteed to never fail.

764+-------------------------------------------------------------------------------

765+-- Sequential applicative for backtracking folds

766+-------------------------------------------------------------------------------

767+

768+-- XXX Create a newtype for nonfailing parsers and downgrade the parser to that

769+-- type before this operation and then upgrade.

770+--

771+-- We can do an inspection testing to reject unwanted constructors at compile

772+-- time.

773+--

774+-- We can use the compiler to automatically annotate accumulators, terminating

775+-- folds, non-failing parsers and failing parsers.

776+

777+-- | Works correctly only if both the parsers are guaranteed to never fail.

751778{-# INLINE noErrorUnsafeSplitWith #-}

752779noErrorUnsafeSplitWith :: Monad m

753780 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c

@@ -757,24 +784,23 @@ noErrorUnsafeSplitWith func (Parser stepL initialL extractL)

757784

758785 where

759786

787+ errMsg e = error $ "noErrorUnsafeSplitWith: unreachable: " ++ e

788+

760789 initial = do

761790 resL <- initialL

762791 case resL of

763792 IPartial sl -> return $ IPartial $ SeqParseL sl

764793 IDone bl -> do

765794 resR <- initialR

766− return $ case resR of

767− IPartial sr -> IPartial $ SeqParseR (func bl) sr

768− IDone br -> IDone (func bl br)

769− IError err -> IError err

770− IError err -> return $ IError err

795+ return $ bimap (SeqParseR (func bl)) (func bl) resR

796+ IError err -> errMsg err

771797

772798 -- Note: For the composed parse to terminate, the left parser has to be

773799 -- a terminating parser returning a Done at some point.

774800 step (SeqParseL st) a = do

775801 r <- stepL st a

776802 case r of

777− -- Assume that the first parser can never fail, therefore we do not

803+ -- Assume that the parser can never fail, therefore, we do not

778804 -- need to keep the input for backtracking.

779805 Partial n s -> return $ Partial n (SeqParseL s)

780806 Continue n s -> return $ Continue n (SeqParseL s)

@@ -784,28 +810,29 @@ noErrorUnsafeSplitWith func (Parser stepL initialL extractL)

784810 $ case res of

785811 IPartial sr -> Partial n $ SeqParseR (func b) sr

786812 IDone br -> Done n (func b br)

787− IError err -> Error err

788− Error err -> return $ Error err

813+ IError err -> errMsg err

814+ Error err -> errMsg err

789815

790− step (SeqParseR f st) a = do

791− r <- stepR st a

792− return $ case r of

793− Partial n s -> Partial n (SeqParseR f s)

794− Continue n s -> Continue n (SeqParseR f s)

795− Done n b -> Done n (f b)

796− Error err -> Error err

816+ step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a)

817+

818+ extract (SeqParseR f sR) = fmap (bimap (SeqParseR f) f) (extractR sR)

797819

798− extract (SeqParseR f sR) = fmap f (extractR sR)

799820 extract (SeqParseL sL) = do

800821 rL <- extractL sL

801− res <- initialR

802− case res of

803− IPartial sR -> do

804− rR <- extractR sR

805− return $ func rL rR

806− IDone rR -> return $ func rL rR

807− IError err -> error $ "noErrorUnsafeSplitWith: cannot use a "

808− ++ "failing parser. Parser failed with: " ++ err

822+ case rL of

823+ Done n bL -> do

824+ iR <- initialR

825+ case iR of

826+ IPartial sR -> do

827+ rR <- extractR sR

828+ return

829+ $ bimapOverrideCount

830+ n (SeqParseR (func bL)) (func bL) rR

831+ IDone bR -> return $ Done n $ func bL bR

832+ IError err -> errMsg err

833+ Error err -> errMsg err

834+ Partial _ _ -> errMsg "Partial"

835+ Continue n s -> return $ Continue n (SeqParseL s)

809836

810837{-# ANN type SeqAState Fuse #-}

811838data SeqAState sl sr = SeqAL sl | SeqAR sr

@@ -816,7 +843,7 @@ data SeqAState sl sr = SeqAL sl | SeqAR sr

816843-- /Pre-release/

817844--

818845{-# INLINE split_ #-}

819−split_ :: MonadThrow m => Parser m x a -> Parser m x b -> Parser m x b

846+split_ :: Monad m => Parser m x a -> Parser m x b -> Parser m x b

820847split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

821848 Parser step initial extract

822849

@@ -828,10 +855,7 @@ split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

828855 IPartial sl -> return $ IPartial $ SeqAL sl

829856 IDone _ -> do

830857 resR <- initialR

831− return $ case resR of

832− IPartial sr -> IPartial $ SeqAR sr

833− IDone br -> IDone br

834− IError err -> IError err

858+ return $ first SeqAR resR

835859 IError err -> return $ IError err

836860

837861 -- Note: For the composed parse to terminate, the left parser has to be

@@ -853,40 +877,43 @@ split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

853877 IError err -> Error err

854878 Error err -> return $ Error err

855879

856− step (SeqAR st) a =

857− (\case

858− Partial n s -> Partial n (SeqAR s)

859− Continue n s -> Continue n (SeqAR s)

860− Done n b -> Done n b

861− Error err -> Error err) <$> stepR st a

880+ step (SeqAR st) a = first SeqAR <$> stepR st a

862881

863− extract (SeqAR sR) = extractR sR

882+ extract (SeqAR sR) = fmap (first SeqAR) (extractR sR)

864883 extract (SeqAL sL) = do

865− _ <- extractL sL

866− res <- initialR

867− case res of

868− IPartial sR -> extractR sR

869− IDone rR -> return rR

870− IError err -> throwM $ ParseError err

884+ rL <- extractL sL

885+ case rL of

886+ Done n _ -> do

887+ iR <- initialR

888+ -- XXX For initial we can have a bimap with leftover.

889+ case iR of

890+ IPartial sR ->

891+ fmap (bimapOverrideCount n SeqAR id) (extractR sR)

892+ IDone bR -> return $ Done n bR

893+ IError err -> return $ Error err

894+ Error err -> return $ Error err

895+ Partial _ _ -> error "split_: Partial"

896+ Continue n s -> return $ Continue n (SeqAL s)

871897

898+-- For backtracking folds

872899{-# INLINE noErrorUnsafeSplit_ #-}

873−noErrorUnsafeSplit_ :: MonadThrow m => Parser m x a -> Parser m x b -> Parser m x b

874−noErrorUnsafeSplit_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

900+noErrorUnsafeSplit_ :: Monad m => Parser m x a -> Parser m x b -> Parser m x b

901+noErrorUnsafeSplit_

902+ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

875903 Parser step initial extract

876904

877905 where

878906

907+ errMsg e = error $ "noErrorUnsafeSplit_: unreachable: " ++ e

908+

879909 initial = do

880910 resL <- initialL

881911 case resL of

882912 IPartial sl -> return $ IPartial $ SeqAL sl

883913 IDone _ -> do

884914 resR <- initialR

885− return $ case resR of

886− IPartial sr -> IPartial $ SeqAR sr

887− IDone br -> IDone br

888− IError err -> IError err

889− IError err -> return $ IError err

915+ return $ first SeqAR resR

916+ IError err -> errMsg err

890917

891918 -- Note: For the composed parse to terminate, the left parser has to be

892919 -- a terminating parser returning a Done at some point.

@@ -903,27 +930,28 @@ noErrorUnsafeSplit_ (Parser stepL initialL extractL) (Parser stepR initialR extr

903930 return $ case initR of

904931 IPartial s -> Partial n (SeqAR s)

905932 IDone b -> Done n b

906− IError err -> Error err

907− Error err -> return $ Error err

933+ IError err -> errMsg err

934+ Error err -> errMsg err

908935

909− step (SeqAR st) a =

910− (\case

911− Partial n s -> Partial n (SeqAR s)

912− Continue n s -> Continue n (SeqAR s)

913− Done n b -> Done n b

914− Error err -> Error err) <$> stepR st a

936+ step (SeqAR st) a = first SeqAR <$> stepR st a

915937

916− extract (SeqAR sR) = extractR sR

938+ extract (SeqAR sR) = fmap (first SeqAR) (extractR sR)

917939 extract (SeqAL sL) = do

918− _ <- extractL sL

919− res <- initialR

920− case res of

921− IPartial sR -> extractR sR

922− IDone rR -> return rR

923− IError err -> throwM $ ParseError err

940+ rL <- extractL sL

941+ case rL of

942+ Done n _ -> do

943+ iR <- initialR

944+ case iR of

945+ IPartial sR -> do

946+ fmap (bimapOverrideCount n SeqAR id) (extractR sR)

947+ IDone bR -> return $ Done n bR

948+ IError err -> errMsg err

949+ Error err -> errMsg err

950+ Partial _ _ -> error "split_: Partial"

951+ Continue n s -> return $ Continue n (SeqAL s)

924952

925953-- | 'Applicative' form of 'serialWith'.

926−instance MonadThrow m => Applicative (Parser m a) where

954+instance Monad m => Applicative (Parser m a) where

927955 {-# INLINE pure #-}

928956 pure = fromPure

929957

@@ -936,7 +964,6 @@ instance MonadThrow m => Applicative (Parser m a) where

936964 {-# INLINE liftA2 #-}

937965 liftA2 f x = (<*>) (fmap f x)

938966

939−

940967-------------------------------------------------------------------------------

941968-- Sequential Alternative

942969-------------------------------------------------------------------------------

@@ -948,9 +975,11 @@ data AltParseState sl sr = AltParseL Int sl | AltParseR sr

948975-- quadratic time complexity, because each composition adds a new branch that

949976-- each subsequent alternative's input element has to go through, therefore, it

950977-- cannot scale to a large number of compositions

951−--

978+

952979-- | See 'Streamly.Internal.Data.Parser.alt'.

953980--

981+-- /Time Complexity:/ O(n^2) where n is the number of compositions.

982+--

954983-- /Pre-release/

955984--

956985{-# INLINE alt #-}

@@ -1001,15 +1030,30 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

10011030 Done n b -> Done n b

10021031 Error err -> Error err

10031032

1004− extract (AltParseR sR) = extractR sR

1005− extract (AltParseL _ sL) = extractL sL

1033+ extract (AltParseR sR) = fmap (first AltParseR) (extractR sR)

1034+

1035+ extract (AltParseL cnt sL) = do

1036+ rL <- extractL sL

1037+ case rL of

1038+ Done n b -> return $ Done n b

1039+ Error _ -> do

1040+ res <- initialR

1041+ return

1042+ $ case res of

1043+ IPartial rR -> Continue cnt (AltParseR rR)

1044+ IDone b -> Done cnt b

1045+ IError err -> Error err

1046+ Partial _ _ -> error "Bug: serialWith extract 'Partial'"

1047+ Continue n s -> do

1048+ assertM(n == cnt)

1049+ return $ Continue n (AltParseL 0 s)

10061050

10071051-- | See documentation of 'Streamly.Internal.Data.Parser.many'.

10081052--

10091053-- /Pre-release/

10101054--

10111055{-# INLINE splitMany #-}

1012−splitMany :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c

1056+splitMany :: Monad m => Parser m a b -> Fold m b c -> Parser m a c

10131057splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

10141058 Parser step initial extract

10151059

@@ -1051,17 +1095,21 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

10511095 xs <- fextract fs

10521096 return $ Done cnt1 xs

10531097

1054− extract (Tuple3' _ 0 fs) = fextract fs

1055− -- XXX The "try" may impact performance if this parser is used as a scan

1056− extract (Tuple3' s _ fs) = do

1057− r <- try $ extract1 s

1098+ extract (Tuple3' _ 0 fs) = fmap (Done 0) (fextract fs)

1099+ extract (Tuple3' s cnt fs) = do

1100+ r <- extract1 s

10581101 case r of

1059− Left (_ :: ParseError) -> fextract fs

1060− Right b -> do

1102+ Error _ -> fmap (Done cnt) (fextract fs)

1103+ Done n b -> do

1104+ assertM(n <= cnt)

10611105 fs1 <- fstep fs b

10621106 case fs1 of

1063− FL.Partial s1 -> fextract s1

1064− FL.Done b1 -> return b1

1107+ FL.Partial s1 -> fmap (Done n) (fextract s1)

1108+ FL.Done b1 -> return (Done n b1)

1109+ Partial _ _ -> error "splitMany: Partial in extract"

1110+ Continue n s1 -> do

1111+ assertM(n == cnt)

1112+ return (Continue n (Tuple3' s1 0 fs))

10651113

10661114-- | Like splitMany, but inner fold emits an output at the end even if no input

10671115-- is received.

@@ -1069,7 +1117,7 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

10691117-- /Internal/

10701118--

10711119{-# INLINE splitManyPost #-}

1072−splitManyPost :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c

1120+splitManyPost :: Monad m => Parser m a b -> Fold m b c -> Parser m a c

10731121splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

10741122 Parser step initial extract

10751123

@@ -1111,23 +1159,27 @@ splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

11111159 xs <- fextract fs

11121160 return $ Done cnt1 xs

11131161

1114− -- XXX The "try" may impact performance if this parser is used as a scan

1115− extract (Tuple3' s _ fs) = do

1116− r <- try $ extract1 s

1162+ extract (Tuple3' s cnt fs) = do

1163+ r <- extract1 s

11171164 case r of

1118− Left (_ :: ParseError) -> fextract fs

1119− Right b -> do

1165+ Error _ -> fmap (Done cnt) (fextract fs)

1166+ Done n b -> do

1167+ assertM(n <= cnt)

11201168 fs1 <- fstep fs b

11211169 case fs1 of

1122− FL.Partial s1 -> fextract s1

1123− FL.Done b1 -> return b1

1170+ FL.Partial s1 -> fmap (Done n) (fextract s1)

1171+ FL.Done b1 -> return (Done n b1)

1172+ Partial _ _ -> error "splitMany: Partial in extract"

1173+ Continue n s1 -> do

1174+ assertM(n == cnt)

1175+ return (Continue n (Tuple3' s1 0 fs))

11241176

11251177-- | See documentation of 'Streamly.Internal.Data.Parser.some'.

11261178--

11271179-- /Pre-release/

11281180--

11291181{-# INLINE splitSome #-}

1130−splitSome :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c

1182+splitSome :: Monad m => Parser m a b -> Fold m b c -> Parser m a c

11311183splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

11321184 Parser step initial extract

11331185

@@ -1196,29 +1248,41 @@ splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

11961248 fstep fs b >>= handleCollect (Partial n) (Done n)

11971249 Error _ -> Done cnt1 <$> fextract fs

11981250

1199− -- XXX The "try" may impact performance if this parser is used as a scan

1200− extract (Tuple3' s _ (Left fs)) = do

1201− b <- extract1 s

1202− fs1 <- fstep fs b

1203− case fs1 of

1204− FL.Partial s1 -> fextract s1

1205− FL.Done b1 -> return b1

1206− extract (Tuple3' s _ (Right fs)) = do

1207− r <- try $ extract1 s

1251+ extract (Tuple3' s cnt (Left fs)) = do

1252+ r <- extract1 s

12081253 case r of

1209− Left (_ :: ParseError) -> fextract fs

1210− Right b -> do

1254+ Error err -> return (Error err)

1255+ Done n b -> do

1256+ assertM(n <= cnt)

12111257 fs1 <- fstep fs b

12121258 case fs1 of

1213− FL.Partial s1 -> fextract s1

1214− FL.Done b1 -> return b1

1259+ FL.Partial s1 -> fmap (Done n) (fextract s1)

1260+ FL.Done b1 -> return (Done n b1)

1261+ Partial _ _ -> error "splitSome: Partial in extract"

1262+ Continue n s1 -> do

1263+ assertM(n == cnt)

1264+ return (Continue n (Tuple3' s1 0 (Left fs)))

1265+ extract (Tuple3' s cnt (Right fs)) = do

1266+ r <- extract1 s

1267+ case r of

1268+ Error _ -> fmap (Done cnt) (fextract fs)

1269+ Done n b -> do

1270+ assertM(n <= cnt)

1271+ fs1 <- fstep fs b

1272+ case fs1 of

1273+ FL.Partial s1 -> fmap (Done n) (fextract s1)

1274+ FL.Done b1 -> return (Done n b1)

1275+ Partial _ _ -> error "splitSome: Partial in extract"

1276+ Continue n s1 -> do

1277+ assertM(n == cnt)

1278+ return (Continue n (Tuple3' s1 0 (Right fs)))

12151279

12161280-- | See 'Streamly.Internal.Data.Parser.die'.

12171281--

12181282-- /Pre-release/

12191283--

12201284{-# INLINE_NORMAL die #-}

1221−die :: MonadThrow m => String -> Parser m a b

1285+die :: Monad m => String -> Parser m a b

12221286die err = Parser undefined (pure (IError err)) undefined

12231287

12241288-- | See 'Streamly.Internal.Data.Parser.dieM'.

@@ -1226,7 +1290,7 @@ die err = Parser undefined (pure (IError err)) undefined

12261290-- /Pre-release/

12271291--

12281292{-# INLINE dieM #-}

1229−dieM :: MonadThrow m => m String -> Parser m a b

1293+dieM :: Monad m => m String -> Parser m a b

12301294dieM err = Parser undefined (IError <$> err) undefined

12311295

12321296-- Note: The default implementations of "some" and "many" loop infinitely

@@ -1245,7 +1309,7 @@ dieM err = Parser undefined (IError <$> err) undefined

12451309-- >>> Stream.parse (Parser.satisfy (> 0) <|> undefined) $ Stream.fromList [1..10]

12461310-- 1

12471311--

1248−instance MonadCatch m => Alternative (Parser m a) where

1312+instance Monad m => Alternative (Parser m a) where

12491313 {-# INLINE empty #-}

12501314 empty = die "empty"

12511315

@@ -1261,14 +1325,14 @@ instance MonadCatch m => Alternative (Parser m a) where

12611325{-# ANN type ConcatParseState Fuse #-}

12621326data ConcatParseState sl m a b =

12631327 ConcatParseL sl

1264− | forall s. ConcatParseR (s -> a -> m (Step s b)) s (s -> m b)

1328+ | forall s. ConcatParseR (s -> a -> m (Step s b)) s (s -> m (Step s b))

12651329

12661330-- | See 'Streamly.Internal.Data.Parser.concatMap'.

12671331--

12681332-- /Pre-release/

12691333--

12701334{-# INLINE concatMap #-}

1271−concatMap :: MonadThrow m =>

1335+concatMap :: Monad m =>

12721336 (b -> Parser m a c) -> Parser m a b -> Parser m a c

12731337concatMap func (Parser stepL initialL extractL) = Parser step initial extract

12741338

@@ -1314,18 +1378,28 @@ concatMap func (Parser stepL initialL extractL) = Parser step initial extract

13141378 Error err -> Error err

13151379

13161380 {-# INLINE extractP #-}

1317− extractP (Parser _ initialR extractR) = do

1381+ extractP n (Parser stepR initialR extractR) = do

13181382 res <- initialR

13191383 case res of

1320− IPartial s -> extractR s

1321− IDone b -> return b

1322− IError err -> throwM $ ParseError err

1323−

1324− extract (ConcatParseR _ s extractR) = extractR s

1325− extract (ConcatParseL sL) = extractL sL >>= extractP . func

1384+ IPartial s ->

1385+ fmap

1386+ (first (\s1 -> ConcatParseR stepR s1 extractR))

1387+ (extractR s)

1388+ IDone b -> return (Done n b)

1389+ IError err -> return $ Error err

1390+

1391+ extract (ConcatParseR stepR s extractR) =

1392+ fmap (first (\s1 -> ConcatParseR stepR s1 extractR)) (extractR s)

1393+ extract (ConcatParseL sL) = do

1394+ rL <- extractL sL

1395+ case rL of

1396+ Error err -> return $ Error err

1397+ Done n b -> extractP n $ func b

1398+ Partial _ _ -> error "concatMap: extract Partial"

1399+ Continue n s -> return $ Continue n (ConcatParseL s)

13261400

13271401{-# INLINE noErrorUnsafeConcatMap #-}

1328−noErrorUnsafeConcatMap :: MonadThrow m =>

1402+noErrorUnsafeConcatMap :: Monad m =>

13291403 (b -> Parser m a c) -> Parser m a b -> Parser m a c

13301404noErrorUnsafeConcatMap func (Parser stepL initialL extractL) =

13311405 Parser step initial extract

@@ -1372,15 +1446,25 @@ noErrorUnsafeConcatMap func (Parser stepL initialL extractL) =

13721446 Error err -> Error err

13731447

13741448 {-# INLINE extractP #-}

1375− extractP (Parser _ initialR extractR) = do

1449+ extractP n (Parser stepR initialR extractR) = do

13761450 res <- initialR

13771451 case res of

1378− IPartial s -> extractR s

1379− IDone b -> return b

1380− IError err -> throwM $ ParseError err

1381−

1382− extract (ConcatParseR _ s extractR) = extractR s

1383− extract (ConcatParseL sL) = extractL sL >>= extractP . func

1452+ IPartial s ->

1453+ fmap

1454+ (first (\s1 -> ConcatParseR stepR s1 extractR))

1455+ (extractR s)

1456+ IDone b -> return (Done n b)

1457+ IError err -> return $ Error err

1458+

1459+ extract (ConcatParseR stepR s extractR) =

1460+ fmap (first (\s1 -> ConcatParseR stepR s1 extractR)) (extractR s)

1461+ extract (ConcatParseL sL) = do

1462+ rL <- extractL sL

1463+ case rL of

1464+ Error err -> return $ Error err

1465+ Done n b -> extractP n $ func b

1466+ Partial _ _ -> error "concatMap: extract Partial"

1467+ Continue n s -> return $ Continue n (ConcatParseL s)

13841468

13851469-- Note: The monad instance has quadratic performance complexity. It works fine

13861470-- for small number of compositions but for a scalable implementation we need a

@@ -1388,7 +1472,7 @@ noErrorUnsafeConcatMap func (Parser stepL initialL extractL) =

13881472

13891473-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.

13901474--

1391−instance MonadThrow m => Monad (Parser m a) where

1475+instance Monad m => Monad (Parser m a) where

13921476 {-# INLINE return #-}

13931477 return = pure

13941478

@@ -1400,14 +1484,14 @@ instance MonadThrow m => Monad (Parser m a) where

14001484

14011485-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.

14021486--

1403−instance MonadCatch m => MonadPlus (Parser m a) where

1487+instance Monad m => MonadPlus (Parser m a) where

14041488 {-# INLINE mzero #-}

14051489 mzero = die "mzero"

14061490

14071491 {-# INLINE mplus #-}

14081492 mplus = alt

14091493

1410−instance (MonadThrow m, MonadReader r m, MonadCatch m) => MonadReader r (Parser m a) where

1494+instance (Monad m, MonadReader r m) => MonadReader r (Parser m a) where

14111495 {-# INLINE ask #-}

14121496 ask = fromEffect ask

14131497

@@ -1417,14 +1501,14 @@ instance (MonadThrow m, MonadReader r m, MonadCatch m) => MonadReader r (Parser

14171501 (local f init')

14181502 (local f . extract)

14191503

1420−instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where

1504+instance (Monad m, MonadState s m) => MonadState s (Parser m a) where

14211505 {-# INLINE get #-}

14221506 get = fromEffect get

14231507

14241508 {-# INLINE put #-}

14251509 put = fromEffect . put

14261510

1427−instance (MonadThrow m, MonadIO m) => MonadIO (Parser m a) where

1511+instance (Monad m, MonadIO m) => MonadIO (Parser m a) where

14281512 {-# INLINE liftIO #-}

14291513 liftIO = fromEffect . liftIO

14301514

core/src/Streamly/Internal/Data/Parser/ParserK/Type.hs+1−1

@@ -67,7 +67,7 @@ instance Functor m => Functor (Step m a) where

6767-- /Pre-release/

6868--

6969data Parse b =

70− Success !Int !b -- Success, no more input needed

70+ Success !Int !b -- Leftover count, result

7171 | Failure !String -- Error

7272

7373-- | Map a function over 'Success'.

core/src/Streamly/Internal/Data/Producer/Source.hs+48−3

@@ -161,9 +161,7 @@ parseD

161161 return (b, unread src s1)

162162 Error err -> throwM $ ParseError err

163163 Skip s -> go SPEC s buf pst

164− Stop -> do

165− b <- extract pst

166− return (b, unread (reverse $ getList buf) (source Nothing))

164+ Stop -> goStop buf pst

167165

168166 gobuf !_ s buf (List []) !pst = go SPEC s buf pst

169167 gobuf !_ s buf (List (x:xs)) !pst = do

@@ -191,6 +189,53 @@ parseD

191189 return (b, unread src s1)

192190 Error err -> throwM $ ParseError err

193191

192+ -- This is a simplified gobuf

193+ goExtract !_ buf (List []) !pst = goStop buf pst

194+ goExtract !_ buf (List (x:xs)) !pst = do

195+ pRes <- pstep pst x

196+ case pRes of

197+ Partial 0 pst1 ->

198+ goExtract SPEC (List []) (List xs) pst1

199+ Partial n pst1 -> do

200+ assert (n <= length (x:getList buf)) (return ())

201+ let src0 = Prelude.take n (x:getList buf)

202+ src = Prelude.reverse src0 ++ xs

203+ goExtract SPEC (List []) (List src) pst1

204+ Continue 0 pst1 ->

205+ goExtract SPEC (List (x:getList buf)) (List xs) pst1

206+ Continue n pst1 -> do

207+ assert (n <= length (x:getList buf)) (return ())

208+ let (src0, buf1) = splitAt n (x:getList buf)

209+ src = Prelude.reverse src0 ++ xs

210+ goExtract SPEC (List buf1) (List src) pst1

211+ Done n b -> do

212+ assert (n <= length (x:getList buf)) (return ())

213+ let src0 = Prelude.take n (x:getList buf)

214+ src = Prelude.reverse src0

215+ return (b, unread src (source Nothing))

216+ Error err -> throwM $ ParseError err

217+

218+ -- This is a simplified goExtract

219+ {-# INLINE goStop #-}

220+ goStop buf pst = do

221+ pRes <- extract pst

222+ case pRes of

223+ Partial _ _ -> error "Bug: parseD: Partial in extract"

224+ Continue 0 _ ->

225+ error "parseD: extract, Continue 0 creates infinite loop"

226+ Continue n pst1 -> do

227+ assert (n <= length (getList buf)) (return ())

228+ let (src0, buf1) = splitAt n (getList buf)

229+ src = Prelude.reverse src0

230+ goExtract SPEC (List buf1) (List src) pst1

231+ Done 0 b -> return (b, source Nothing)

232+ Done n b -> do

233+ assert (n <= length (getList buf)) (return ())

234+ let src0 = Prelude.take n (getList buf)

235+ src = Prelude.reverse src0

236+ return (b, unread src (source Nothing))

237+ Error err -> throwM $ ParseError err

238+

194239-- | Parse a buffered source using a parser, returning the parsed value and the

195240-- remaining source.

196241--

core/src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs+49−3

@@ -89,6 +89,7 @@ import qualified Streamly.Internal.Data.Fold as Fold

8989#endif

9090import qualified Streamly.Internal.Data.Parser as PR

9191import qualified Streamly.Internal.Data.Parser.ParserD as PRD

92+import qualified Streamly.Internal.Data.Stream.StreamD.Generate as StreamD

9293import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Nesting

9394

9495import Prelude hiding

@@ -198,9 +199,7 @@ parseBreak (PRD.Parser pstep initial extract) stream@(Stream step state) = do

198199 return (b, Nesting.append (fromList src) (Stream step s))

199200 PR.Error err -> throwM $ ParseError err

200201 Skip s -> go SPEC s buf pst

201− Stop -> do

202− b <- extract pst

203− return (b, let List buffer = buf in fromList buffer)

202+ Stop -> goStop buf pst

204203

205204 gobuf !_ s buf (List []) !pst = go SPEC s buf pst

206205 gobuf !_ s buf (List (x:xs)) !pst = do

@@ -227,6 +226,53 @@ parseBreak (PRD.Parser pstep initial extract) stream@(Stream step state) = do

227226 return (b, Nesting.append (fromList src) (Stream step s))

228227 PR.Error err -> throwM $ ParseError err

229228

229+ -- This is simplified gobuf

230+ goExtract !_ buf (List []) !pst = goStop buf pst

231+ goExtract !_ buf (List (x:xs)) !pst = do

232+ pRes <- pstep pst x

233+ case pRes of

234+ PR.Partial 0 pst1 ->

235+ goExtract SPEC (List []) (List xs) pst1

236+ PR.Partial n pst1 -> do

237+ assert (n <= length (x:getList buf)) (return ())

238+ let src0 = Prelude.take n (x:getList buf)

239+ src = Prelude.reverse src0 ++ xs

240+ goExtract SPEC (List []) (List src) pst1

241+ PR.Continue 0 pst1 ->

242+ goExtract SPEC (List (x:getList buf)) (List xs) pst1

243+ PR.Continue n pst1 -> do

244+ assert (n <= length (x:getList buf)) (return ())

245+ let (src0, buf1) = splitAt n (x:getList buf)

246+ src = Prelude.reverse src0 ++ xs

247+ goExtract SPEC (List buf1) (List src) pst1

248+ PR.Done n b -> do

249+ assert (n <= length (x:getList buf)) (return ())

250+ let src0 = Prelude.take n (x:getList buf)

251+ src = Prelude.reverse src0

252+ return (b, fromList src)

253+ PR.Error err -> throwM $ ParseError err

254+

255+ -- This is simplified goExtract

256+ {-# INLINE goStop #-}

257+ goStop buf pst = do

258+ pRes <- extract pst

259+ case pRes of

260+ PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"

261+ PR.Continue 0 _ ->

262+ error "parseBreak: extract, Continue 0 creates infinite loop"

263+ PR.Continue n pst1 -> do

264+ assert (n <= length (getList buf)) (return ())

265+ let (src0, buf1) = splitAt n (getList buf)

266+ src = Prelude.reverse src0

267+ goExtract SPEC (List buf1) (List src) pst1

268+ PR.Done 0 b -> return (b, StreamD.nil)

269+ PR.Done n b -> do

270+ assert (n <= length (getList buf)) (return ())

271+ let src0 = Prelude.take n (getList buf)

272+ src = Prelude.reverse src0

273+ return (b, fromList src)

274+ PR.Error err -> throwM $ ParseError err

275+

230276------------------------------------------------------------------------------

231277-- Specialized Folds

232278------------------------------------------------------------------------------

core/src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs+140−11

@@ -1148,9 +1148,12 @@ sliceOnSuffix predicate =

11481148{-# ANN type ParseChunksState Fuse #-}

11491149data ParseChunksState x inpBuf st pst =

11501150 ParseChunksInit inpBuf st

1151+ | ParseChunksInitBuf inpBuf

11511152 | ParseChunksInitLeftOver inpBuf

11521153 | ParseChunksStream st inpBuf !pst

1154+ | ParseChunksStop inpBuf !pst

11531155 | ParseChunksBuf inpBuf st inpBuf !pst

1156+ | ParseChunksExtract inpBuf inpBuf !pst

11541157 | ParseChunksYield x (ParseChunksState x inpBuf st pst)

11551158

11561159-- XXX This is in fact parseMany1 (a la foldMany1). Do we need a parseMany as

@@ -1195,6 +1198,17 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) =

11951198 in return $ Skip $ ParseChunksYield pb next

11961199 PRD.IError err -> throwM $ ParseError err

11971200

1201+ -- This is simplified ParseChunksInit

1202+ stepOuter _ (ParseChunksInitBuf src) = do

1203+ res <- initial

1204+ case res of

1205+ PRD.IPartial ps ->

1206+ return $ Skip $ ParseChunksExtract src [] ps

1207+ PRD.IDone pb ->

1208+ let next = ParseChunksInitBuf src

1209+ in return $ Skip $ ParseChunksYield pb next

1210+ PRD.IError err -> throwM $ ParseError err

1211+

11981212 -- XXX we just discard any leftover input at the end

11991213 stepOuter _ (ParseChunksInitLeftOver _) = return Stop

12001214

@@ -1229,11 +1243,7 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) =

12291243 ParseChunksYield b (ParseChunksInit src s)

12301244 PR.Error err -> throwM $ ParseError err

12311245 Skip s -> return $ Skip $ ParseChunksStream s buf pst

1232− Stop -> do

1233− b <- extract pst

1234− let src = Prelude.reverse buf

1235− return $ Skip $

1236− ParseChunksYield b (ParseChunksInitLeftOver src)

1246+ Stop -> return $ Skip $ ParseChunksStop buf pst

12371247

12381248 -- go back to stream processing mode

12391249 stepOuter _ (ParseChunksBuf [] s buf pst) =

@@ -1265,16 +1275,75 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) =

12651275 return $ Skip $ ParseChunksYield b (ParseChunksInit src s)

12661276 PR.Error err -> throwM $ ParseError err

12671277

1278+ -- This is simplified ParseChunksBuf

1279+ stepOuter _ (ParseChunksExtract [] buf pst) =

1280+ return $ Skip $ ParseChunksStop buf pst

1281+

1282+ stepOuter _ (ParseChunksExtract (x:xs) buf pst) = do

1283+ pRes <- pstep pst x

1284+ case pRes of

1285+ PR.Partial 0 pst1 ->

1286+ return $ Skip $ ParseChunksExtract xs [] pst1

1287+ PR.Partial n pst1 -> do

1288+ assert (n <= length (x:buf)) (return ())

1289+ let src0 = Prelude.take n (x:buf)

1290+ src = Prelude.reverse src0 ++ xs

1291+ return $ Skip $ ParseChunksExtract src [] pst1

1292+ PR.Continue 0 pst1 ->

1293+ return $ Skip $ ParseChunksExtract xs (x:buf) pst1

1294+ PR.Continue n pst1 -> do

1295+ assert (n <= length (x:buf)) (return ())

1296+ let (src0, buf1) = splitAt n (x:buf)

1297+ src = Prelude.reverse src0 ++ xs

1298+ return $ Skip $ ParseChunksExtract src buf1 pst1

1299+ PR.Done 0 b ->

1300+ return $ Skip $ ParseChunksYield b (ParseChunksInitBuf xs)

1301+ PR.Done n b -> do

1302+ assert (n <= length (x:buf)) (return ())

1303+ let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs

1304+ return $ Skip $ ParseChunksYield b (ParseChunksInitBuf src)

1305+ PR.Error err -> throwM $ ParseError err

1306+

1307+ -- This is simplified ParseChunksExtract

1308+ stepOuter _ (ParseChunksStop buf pst) = do

1309+ pRes <- extract pst

1310+ case pRes of

1311+ PR.Partial _ _ -> error "Bug: parseMany: Partial in extract"

1312+ PR.Continue 0 _ ->

1313+ error "parseMany: extract, Continue 0 creates infinite loop"

1314+ PR.Continue n pst1 -> do

1315+ assert (n <= length buf) (return ())

1316+ let (src0, buf1) = splitAt n buf

1317+ src = Prelude.reverse src0

1318+ return $ Skip $ ParseChunksExtract src buf1 pst1

1319+ PR.Done 0 b -> do

1320+ return $ Skip $

1321+ ParseChunksYield b (ParseChunksInitLeftOver [])

1322+ PR.Done n b -> do

1323+ assert (n <= length buf) (return ())

1324+ let src = Prelude.reverse (Prelude.take n buf)

1325+ return $ Skip $

1326+ ParseChunksYield b (ParseChunksInitBuf src)

1327+ PR.Error err -> throwM $ ParseError err

1328+

12681329 stepOuter _ (ParseChunksYield a next) = return $ Yield a next

12691330

12701331{-# ANN type ConcatParseState Fuse #-}

12711332data ConcatParseState b inpBuf st p m a =

12721333 ConcatParseInit inpBuf st p

1334+ | ConcatParseInitBuf inpBuf p

12731335 | ConcatParseInitLeftOver inpBuf

1274− | forall s. ConcatParseStream st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m b)

1275− | forall s. ConcatParseBuf inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m b)

1336+ | forall s. ConcatParseStop

1337+ inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))

1338+ | forall s. ConcatParseStream

1339+ st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))

1340+ | forall s. ConcatParseBuf

1341+ inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))

1342+ | forall s. ConcatParseExtract

1343+ inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))

12761344 | ConcatParseYield b (ConcatParseState b inpBuf st p m a)

12771345

1346+-- XXX Review the changes

12781347{-# INLINE_NORMAL parseIterate #-}

12791348parseIterate

12801349 :: MonadThrow m

@@ -1311,6 +1380,18 @@ parseIterate func seed (Stream step state) =

13111380 in return $ Skip $ ConcatParseYield pb next

13121381 PRD.IError err -> throwM $ ParseError err

13131382

1383+ -- This is simplified ConcatParseInit

1384+ stepOuter _ (ConcatParseInitBuf src

1385+ (PRD.Parser pstep initial extract)) = do

1386+ res <- initial

1387+ case res of

1388+ PRD.IPartial ps ->

1389+ return $ Skip $ ConcatParseExtract src [] pstep ps extract

1390+ PRD.IDone pb ->

1391+ let next = ConcatParseInitBuf src (func pb)

1392+ in return $ Skip $ ConcatParseYield pb next

1393+ PRD.IError err -> throwM $ ParseError err

1394+

13141395 -- XXX we just discard any leftover input at the end

13151396 stepOuter _ (ConcatParseInitLeftOver _) = return Stop

13161397

@@ -1343,10 +1424,7 @@ parseIterate func seed (Stream step state) =

13431424 ConcatParseYield b (ConcatParseInit src s (func b))

13441425 PR.Error err -> throwM $ ParseError err

13451426 Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract

1346− Stop -> do

1347− b <- extract pst

1348− let src = Prelude.reverse buf

1349− return $ Skip $ ConcatParseYield b (ConcatParseInitLeftOver src)

1427+ Stop -> return $ Skip $ ConcatParseStop buf pstep pst extract

13501428

13511429 -- go back to stream processing mode

13521430 stepOuter _ (ConcatParseBuf [] s buf pstep ps extract) =

@@ -1377,6 +1455,57 @@ parseIterate func seed (Stream step state) =

13771455 (ConcatParseInit src s (func b))

13781456 PR.Error err -> throwM $ ParseError err

13791457

1458+ -- This is simplified ConcatParseBuf

1459+ stepOuter _ (ConcatParseExtract [] buf pstep pst extract) =

1460+ return $ Skip $ ConcatParseStop buf pstep pst extract

1461+

1462+ stepOuter _ (ConcatParseExtract (x:xs) buf pstep pst extract) = do

1463+ pRes <- pstep pst x

1464+ case pRes of

1465+ PR.Partial 0 pst1 ->

1466+ return $ Skip $ ConcatParseExtract xs [] pstep pst1 extract

1467+ PR.Partial n pst1 -> do

1468+ assert (n <= length (x:buf)) (return ())

1469+ let src0 = Prelude.take n (x:buf)

1470+ src = Prelude.reverse src0 ++ xs

1471+ return $ Skip $ ConcatParseExtract src [] pstep pst1 extract

1472+ PR.Continue 0 pst1 ->

1473+ return $ Skip $ ConcatParseExtract xs (x:buf) pstep pst1 extract

1474+ PR.Continue n pst1 -> do

1475+ assert (n <= length (x:buf)) (return ())

1476+ let (src0, buf1) = splitAt n (x:buf)

1477+ src = Prelude.reverse src0 ++ xs

1478+ return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract

1479+ PR.Done 0 b ->

1480+ return $ Skip $ ConcatParseYield b (ConcatParseInitBuf xs (func b))

1481+ PR.Done n b -> do

1482+ assert (n <= length (x:buf)) (return ())

1483+ let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs

1484+ return $ Skip $ ConcatParseYield b (ConcatParseInitBuf src (func b))

1485+ PR.Error err -> throwM $ ParseError err

1486+

1487+ -- This is simplified ConcatParseExtract

1488+ stepOuter _ (ConcatParseStop buf pstep pst extract) = do

1489+ pRes <- extract pst

1490+ case pRes of

1491+ PR.Partial _ _ -> error "Bug: parseIterate: Partial in extract"

1492+ PR.Continue 0 _ ->

1493+ error "parseIterate: extract, Continue 0 creates infinite loop"

1494+ PR.Continue n pst1 -> do

1495+ assert (n <= length buf) (return ())

1496+ let (src0, buf1) = splitAt n buf

1497+ src = Prelude.reverse src0

1498+ return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract

1499+ PR.Done 0 b -> do

1500+ return $ Skip $

1501+ ConcatParseYield b (ConcatParseInitLeftOver [])

1502+ PR.Done n b -> do

1503+ assert (n <= length buf) (return ())

1504+ let src = Prelude.reverse (Prelude.take n buf)

1505+ return $ Skip $

1506+ ConcatParseYield b (ConcatParseInitBuf src (func b))

1507+ PR.Error err -> throwM $ ParseError err

1508+

13801509 stepOuter _ (ConcatParseYield a next) = return $ Yield a next

13811510

13821511------------------------------------------------------------------------------

core/src/Streamly/Internal/Data/Stream/StreamK.hs+20−6

@@ -175,7 +175,8 @@ module Streamly.Internal.Data.Stream.StreamK

175175 )

176176where

177177

178−import Control.Exception (assert)

178+#include "assert.hs"

179+

179180import Control.Monad.Catch (MonadThrow, throwM)

180181import Control.Monad.Trans.Class (MonadTrans(lift))

181182import Control.Monad (void, join)

@@ -1027,27 +1028,40 @@ parseBreak (PR.Parser pstep initial extract) stream = do

10271028 -- That will allow us more efficient random back and forth movement.

10281029 goStream st buf !pst =

10291030 let stop = do

1030− b <- extract pst

1031− return (b, fromList buf)

1031+ r <- extract pst

1032+ case r of

1033+ PR.Error err -> throwM $ PR.ParseError err

1034+ PR.Done n b -> do

1035+ assertM(n <= length buf)

1036+ let src0 = Prelude.take n buf

1037+ src = Prelude.reverse src0

1038+ return (b, fromList src)

1039+ PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"

1040+ PR.Continue 0 _ -> error "parseBreak: extract, Continue 0 creates infinite loop"

1041+ PR.Continue n s -> do

1042+ assertM(n <= length buf)

1043+ let (src0, buf1) = splitAt n buf

1044+ src = Prelude.reverse src0

1045+ goBuf nil buf1 src s

10321046 single x = yieldk x nil

10331047 yieldk x r = do

10341048 res <- pstep pst x

10351049 case res of

10361050 PR.Partial 0 s -> goStream r [] s

10371051 PR.Partial n s -> do

1038− assert (n <= length (x:buf)) (return ())

1052+ assertM(n <= length (x:buf))

10391053 let src0 = Prelude.take n (x:buf)

10401054 src = Prelude.reverse src0

10411055 goBuf r [] src s

10421056 PR.Continue 0 s -> goStream r (x:buf) s

10431057 PR.Continue n s -> do

1044− assert (n <= length (x:buf)) (return ())

1058+ assertM(n <= length (x:buf))

10451059 let (src0, buf1) = splitAt n (x:buf)

10461060 src = Prelude.reverse src0

10471061 goBuf r buf1 src s

10481062 PR.Done 0 b -> return (b, r)

10491063 PR.Done n b -> do

1050− assert (n <= length (x:buf)) (return ())

1064+ assertM(n <= length (x:buf))

10511065 let src0 = Prelude.take n (x:buf)

10521066 src = Prelude.reverse src0

10531067 return (b, serial (fromList src) r)

src/Streamly/Internal/Data/Array/Stream/Foreign.hs+201−26

@@ -26,7 +26,7 @@ module Streamly.Internal.Data.Array.Stream.Foreign

2626 , foldBreak

2727 , foldBreakD

2828 , parseBreak

29− , parseBreakD

29+ -- , parseBreakD

3030

3131 -- ** Array Folds

3232 , runArrayFold

@@ -542,6 +542,7 @@ _toArraysOf n = FL.chunksOf n (A.writeNF n) FL.toStream

542542{-# ANN type List NoSpecConstr #-}

543543newtype List a = List {getList :: [a]}

544544

545+{-

545546-- This can be generalized to any type provided it can be unfolded to a stream

546547-- and it can be combined using a semigroup operation.

547548--

@@ -626,6 +627,7 @@ parseBreakD

626627 str = D.cons arr0 (D.cons arr1 (D.Stream step s))

627628 return (b, str)

628629 PR.Error err -> throwM $ ParseError err

630+-}

629631

630632{-# INLINE_NORMAL parseBreakK #-}

631633parseBreakK ::

@@ -649,44 +651,36 @@ parseBreakK (PRD.Parser pstep initial extract) stream = do

649651 -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.

650652 -- That will allow us more efficient random back and forth movement.

651653 go !pst st backBuf = do

652− let stop = (, K.nil) <$> extract pst

654+ let stop = goStop pst backBuf -- (, K.nil) <$> extract pst

653655 single a = yieldk a K.nil

654− yieldk (Array contents start end) r =

655− let fp = Tuple' end contents

656− in goArray pst backBuf r fp start

656+ yieldk arr r = goArray pst backBuf r arr

657657 in K.foldStream defState yieldk single stop st

658658

659659 -- Use strictness on "cur" to keep it unboxed

660− goArray !pst backBuf st (Tuple' end _) !cur

661− | cur == end = do

662− go pst st backBuf

663− goArray !pst backBuf st fp@(Tuple' end contents) !cur = do

660+ goArray !pst backBuf st (Array _ cur end) | cur == end = go pst st backBuf

661+ goArray !pst backBuf st (Array contents cur end) = do

664662 x <- liftIO $ peekWith contents cur

665663 pRes <- pstep pst x

666664 let next = INDEX_NEXT(cur,a)

667665 case pRes of

668666 PR.Partial 0 s ->

669− goArray s [] st fp next

667+ goArray s [] st (Array contents next end)

670668 PR.Partial n s -> do

671669 assert (n <= Prelude.length (x:backBuf)) (return ())

672670 let src0 = Prelude.take n (x:backBuf)

673671 arr0 = A.fromListN n (Prelude.reverse src0)

674672 arr1 = Array contents next end

675673 src = arr0 <> arr1

676− let !(Array cont1 start end1) = src

677− fp1 = Tuple' end1 cont1

678− goArray s [] st fp1 start

674+ goArray s [] st src

679675 PR.Continue 0 s ->

680− goArray s (x:backBuf) st fp next

676+ goArray s (x:backBuf) st (Array contents next end)

681677 PR.Continue n s -> do

682678 assert (n <= Prelude.length (x:backBuf)) (return ())

683679 let (src0, buf1) = splitAt n (x:backBuf)

684680 arr0 = A.fromListN n (Prelude.reverse src0)

685681 arr1 = Array contents next end

686682 src = arr0 <> arr1

687− let !(Array cont1 start end1) = src

688− fp1 = Tuple' end1 cont1

689− goArray s buf1 st fp1 start

683+ goArray s buf1 st src

690684 PR.Done 0 b -> do

691685 let arr = Array contents next end

692686 return (b, K.cons arr st)

@@ -701,6 +695,70 @@ parseBreakK (PRD.Parser pstep initial extract) stream = do

701695 return (b, str)

702696 PR.Error err -> throwM $ ParseError err

703697

698+ -- This is a simplified goArray

699+ goExtract !pst backBuf (Array _ cur end)

700+ | cur == end = goStop pst backBuf

701+ goExtract !pst backBuf (Array contents cur end) = do

702+ x <- liftIO $ peekWith contents cur

703+ pRes <- pstep pst x

704+ let next = INDEX_NEXT(cur,a)

705+ case pRes of

706+ PR.Partial 0 s ->

707+ goExtract s [] (Array contents next end)

708+ PR.Partial n s -> do

709+ assert (n <= Prelude.length (x:backBuf)) (return ())

710+ let src0 = Prelude.take n (x:backBuf)

711+ arr0 = A.fromListN n (Prelude.reverse src0)

712+ arr1 = Array contents next end

713+ src = arr0 <> arr1

714+ goExtract s [] src

715+ PR.Continue 0 s ->

716+ goExtract s backBuf (Array contents next end)

717+ PR.Continue n s -> do

718+ assert (n <= Prelude.length (x:backBuf)) (return ())

719+ let (src0, buf1) = splitAt n (x:backBuf)

720+ arr0 = A.fromListN n (Prelude.reverse src0)

721+ arr1 = Array contents next end

722+ src = arr0 <> arr1

723+ goExtract s buf1 src

724+ PR.Done 0 b -> do

725+ let arr = Array contents next end

726+ return (b, K.fromPure arr)

727+ PR.Done n b -> do

728+ assert (n <= Prelude.length backBuf) (return ())

729+ let src0 = Prelude.take n backBuf

730+ -- XXX Use fromListRevN once implemented

731+ -- arr0 = A.fromListRevN n src0

732+ arr0 = A.fromListN n (Prelude.reverse src0)

733+ arr1 = Array contents next end

734+ str = K.cons arr0 (K.fromPure arr1)

735+ return (b, str)

736+ PR.Error err -> throwM $ ParseError err

737+

738+ -- This is a simplified goExtract

739+ {-# INLINE goStop #-}

740+ goStop !pst backBuf = do

741+ pRes <- extract pst

742+ case pRes of

743+ PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"

744+ PR.Continue 0 _ ->

745+ error "parseBreak: extract, Continue 0 creates infinite loop"

746+ PR.Continue n s -> do

747+ assert (n <= Prelude.length backBuf) (return ())

748+ let (src0, buf1) = splitAt n backBuf

749+ arr = A.fromListN n (Prelude.reverse src0)

750+ goExtract s buf1 arr

751+ PR.Done 0 b ->

752+ return (b, K.nil)

753+ PR.Done n b -> do

754+ assert (n <= Prelude.length backBuf) (return ())

755+ let src0 = Prelude.take n backBuf

756+ -- XXX Use fromListRevN once implemented

757+ -- arr0 = A.fromListRevN n src0

758+ arr0 = A.fromListN n (Prelude.reverse src0)

759+ return (b, K.fromPure arr0)

760+ PR.Error err -> throwM $ ParseError err

761+

704762-- | Parse an array stream using the supplied 'Parser'. Returns the parse

705763-- result and the unconsumed stream. Throws 'ParseError' if the parse fails.

706764--

@@ -756,14 +814,12 @@ runArrayParserDBreak

756814 -- XXX currently we are using a dumb list based approach for backtracking

757815 -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.

758816 -- That will allow us more efficient random back and forth movement.

759− go !_ st backBuf !pst = do

817+ go _ st backBuf !pst = do

760818 r <- step defState st

761819 case r of

762820 D.Yield x s -> gobuf SPEC [x] s backBuf pst

763821 D.Skip s -> go SPEC s backBuf pst

764− D.Stop -> do

765− b <- extract pst

766− return (b, D.nil)

822+ D.Stop -> goStop backBuf pst

767823

768824 gobuf !_ [] s backBuf !pst = go SPEC s backBuf pst

769825 gobuf !_ (x:xs) s backBuf !pst = do

@@ -798,6 +854,65 @@ runArrayParserDBreak

798854 return (b, D.append (D.fromList src) (D.Stream step s))

799855 PR.Error err -> throwM $ ParseError err

800856

857+ -- This is a simplified gobuf

858+ goExtract _ [] backBuf !pst = goStop backBuf pst

859+ goExtract _ (x:xs) backBuf !pst = do

860+ pRes <- pstep pst x

861+ case pRes of

862+ PR.Partial 0 pst1 ->

863+ goExtract SPEC xs (List []) pst1

864+ PR.Partial n pst1 -> do

865+ assert

866+ (n <= sum (map Array.length (x:getList backBuf)))

867+ (return ())

868+ let src0 = takeArrayListRev n (x:getList backBuf)

869+ src = Prelude.reverse src0 ++ xs

870+ goExtract SPEC src (List []) pst1

871+ PR.Continue 0 pst1 ->

872+ goExtract SPEC xs (List (x:getList backBuf)) pst1

873+ PR.Continue n pst1 -> do

874+ assert

875+ (n <= sum (map Array.length (x:getList backBuf)))

876+ (return ())

877+ let (src0, buf1) = splitAtArrayListRev n (x:getList backBuf)

878+ src = Prelude.reverse src0 ++ xs

879+ goExtract SPEC src (List buf1) pst1

880+ PR.Done 0 b ->

881+ return (b, D.nil)

882+ PR.Done n b -> do

883+ assert

884+ (n <= sum (map Array.length (x:getList backBuf)))

885+ (return ())

886+ let src0 = takeArrayListRev n (x:getList backBuf)

887+ src = Prelude.reverse src0 ++ xs

888+ return (b, D.fromList src)

889+ PR.Error err -> throwM $ ParseError err

890+

891+ -- This is a simplified goExtract

892+ {-# INLINE goStop #-}

893+ goStop backBuf pst = do

894+ pRes <- extract pst

895+ case pRes of

896+ PR.Partial _ _ -> error "Bug: runArrayParserDBreak: Partial in extract"

897+ PR.Continue 0 _ ->

898+ error "runArrayParserDBreak: extract, Continue 0 creates infinite loop"

899+ PR.Continue n pst1 -> do

900+ assert

901+ (n <= sum (map Array.length (getList backBuf)))

902+ (return ())

903+ let (src0, buf1) = splitAtArrayListRev n (getList backBuf)

904+ src = Prelude.reverse src0

905+ goExtract SPEC src (List buf1) pst1

906+ PR.Done 0 b -> return (b, D.nil)

907+ PR.Done n b -> do

908+ assert

909+ (n <= sum (map Array.length (getList backBuf)))

910+ (return ())

911+ let src0 = takeArrayListRev n (getList backBuf)

912+ src = Prelude.reverse src0

913+ return (b, D.fromList src)

914+ PR.Error err -> throwM $ ParseError err

915+

801916{-

802917-- | Parse an array stream using the supplied 'Parser'. Returns the parse

803918-- result and the unconsumed stream. Throws 'ParseError' if the parse fails.

@@ -835,9 +950,12 @@ runArrayFoldBreak (ArrayFold p) s =

835950{-# ANN type ParseChunksState Fuse #-}

836951data ParseChunksState x inpBuf st pst =

837952 ParseChunksInit inpBuf st

953+ | ParseChunksInitBuf inpBuf

838954 | ParseChunksInitLeftOver inpBuf

839955 | ParseChunksStream st inpBuf !pst

956+ | ParseChunksStop inpBuf !pst

840957 | ParseChunksBuf inpBuf st inpBuf !pst

958+ | ParseChunksExtract inpBuf inpBuf !pst

841959 | ParseChunksYield x (ParseChunksState x inpBuf st pst)

842960

843961{-# INLINE_NORMAL runArrayFoldManyD #-}

@@ -882,6 +1000,17 @@ runArrayFoldManyD

8821000 in return $ D.Skip $ ParseChunksYield pb next

8831001 PRD.IError err -> throwM $ ParseError err

8841002

1003+ -- This is a simplified ParseChunksInit

1004+ stepOuter _ (ParseChunksInitBuf src) = do

1005+ res <- initial

1006+ case res of

1007+ PRD.IPartial ps ->

1008+ return $ D.Skip $ ParseChunksExtract src [] ps

1009+ PRD.IDone pb ->

1010+ let next = ParseChunksInitBuf src

1011+ in return $ D.Skip $ ParseChunksYield pb next

1012+ PRD.IError err -> throwM $ ParseError err

1013+

8851014 -- XXX we just discard any leftover input at the end

8861015 stepOuter _ (ParseChunksInitLeftOver _) = return D.Stop

8871016

@@ -923,11 +1052,7 @@ runArrayFoldManyD

9231052 ParseChunksYield b (ParseChunksInit src s)

9241053 PR.Error err -> throwM $ ParseError err

9251054 D.Skip s -> return $ D.Skip $ ParseChunksStream s backBuf pst

926− D.Stop -> do

927− b <- extract pst

928− let src = Prelude.reverse backBuf

929− return $ D.Skip $

930− ParseChunksYield b (ParseChunksInitLeftOver src)

1055+ D.Stop -> return $ D.Skip $ ParseChunksStop backBuf pst

9311056

9321057 -- go back to stream processing mode

9331058 stepOuter _ (ParseChunksBuf [] s buf pst) =

@@ -960,6 +1085,56 @@ runArrayFoldManyD

9601085 return $ D.Skip $ ParseChunksYield b (ParseChunksInit src s)

9611086 PR.Error err -> throwM $ ParseError err

9621087

1088+ -- This is a simplified ParseChunksBuf

1089+ stepOuter _ (ParseChunksExtract [] buf pst) =

1090+ return $ D.Skip $ ParseChunksStop buf pst

1091+

1092+ stepOuter _ (ParseChunksExtract (x:xs) backBuf pst) = do

1093+ pRes <- pstep pst x

1094+ case pRes of

1095+ PR.Partial 0 pst1 ->

1096+ return $ D.Skip $ ParseChunksExtract xs [] pst1

1097+ PR.Partial n pst1 -> do

1098+ assert (n <= sum (map Array.length (x:backBuf))) (return ())

1099+ let src0 = takeArrayListRev n (x:backBuf)

1100+ src = Prelude.reverse src0 ++ xs

1101+ return $ D.Skip $ ParseChunksExtract src [] pst1

1102+ PR.Continue 0 pst1 ->

1103+ return $ D.Skip $ ParseChunksExtract xs (x:backBuf) pst1

1104+ PR.Continue n pst1 -> do

1105+ assert (n <= sum (map Array.length (x:backBuf))) (return ())

1106+ let (src0, buf1) = splitAtArrayListRev n (x:backBuf)

1107+ src = Prelude.reverse src0 ++ xs

1108+ return $ D.Skip $ ParseChunksExtract src buf1 pst1

1109+ PR.Done 0 b ->

1110+ return $ D.Skip $ ParseChunksYield b (ParseChunksInitBuf xs)

1111+ PR.Done n b -> do

1112+ assert (n <= sum (map Array.length (x:backBuf))) (return ())

1113+ let src0 = takeArrayListRev n (x:backBuf)

1114+ src = Prelude.reverse src0 ++ xs

1115+ return $ D.Skip $ ParseChunksYield b (ParseChunksInitBuf src)

1116+ PR.Error err -> throwM $ ParseError err

1117+

1118+ -- This is a simplified ParseChunksExtract

1119+ stepOuter _ (ParseChunksStop backBuf pst) = do

1120+ pRes <- extract pst

1121+ case pRes of

1122+ PR.Partial _ _ -> error "runArrayFoldManyD: Partial in extract"

1123+ PR.Continue 0 _ -> error "runArrayFoldManyD: Continue 0 in extract"

1124+ PR.Continue n pst1 -> do

1125+ assert (n <= sum (map Array.length backBuf)) (return ())

1126+ let (src0, buf1) = splitAtArrayListRev n backBuf

1127+ src = Prelude.reverse src0

1128+ return $ D.Skip $ ParseChunksExtract src buf1 pst1

1129+ PR.Done 0 b ->

1130+ return $ D.Skip $ ParseChunksYield b (ParseChunksInitLeftOver [])

1131+ PR.Done n b -> do

1132+ assert (n <= sum (map Array.length backBuf)) (return ())

1133+ let src0 = takeArrayListRev n backBuf

1134+ src = Prelude.reverse src0

1135+ return $ D.Skip $ ParseChunksYield b (ParseChunksInitBuf src)

1136+ PR.Error err -> throwM $ ParseError err

1137+

9631138 stepOuter _ (ParseChunksYield a next) = return $ D.Yield a next

9641139

9651140-- | Apply an 'ArrayFold' repeatedly on an array stream and emit the

src/Streamly/Internal/Unicode/Stream.hs+3−2

@@ -525,8 +525,9 @@ parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract

525525 extract (UTF8CharDecoding _ _) =

526526 case cfm of

527527 ErrorOnCodingFailure ->

528− throwM $ ParserD.ParseError $ prefix ++ "Not enough input"

529− TransliterateCodingFailure -> return replacementChar

528+ return $ ParserD.Error $ prefix ++ "Not enough input"

529+ TransliterateCodingFailure ->

530+ return (ParserD.Done 0 replacementChar)

530531 -- XXX We shouldn't error out here. There is no way to represent an

531532 -- empty parser result unless we return a "Maybe" type.

532533 DropOnCodingFailure -> error $ prefix ++ "Not enough input"

test/Streamly/Test/Data/Parser.hs+9−4

@@ -1,6 +1,6 @@

11module Main (main) where

3−import Control.Exception (SomeException(..), displayException)

3+import Control.Exception (SomeException(..), displayException, try)

44import Data.Foldable (for_)

55import Data.Word (Word8, Word32, Word64)

66import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)

@@ -195,13 +195,16 @@ takeBetween =

195195

196196 go m n ls =

197197 let inputLen = Prelude.length ls

198− in case S.parse (P.takeBetween m n FL.toList) (S.fromList ls) of

198+ in monadicIO $ do

199+ let p = P.takeBetween m n FL.toList

200+ r <- run $ try $ S.parse p (S.fromList ls)

201+ return $ case r of

199202 Right xs ->

200203 let parsedLen = Prelude.length xs

201204 in if inputLen >= m && parsedLen >= m && parsedLen <= n

202205 then checkListEqual xs $ Prelude.take parsedLen ls

203206 else property False

204− Left _ ->

207+ Left (_ :: SomeException) ->

205208 property ((m >= 0 && n >= 0 && m > n) || inputLen < m)

206209

207210takeEQPass :: Property

@@ -419,6 +422,7 @@ takeWhileP =

419422 (takeWhileTillLen n predicate ls)

420423 Left _ -> property False

421424

425+{-

422426choice :: Property

423427choice =

424428 forAll

@@ -434,6 +438,7 @@ choice =

434438 where

435439

436440 parser i = P.fromFold (FL.take i FL.toList)

441+-}

437442

438443groupBy :: Property

439444groupBy =

@@ -1179,7 +1184,7 @@ main =

11791184 prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy

11801185 prop "many (P.wordBy ' ') = words'" wordBy

11811186 parseManyWordQuotedBy

1182− prop "choice" choice

1187+ -- prop "choice" choice

11831188 -- prop "" splitWithPass

11841189 -- prop "" splitWithFailLeft

11851190 -- prop "" splitWithFailRight

test/Streamly/Test/Data/Parser/ParserD.hs+16−9

@@ -1,6 +1,6 @@

11module Main (main) where

3−import Control.Exception (SomeException(..))

3+import Control.Exception (SomeException(..), try)

44import Data.Word (Word8, Word32, Word64)

55import Streamly.Test.Common (listEquals, checkListEqual, chooseInt, equals)

66import Test.Hspec (Spec, hspec, describe)

@@ -175,16 +175,19 @@ takeBetween =

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

176176 let

177177 list_length = Prelude.length ls

178− in

179− case S.parseD (P.takeBetween m n FL.toList) (S.fromList ls) of

178+ in monadicIO $ do

179+ let p = P.takeBetween m n FL.toList

180+ r <- run $ try $ S.parseD p (S.fromList ls)

181+ return $ case r of

180182 Right parsed_list ->

181183 if m <= list_length && n >= m

182184 then

183− let lpl = Prelude.length parsed_list

184− in checkListEqual parsed_list (Prelude.take

185− lpl ls)

185+ let len = Prelude.length parsed_list

186+ in checkListEqual

187+ parsed_list (Prelude.take len ls)

186188 else property False

187− Left _ -> property (m > n || list_length < m)

189+ Left (_ :: SomeException) ->

190+ property (m > n || list_length < m)

188191

189192take :: Property

190193take =

@@ -417,6 +420,7 @@ splitWithFailBoth =

417420 Right _ -> False

418421 Left _ -> True)

419422

423+{-

420424teeWithPass :: Property

421425teeWithPass =

422426 forAll (chooseInt (min_value, max_value)) $ \n ->

@@ -511,6 +515,7 @@ longestFailBoth =

511515 (case S.parseD (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of

512516 Right _ -> False

513517 Left _ -> True)

518+-}

514519

515520many :: Property

516521many =

@@ -757,8 +762,8 @@ main =

757762 describe "test for sequence parser" $ do

758763 prop "P.takeBetween m n = Prelude.take when len >= m and len <= n"

759764 takeBetweenPass

760− prop "P.takeBetween m n = Prelude.take when len >= m and len <= n and\

761− \fail otherwise" takeBetween

765+ prop ("P.takeBetween m n = Prelude.take when len >= m and len <= n and"

766+ ++ " fail otherwise") takeBetween

762767 prop "P.take = Prelude.take" Main.take

763768 prop "P.takeEQ = Prelude.take when len >= n" takeEQPass

764769 prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ

@@ -776,6 +781,7 @@ main =

776781 prop "fail due to die as left parser" splitWithFailLeft

777782 prop "fail due to die as right parser" splitWithFailRight

778783 prop "fail due to die as both parsers" splitWithFailBoth

784+ {-

779785 prop "parsed two lists should be equal" teeWithPass

780786 prop "fail due to die as left parser" teeWithFailLeft

781787 prop "fail due to die as right parser" teeWithFailRight

@@ -788,6 +794,7 @@ main =

788794 prop "pass even if die is left parser" longestPassLeft

789795 prop "pass even if die is right parser" longestPassRight

790796 prop "fail due to die as both parsers" longestFailBoth

797+ -}

791798 prop "P.many concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" many

792799 prop "[] due to parser being die" many_empty

793800 prop "P.some concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" some