3a21b44 · streamly · git.iko.soy

git.iko.soy/streamly

Make parser result type either everywhere

* Change remaining parse/parseBreak/parseIterate functions * Fix benchmarks * Fix tests

commit3a21b44607fd710647adaa14a75d7dfd71081336 authorRanjeet Kumar Ranjan <ranjeetr@composewell.com> dateFri 18 Nov 2022, 20:05 (4 years ago) parent4f87668

23 files changed+489−397

compare with master

unifiedsplit

benchmark/Streamly/Benchmark/Data/Parser.hs+67−59

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

1010{-# LANGUAGE CPP #-}

1111{-# LANGUAGE FlexibleContexts #-}

1212{-# LANGUAGE ScopedTypeVariables #-}

13+{-# OPTIONS_GHC -Wno-orphans #-}

1314

1415module Main

1516 (

@@ -17,7 +18,6 @@ module Main

1718 ) where

1819

1920import Control.DeepSeq (NFData(..))

20−import Control.Monad.Catch (MonadCatch, MonadThrow, try, SomeException)

2121import Data.Foldable (asum)

2222import Data.Functor (($>))

2323import Data.Maybe (fromMaybe)

@@ -26,6 +26,7 @@ import GHC.Magic (inline)

2626import GHC.Magic (noinline)

2727import System.IO (Handle)

2828import System.Random (randomRIO)

29+import Streamly.Internal.Data.Parser (ParseError(..))

2930import Prelude hiding

3031 (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile)

3132

@@ -114,7 +115,7 @@ benchIOSink value name f =

114115-------------------------------------------------------------------------------

115116

116117{-# INLINE one #-}

117−one :: MonadThrow m => Int -> Stream m Int -> m (Maybe Int)

118+one :: Monad m => Int -> Stream m Int -> m (Either ParseError (Maybe Int))

118119one value = Stream.parse p

119120

120121 where

@@ -126,25 +127,25 @@ one value = Stream.parse p

126127 Nothing -> pure Nothing

127128

128129{-# INLINE takeBetween #-}

129−takeBetween :: MonadThrow m => Int -> Stream m a -> m ()

130−takeBetween value = Stream.parse (PR.takeBetween 0 value Fold.drain)

130+takeBetween :: Monad m => Int -> Stream m a -> m (Either ParseError ())

131+takeBetween value = Stream.parse (PR.takeBetween 0 value Fold.drain)

131132

132133{-# INLINE takeEQ #-}

133−takeEQ :: MonadThrow m => Int -> Stream m a -> m ()

134+takeEQ :: Monad m => Int -> Stream m a -> m (Either ParseError ())

134135takeEQ value = Stream.parse (PR.takeEQ value Fold.drain)

135136

136137{-# INLINE dropWhile #-}

137−dropWhile :: MonadThrow m => Int -> Stream m Int -> m ()

138+dropWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

138139dropWhile value = Stream.parse (PR.dropWhile (<= value))

139140

140141{-# INLINE takeStartBy #-}

141−takeStartBy :: MonadThrow m => Int -> Stream m Int -> m ()

142+takeStartBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

142143takeStartBy value stream = do

143144 stream1 <- return . fromMaybe (Stream.fromPure (value + 1)) =<< IsStream.tail stream

144145 let stream2 = value `Stream.cons` stream1

145146 Stream.parse (PR.takeStartBy (== value) Fold.drain) stream2

146147

147−takeFramedByEsc_ :: MonadThrow m => Int -> Stream m Char -> m ()

148+takeFramedByEsc_ :: Monad m => Int -> Stream m Char -> m (Either ParseError ())

148149takeFramedByEsc_ _ = Stream.parse parser

149150

150151 where

@@ -156,45 +157,45 @@ takeFramedByEsc_ _ = Stream.parse parser

156157 parser = PR.takeFramedByEsc_ isEsc isBegin isEnd Fold.drain

157158

158159{-# INLINE listEqBy #-}

159−listEqBy :: Int -> Stream IO Int -> IO [Int]

160+listEqBy :: Int -> Stream IO Int -> IO (Either ParseError [Int])

160161listEqBy len = Stream.parse (PR.listEqBy (==) [1 .. len])

161162

162163{-# INLINE eqBy #-}

163−eqBy :: Int -> Stream IO Int -> IO ()

164+eqBy :: Int -> Stream IO Int -> IO (Either ParseError ())

164165eqBy len = Stream.parse (PR.eqBy (==) (Stream.enumerateFromTo 1 len))

165166

166167{-# INLINE takeWhile #-}

167−takeWhile :: MonadThrow m => Int -> Stream m Int -> m ()

168+takeWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

168169takeWhile value = Stream.parse (PR.takeWhile (<= value) Fold.drain)

169170

170−takeWhileP :: MonadThrow m => Int -> Stream m Int -> m ()

171+takeWhileP :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

171172takeWhileP value =

172173 Stream.parse (PR.takeWhileP (<= value) (PR.takeWhile (<= value - 1) Fold.drain))

173174

174175{-# INLINE takeP #-}

175−takeP :: MonadThrow m => Int -> Stream m a -> m ()

176+takeP :: Monad m => Int -> Stream m a -> m (Either ParseError ())

176177takeP value = Stream.parse (PR.takeP value (PR.fromFold Fold.drain))

177178

178179{-# INLINE groupBy #-}

179−groupBy :: MonadThrow m => Stream m Int -> m ()

180+groupBy :: Monad m => Stream m Int -> m (Either ParseError ())

180181groupBy = Stream.parse (PR.groupBy (<=) Fold.drain)

181182

182183{-# INLINE groupByRolling #-}

183−groupByRolling :: MonadThrow m => Stream m Int -> m ()

184+groupByRolling :: Monad m => Stream m Int -> m (Either ParseError ())

184185groupByRolling = Stream.parse (PR.groupByRolling (<=) Fold.drain)

185186

186187{-# INLINE wordBy #-}

187−wordBy :: MonadThrow m => Int -> Stream m Int -> m ()

188+wordBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

188189wordBy value = Stream.parse (PR.wordBy (>= value) Fold.drain)

189190

190191{-# INLINE sepByWords #-}

191−sepByWords :: MonadThrow m => Int -> Stream m Int -> m ()

192+sepByWords :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

192193sepByWords _ = Stream.parse (wrds even Fold.drain)

193194 where

194195 wrds p = PR.sepBy (PR.takeWhile (not . p) Fold.drain) (PR.dropWhile p)

195196

196197{-# INLINE deintercalate #-}

197−deintercalate :: MonadThrow m => Int -> Stream m Int -> m ()

198+deintercalate :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

198199deintercalate _ = Stream.parse (partition even)

199200

200201 where

@@ -204,37 +205,37 @@ deintercalate _ = Stream.parse (partition even)

204205 (PR.takeWhile (not . p) Fold.sum) (PR.takeWhile p Fold.sum) Fold.drain

205206

206207{-# INLINE manyWordByEven #-}

207−manyWordByEven :: MonadThrow m => Stream m Int -> m ()

208+manyWordByEven :: Monad m => Stream m Int -> m (Either ParseError ())

208209manyWordByEven = Stream.parse (PR.many (PR.wordBy even Fold.drain) Fold.drain)

209210

210211{-# INLINE many #-}

211−many :: MonadThrow m => Stream m Int -> m Int

212+many :: Monad m => Stream m Int -> m (Either ParseError Int)

212213many = Stream.parse (PR.many (PR.satisfy (> 0)) Fold.length)

213214

214215{-# INLINE manyAlt #-}

215−manyAlt :: MonadThrow m => Stream m Int -> m Int

216+manyAlt :: Monad m => Stream m Int -> m Int

216217manyAlt xs = do

217218 x <- Stream.parse (AP.many (PR.satisfy (> 0))) xs

218219 return $ Prelude.length x

219220

220221{-# INLINE some #-}

221−some :: MonadThrow m => Stream m Int -> m Int

222+some :: Monad m => Stream m Int -> m (Either ParseError Int)

222223some = Stream.parse (PR.some (PR.satisfy (> 0)) Fold.length)

223224

224225{-# INLINE someAlt #-}

225−someAlt :: MonadThrow m => Stream m Int -> m Int

226+someAlt :: Monad m => Stream m Int -> m Int

226227someAlt xs = do

227228 x <- Stream.parse (AP.some (PR.satisfy (> 0))) xs

228229 return $ Prelude.length x

229230

230231{-# INLINE manyTill #-}

231−manyTill :: MonadThrow m => Int -> Stream m Int -> m Int

232+manyTill :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)

232233manyTill value =

233234 Stream.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) Fold.length)

234235

235236{-# INLINE splitAp #-}

236−splitAp :: MonadThrow m

237− => Int -> Stream m Int -> m ((), ())

237+splitAp :: Monad m

238+ => Int -> Stream m Int -> m (Either ParseError ((), ()))

238239splitAp value =

239240 Stream.parse

240241 ((,)

@@ -243,8 +244,8 @@ splitAp value =

243244 )

244245

245246{-# INLINE splitApBefore #-}

246−splitApBefore :: MonadThrow m

247− => Int -> Stream m Int -> m ()

247+splitApBefore :: Monad m

248+ => Int -> Stream m Int -> m (Either ParseError ())

248249splitApBefore value =

249250 Stream.parse

250251 ( PR.dropWhile (<= (value `div` 2))

@@ -252,8 +253,8 @@ splitApBefore value =

252253 )

253254

254255{-# INLINE splitApAfter #-}

255−splitApAfter :: MonadThrow m

256− => Int -> Stream m Int -> m ()

256+splitApAfter :: Monad m

257+ => Int -> Stream m Int -> m (Either ParseError ())

257258splitApAfter value =

258259 Stream.parse

259260 ( PR.dropWhile (<= (value `div` 2))

@@ -261,8 +262,8 @@ splitApAfter value =

261262 )

262263

263264{-# INLINE splitWith #-}

264−splitWith :: MonadThrow m

265− => Int -> Stream m Int -> m ((), ())

265+splitWith :: Monad m

266+ => Int -> Stream m Int -> m (Either ParseError ((), ()))

266267splitWith value =

267268 Stream.parse

268269 (PR.splitWith (,)

@@ -271,8 +272,8 @@ splitWith value =

271272 )

272273

273274{-# INLINE split_ #-}

274−split_ :: MonadThrow m

275− => Int -> Stream m Int -> m ()

275+split_ :: Monad m

276+ => Int -> Stream m Int -> m (Either ParseError ())

276277split_ value =

277278 Stream.parse

278279 (PR.split_

@@ -281,13 +282,13 @@ split_ value =

281282 )

282283

283284{-# INLINE takeEndBy_ #-}

284−takeEndBy_ :: MonadThrow m

285− => Int -> Stream m Int -> m()

285+takeEndBy_ :: Monad m

286+ => Int -> Stream m Int -> m (Either ParseError ())

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

287288

288289{-

289290{-# INLINE teeAllAny #-}

290−teeAllAny :: MonadThrow m

291+teeAllAny :: Monad m

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

292293teeAllAny value =

293294 Stream.parse

@@ -297,7 +298,7 @@ teeAllAny value =

297298 )

298299

299300{-# INLINE teeFstAllAny #-}

300−teeFstAllAny :: MonadThrow m

301+teeFstAllAny :: Monad m

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

302303teeFstAllAny value =

303304 Stream.parse

@@ -307,8 +308,8 @@ teeFstAllAny value =

307308 )

308309

309310{-# INLINE shortestAllAny #-}

310−shortestAllAny :: MonadThrow m

311− => Int -> Stream m Int -> m ()

311+shortestAllAny :: Monad m

312+ => Int -> Stream m Int -> m (Either ParseError ())

312313shortestAllAny value =

313314 Stream.parse

314315 (PR.shortest

@@ -317,8 +318,8 @@ shortestAllAny value =

317318 )

318319

319320{-# INLINE longestAllAny #-}

320−longestAllAny :: MonadThrow m

321− => Int -> Stream m Int -> m ()

321+longestAllAny :: Monad m

322+ => Int -> Stream m Int -> m (Either ParseError ())

322323longestAllAny value =

323324 Stream.parse

324325 (PR.longest

@@ -359,41 +360,41 @@ parseManyUnfoldArrays count arrays = do

359360-- not have to rely on it.

360361--

361362{-# INLINE lookAhead #-}

362−lookAhead :: MonadThrow m => Int -> Stream m Int -> m ()

363+lookAhead :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

363364lookAhead value =

364365 Stream.parse (PR.lookAhead (PR.takeWhile (<= value) Fold.drain) $> ())

365366

366367{-# INLINE sequenceA #-}

367−sequenceA :: MonadThrow m => Int -> Stream m Int -> m Int

368+sequenceA :: Monad m => Int -> Stream m Int -> m Int

368369sequenceA value xs = do

369370 x <- Stream.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs

370371 return $ length x

371372

372373{-# INLINE sequenceA_ #-}

373−sequenceA_ :: MonadThrow m => Int -> Stream m Int -> m ()

374+sequenceA_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

374375sequenceA_ value =

375376 Stream.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))

376377

377378{-# INLINE sequence #-}

378−sequence :: MonadThrow m => Int -> Stream m Int -> m Int

379+sequence :: Monad m => Int -> Stream m Int -> m Int

379380sequence value xs = do

380381 x <- Stream.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs

381382 return $ length x

382383

383384{-# INLINE sequence_ #-}

384−sequence_ :: MonadThrow m => Int -> Stream m Int -> m ()

385+sequence_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

385386sequence_ value =

386387 Stream.parse (F.sequence_ $ replicate value (PR.satisfy (> 0)))

387388

388389{-# INLINE choiceAsum #-}

389−choiceAsum :: MonadThrow m => Int -> Stream m Int -> m Int

390+choiceAsum :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)

390391choiceAsum value =

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

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

393394

394395{-

395396{-# INLINE choice #-}

396−choice :: MonadThrow m => Int -> Stream m Int -> m Int

397+choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)

397398choice value =

398399 Stream.parse

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

@@ -404,35 +405,38 @@ choice value =

404405-------------------------------------------------------------------------------

405406

406407{-# INLINE parseMany #-}

407−parseMany :: MonadThrow m => Int -> Stream m Int -> m ()

408+parseMany :: Monad m => Int -> Stream m Int -> m ()

408409parseMany n =

409410 Stream.fold Fold.drain

410411 . fmap getSum

411− . Stream.parseMany (PR.fromFold $ Fold.take n Fold.mconcat)

412+ . Stream.rights . Stream.parseMany (PR.fromFold $ Fold.take n Fold.mconcat)

412413 . fmap Sum

413414

414415{-# INLINE parseIterate #-}

415−parseIterate :: MonadThrow m => Int -> Stream m Int -> m ()

416+parseIterate :: Monad m => Int -> Stream m Int -> m ()

416417parseIterate n =

417418 Stream.fold Fold.drain

418419 . fmap getSum

419− . Stream.parseIterate (PR.fromFold . Fold.take n . Fold.sconcat) (Sum 0)

420+ . Stream.rights

421+ . Stream.parseIterate

422+ (PR.fromFold . Fold.take n . Fold.sconcat)

423+ (Sum 0)

420424 . fmap Sum

421425

422426{-# INLINE parseBreak #-}

423−parseBreak :: MonadCatch m => Stream m Int -> m ()

427+parseBreak :: Monad m => Stream m Int -> m ()

424428parseBreak s = do

425− r <- try $ Stream.parseBreak PR.one s

429+ r <- Stream.parseBreak PR.one s

426430 case r of

427− Left (_ :: SomeException) -> return ()

428− Right (_, s1) -> parseBreak s1

431+ (Left _, _) -> return ()

432+ (Right _, s1) -> parseBreak s1

429433

430434{-# INLINE concatSequence #-}

431−concatSequence :: MonadThrow m => Stream m Int -> m ()

435+concatSequence :: Monad m => Stream m Int -> m (Either ParseError ())

432436concatSequence = Stream.parse $ PR.concatSequence Fold.drain $ Stream.repeat PR.one

433437

434438{-# INLINE parseManyGroupBy #-}

435−parseManyGroupBy :: MonadThrow m => (Int -> Int -> Bool) -> Stream m Int -> m ()

439+parseManyGroupBy :: Monad m => (Int -> Int -> Bool) -> Stream m Int -> m ()

436440parseManyGroupBy cmp =

437441 Stream.fold Fold.drain . Stream.parseMany (PR.groupBy cmp Fold.drain)

438442

@@ -443,6 +447,10 @@ parseManyGroupBy cmp =

443447moduleName :: String

444448moduleName = "Data.Parser"

445449

450+instance NFData ParseError where

451+ {-# INLINE rnf #-}

452+ rnf (ParseError x) = rnf x

453+

446454o_1_space_serial :: Int -> [Benchmark]

447455o_1_space_serial value =

448456 [ benchIOSink value "one (fold)" $ one value

benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs+45−40

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

1010{-# LANGUAGE FlexibleContexts #-}

1111{-# LANGUAGE ScopedTypeVariables #-}

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

13+{-# OPTIONS_GHC -Wno-orphans #-}

1314

1415module Main

1516 (

@@ -17,12 +18,12 @@ module Main

1718 ) where

1819

1920import Control.DeepSeq (NFData(..))

20−import Control.Monad.Catch (MonadThrow)

2121import Data.Foldable (asum)

2222import Data.Function ((&))

2323import Data.Functor (($>))

2424import Data.Maybe (fromMaybe)

2525import Streamly.Internal.Data.Stream (Stream)

26+import Streamly.Internal.Data.Parser (ParseError(..))

2627import System.Random (randomRIO)

2728import Prelude hiding (any, all, take, sequence, sequenceA, sequence_, takeWhile, span)

2829

@@ -69,87 +70,87 @@ benchIOSink value name f =

6970-------------------------------------------------------------------------------

7071

7172{-# INLINE listEqBy #-}

72−listEqBy :: Int -> Stream IO Int -> IO [Int]

73+listEqBy :: Int -> Stream IO Int -> IO (Either ParseError [Int])

7374listEqBy len = Stream.parseD (PR.listEqBy (==) [1 .. len])

7475

7576{-# INLINE eqBy #-}

76−eqBy :: Int -> Stream IO Int -> IO ()

77+eqBy :: Int -> Stream IO Int -> IO (Either ParseError ())

7778eqBy len = Stream.parseD (PR.eqBy (==) (D.enumerateFromToIntegral 1 len))

7879

7980{-# INLINE drainWhile #-}

80−drainWhile :: MonadThrow m => (a -> Bool) -> PR.Parser a m ()

81+drainWhile :: Monad m => (a -> Bool) -> PR.Parser a m ()

8182drainWhile p = PR.takeWhile p Fold.drain

8283

8384{-# INLINE takeStartBy #-}

84−takeStartBy :: MonadThrow m => Int -> Stream m Int -> m ()

85+takeStartBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

8586takeStartBy value stream = do

8687 stream1 <- return . fromMaybe (Stream.fromPure (value + 1)) =<< IsStream.tail stream

8788 let stream2 = value `Stream.cons` stream1

8889 Stream.parseD (PR.takeStartBy (== value) Fold.drain) stream2

8990

9091{-# INLINE takeWhile #-}

91−takeWhile :: MonadThrow m => Int -> Stream m Int -> m ()

92+takeWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

9293takeWhile value = Stream.parseD (drainWhile (<= value))

9394

9495{-# INLINE takeP #-}

95−takeP :: MonadThrow m => Int -> Stream m a -> m ()

96+takeP :: Monad m => Int -> Stream m a -> m (Either ParseError ())

9697takeP value = Stream.parseD (PR.takeP value (PR.fromFold Fold.drain))

9798

9899{-# INLINE takeBetween #-}

99−takeBetween :: MonadThrow m => Int -> Stream m a -> m ()

100+takeBetween :: Monad m => Int -> Stream m a -> m (Either ParseError ())

100101takeBetween value = Stream.parseD (PR.takeBetween 0 value Fold.drain)

101102

102103{-# INLINE groupBy #-}

103−groupBy :: MonadThrow m => Stream m Int -> m ()

104+groupBy :: Monad m => Stream m Int -> m (Either ParseError ())

104105groupBy = Stream.parseD (PR.groupBy (<=) Fold.drain)

105106

106107{-# INLINE groupByRolling #-}

107−groupByRolling :: MonadThrow m => Stream m Int -> m ()

108+groupByRolling :: Monad m => Stream m Int -> m (Either ParseError ())

108109groupByRolling = Stream.parseD (PR.groupByRolling (<=) Fold.drain)

109110

110111{-# INLINE wordBy #-}

111−wordBy :: MonadThrow m => Int -> Stream m Int -> m ()

112+wordBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

112113wordBy value = Stream.parseD (PR.wordBy (>= value) Fold.drain)

113114

114115{-# INLINE manyWordByEven #-}

115−manyWordByEven :: MonadThrow m => Stream m Int -> m ()

116+manyWordByEven :: Monad m => Stream m Int -> m (Either ParseError ())

116117manyWordByEven =

117118 Stream.parseD (PR.many (PR.wordBy (Prelude.even) Fold.drain) Fold.drain)

118119

119120{-# INLINE many #-}

120−many :: MonadThrow m => Stream m Int -> m Int

121+many :: Monad m => Stream m Int -> m (Either ParseError Int)

121122many = Stream.parseD (PR.many (PR.satisfy (> 0)) Fold.length)

122123

123124{-# INLINE manyAlt #-}

124−manyAlt :: MonadThrow m => Stream m Int -> m Int

125+manyAlt :: Monad m => Stream m Int -> m Int

125126manyAlt xs = do

126127 x <- Stream.parseD (AP.many (PR.satisfy (> 0))) xs

127128 return $ Prelude.length x

128129

129130{-# INLINE some #-}

130−some :: MonadThrow m => Stream m Int -> m Int

131+some :: Monad m => Stream m Int -> m (Either ParseError Int)

131132some = Stream.parseD (PR.some (PR.satisfy (> 0)) Fold.length)

132133

133134{-# INLINE someAlt #-}

134−someAlt :: MonadThrow m => Stream m Int -> m Int

135+someAlt :: Monad m => Stream m Int -> m Int

135136someAlt xs = do

136137 x <- Stream.parseD (AP.some (PR.satisfy (> 0))) xs

137138 return $ Prelude.length x

138139

139140{-#INLINE takeEndBy_ #-}

140−takeEndBy_ :: MonadThrow m => Int -> Stream m Int -> m ()

141+takeEndBy_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

141142takeEndBy_ value = Stream.parseD (PR.takeEndBy_ (>= value) (PR.fromFold Fold.drain))

142143

143144{-# INLINE manyTill #-}

144−manyTill :: MonadThrow m => Int -> Stream m Int -> m Int

145+manyTill :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)

145146manyTill value =

146147 let p = PR.satisfy (> 0)

147148 pcond = PR.satisfy (== value)

148149 in Stream.parseD (PR.manyTill p pcond Fold.length)

149150

150151{-# INLINE splitWith #-}

151−splitWith :: MonadThrow m

152− => Int -> Stream m Int -> m ((), ())

152+splitWith :: Monad m

153+ => Int -> Stream m Int -> m (Either ParseError ((), ()))

153154splitWith value =

154155 Stream.parseD

155156 ((,)

@@ -159,7 +160,7 @@ splitWith value =

159160

160161{-

161162{-# INLINE teeAllAny #-}

162−teeAllAny :: MonadThrow m

163+teeAllAny :: Monad m

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

164165teeAllAny value =

165166 Stream.parseD

@@ -169,7 +170,7 @@ teeAllAny value =

169170 )

170171

171172{-# INLINE teeFstAllAny #-}

172−teeFstAllAny :: MonadThrow m

173+teeFstAllAny :: Monad m

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

174175teeFstAllAny value =

175176 Stream.parseD

@@ -179,7 +180,7 @@ teeFstAllAny value =

179180 )

180181

181182{-# INLINE shortestAllAny #-}

182−shortestAllAny :: MonadThrow m

183+shortestAllAny :: Monad m

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

184185shortestAllAny value =

185186 Stream.parseD

@@ -189,7 +190,7 @@ shortestAllAny value =

189190 )

190191

191192{-# INLINE longestAllAny #-}

192−longestAllAny :: MonadThrow m

193+longestAllAny :: Monad m

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

194195longestAllAny value =

195196 Stream.parseD

@@ -200,7 +201,7 @@ longestAllAny value =

200201-}

201202

202203{-# INLINE sequenceParser #-}

203−sequenceParser :: MonadThrow m => Stream m Int -> m ()

204+sequenceParser :: Monad m => Stream m Int -> m (Either ParseError ())

204205sequenceParser = Stream.parseD (PR.sequence (D.repeat (PR.satisfy $ const True)) Fold.drain)

205206

206207-------------------------------------------------------------------------------

@@ -208,16 +209,16 @@ sequenceParser = Stream.parseD (PR.sequence (D.repeat (PR.satisfy $ const True))

208209-------------------------------------------------------------------------------

209210

210211{-# INLINE span #-}

211−span :: MonadThrow m => Int -> Stream m Int -> m ((), ())

212+span :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))

212213span value = Stream.parseD (PR.span (<= (value `div` 2)) Fold.drain Fold.drain)

213214

214215{-# INLINE spanBy #-}

215−spanBy :: MonadThrow m => Int -> Stream m Int -> m ((), ())

216+spanBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))

216217spanBy value =

217218 Stream.parseD (PR.spanBy (\_ i -> i <= (value `div` 2)) Fold.drain Fold.drain)

218219

219220{-# INLINE spanByRolling #-}

220−spanByRolling :: MonadThrow m => Int -> Stream m Int -> m ((), ())

221+spanByRolling :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))

221222spanByRolling value =

222223 Stream.parseD (PR.spanByRolling (\_ i -> i <= value `div` 2) Fold.drain Fold.drain)

223224

@@ -226,20 +227,20 @@ spanByRolling value =

226227-------------------------------------------------------------------------------

227228

228229{-# INLINE parseMany #-}

229−parseMany :: MonadThrow m => Int -> Stream m Int -> m ()

230+parseMany :: Monad m => Int -> Stream m Int -> m ()

230231parseMany value = Stream.fold Fold.drain . Stream.parseManyD (drainWhile (<= value + 1))

231232

232233{-# INLINE parseManyGroups #-}

233−parseManyGroups :: MonadThrow m => Bool -> Stream m Int -> m ()

234+parseManyGroups :: Monad m => Bool -> Stream m Int -> m ()

234235parseManyGroups b = Stream.fold Fold.drain . Stream.parseManyD (PR.groupBy (\_ _ -> b) Fold.drain)

235236

236237{-# INLINE parseManyGroupsRolling #-}

237−parseManyGroupsRolling :: MonadThrow m => Bool -> Stream m Int -> m ()

238+parseManyGroupsRolling :: Monad m => Bool -> Stream m Int -> m ()

238239parseManyGroupsRolling b =

239240 Stream.fold Fold.drain . Stream.parseManyD (PR.groupByRolling (\_ _ -> b) Fold.drain)

240241

241242{-# INLINE parseManyGroupsRollingEither #-}

242−parseManyGroupsRollingEither :: MonadThrow m =>

243+parseManyGroupsRollingEither :: Monad m =>

243244 (Int -> Int -> Bool) -> Int -> m ()

244245parseManyGroupsRollingEither cmp value = do

245246 sourceUnfoldrM value 1

@@ -247,7 +248,7 @@ parseManyGroupsRollingEither cmp value = do

247248 & Stream.fold Fold.drain

248249

249250{-# INLINE parseManyGroupsRollingEitherAlt #-}

250−parseManyGroupsRollingEitherAlt :: MonadThrow m =>

251+parseManyGroupsRollingEitherAlt :: Monad m =>

251252 (Int -> Int -> Bool) -> Int -> m ()

252253parseManyGroupsRollingEitherAlt cmp value = do

253254 sourceUnfoldrM value 1

@@ -281,32 +282,32 @@ parseManyUnfoldArrays count arrays = do

281282-- not have to rely on it.

282283--

283284{-# INLINE lookAhead #-}

284−lookAhead :: MonadThrow m => Int -> Stream m Int -> m ()

285+lookAhead :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

285286lookAhead value =

286287 Stream.parseD (PR.lookAhead (PR.takeWhile (<= value) Fold.drain) $> ())

287288

288289-- XXX The timing of this increased 3x after the stepify extract changes.

289290{-# INLINE sequenceA_ #-}

290−sequenceA_ :: MonadThrow m => Int -> Stream m Int -> m ()

291+sequenceA_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

291292sequenceA_ value =

292293 Stream.parseD (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))

293294

294295-- quadratic complexity

295296{-# INLINE sequenceA #-}

296−sequenceA :: MonadThrow m => Int -> Stream m Int -> m Int

297+sequenceA :: Monad m => Int -> Stream m Int -> m Int

297298sequenceA value xs = do

298299 x <- Stream.parseD (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs

299300 return $ length x

300301

301302-- quadratic complexity

302303{-# INLINE sequence #-}

303−sequence :: MonadThrow m => Int -> Stream m Int -> m Int

304+sequence :: Monad m => Int -> Stream m Int -> m Int

304305sequence value xs = do

305306 x <- Stream.parseD (TR.sequence (replicate value (PR.satisfy (> 0)))) xs

306307 return $ length x

307308

308309{-# INLINE sequence_ #-}

309−sequence_ :: MonadThrow m => Int -> Stream m Int -> m ()

310+sequence_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

310311sequence_ value xs =

311312 Stream.parseD (foldr f (return ()) (replicate value (PR.takeBetween 0 1 Fold.drain))) xs

312313

@@ -319,14 +320,14 @@ sequence_ value xs =

319320-- quadratic performance complexity.

320321--

321322{-# INLINE choiceAsum #-}

322−choiceAsum :: MonadThrow m => Int -> Stream m Int -> m Int

323+choiceAsum :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)

323324choiceAsum value =

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

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

326327

327328{-

328329{-# INLINE choice #-}

329−choice :: MonadThrow m => Int -> Stream m Int -> m Int

330+choice :: Monad m => Int -> Stream m Int -> m Int

330331choice value =

331332 Stream.parseD

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

@@ -339,6 +340,10 @@ choice value =

339340moduleName :: String

340341moduleName = "Data.Parser.ParserD"

341342

343+instance NFData ParseError where

344+ {-# INLINE rnf #-}

345+ rnf (ParseError x) = rnf x

346+

342347o_1_space_serial :: Int -> [Benchmark]

343348o_1_space_serial value =

344349 [ benchIOSink value "takeWhile" $ takeWhile value

benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+15−10

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

88{-# LANGUAGE CPP #-}

99{-# LANGUAGE FlexibleContexts #-}

10+{-# OPTIONS_GHC -Wno-orphans #-}

1011

1112module Main

1213 (

@@ -14,8 +15,8 @@ module Main

1415 ) where

1516

1617import Control.DeepSeq (NFData(..))

17−import Control.Monad.Catch (MonadThrow)

1818import Data.Foldable (asum)

19+import Streamly.Internal.Data.Parser (ParseError(..))

1920import Streamly.Internal.Data.Stream (Stream)

2021import System.Random (randomRIO)

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

@@ -73,17 +74,17 @@ takeWhile :: Monad m => (a -> Bool) -> PR.Parser a m ()

7374takeWhile p = PRD.toParserK $ PRD.takeWhile p FL.drain

7475

7576{-# INLINE takeWhileK #-}

76−takeWhileK :: MonadThrow m => Int -> Stream m Int -> m ()

77+takeWhileK :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

7778takeWhileK value = PARSE_OP (takeWhile (<= value))

7879

7980{-# INLINE splitApp #-}

80−splitApp :: MonadThrow m

81− => Int -> Stream m Int -> m ((), ())

81+splitApp :: Monad m

82+ => Int -> Stream m Int -> m (Either ParseError ((), ()))

8283splitApp value =

8384 PARSE_OP ((,) <$> takeWhile (<= (value `div` 2)) <*> takeWhile (<= value))

8485

8586{-# INLINE sequenceA #-}

86−sequenceA :: MonadThrow m => Int -> Stream m Int -> m Int

87+sequenceA :: Monad m => Int -> Stream m Int -> m Int

8788sequenceA value xs = do

8889 let parser = satisfy (> 0)

8990 list = Prelude.replicate value parser

@@ -91,14 +92,14 @@ sequenceA value xs = do

9192 return $ Prelude.length x

9293

9394{-# INLINE sequenceA_ #-}

94−sequenceA_ :: MonadThrow m => Int -> Stream m Int -> m ()

95+sequenceA_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

9596sequenceA_ value xs = do

9697 let parser = satisfy (> 0)

9798 list = Prelude.replicate value parser

9899 PARSE_OP (F.sequenceA_ list) xs

99100

100101{-# INLINE sequence #-}

101−sequence :: MonadThrow m => Int -> Stream m Int -> m Int

102+sequence :: Monad m => Int -> Stream m Int -> m Int

102103sequence value xs = do

103104 let parser = satisfy (> 0)

104105 list = Prelude.replicate value parser

@@ -106,19 +107,19 @@ sequence value xs = do

106107 return $ Prelude.length x

107108

108109{-# INLINE manyAlt #-}

109−manyAlt :: MonadThrow m => Stream m Int -> m Int

110+manyAlt :: Monad m => Stream m Int -> m Int

110111manyAlt xs = do

111112 x <- PARSE_OP (AP.many (satisfy (> 0))) xs

112113 return $ Prelude.length x

113114

114115{-# INLINE someAlt #-}

115−someAlt :: MonadThrow m => Stream m Int -> m Int

116+someAlt :: Monad m => Stream m Int -> m Int

116117someAlt xs = do

117118 x <- PARSE_OP (AP.some (satisfy (> 0))) xs

118119 return $ Prelude.length x

119120

120121{-# INLINE choice #-}

121−choice :: MonadThrow m => Int -> Stream m Int -> m Int

122+choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)

122123choice value =

123124 PARSE_OP (asum (replicate value (satisfy (< 0)))

124125 AP.<|> satisfy (> 0))

@@ -130,6 +131,10 @@ choice value =

130131moduleName :: String

131132moduleName = "Data.Parser.ParserK"

132133

134+instance NFData ParseError where

135+ {-# INLINE rnf #-}

136+ rnf (ParseError x) = rnf x

137+

133138o_1_space_serial :: Int -> [Benchmark]

134139o_1_space_serial value =

135140 [ benchIOSink value "takeWhile" $ takeWhileK value

benchmark/Streamly/Benchmark/Unicode/Stream.hs+1−1

@@ -280,7 +280,7 @@ _copyStreamUtf8Parser :: Handle -> Handle -> IO ()

280280_copyStreamUtf8Parser inh outh =

281281 Stream.fold (Handle.write outh)

282282 $ Unicode.encodeUtf8

283− $ Stream.parseMany

283+ $ Stream.rights $ Stream.parseMany

284284 (Unicode.parseCharUtf8With Unicode.TransliterateCodingFailure)

285285 $ Stream.unfold Handle.reader inh

286286

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

@@ -29,11 +29,11 @@ where

2929

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

3131import Control.Monad (when)

32−import Control.Monad.Catch (MonadThrow)

3332import Data.Bifunctor (first)

3433import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)

3534import Streamly.Internal.Data.Array.Mut.Type (Array(..))

3635import Streamly.Internal.Data.Fold.Type (Fold(..))

36+import Streamly.Internal.Data.Parser (ParseError)

3737import Streamly.Internal.Data.Stream.Type (Stream)

3838import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))

3939

@@ -298,8 +298,8 @@ compactGEFold n = Fold step initial extract

298298-- maximum specified size in bytes.

299299--

300300-- /Internal/

301−compactLE :: (MonadThrow m, MonadIO m, Unbox a) =>

302− Int -> Stream m (Array a) -> Stream m (Array a)

301+compactLE :: (Monad m, MonadIO m, Unbox a) =>

302+ Int -> Stream m (Array a) -> Stream m (Either ParseError (Array a))

303303compactLE n =

304304 Stream.fromStreamD . D.parseMany (compactLEParserD n) . Stream.toStreamD

305305

core/src/Streamly/Internal/Data/Parser.hs+38−38

@@ -365,7 +365,7 @@ dieM = D.toParserK . D.dieM

365365-- | @lmap f parser@ maps the function @f@ on the input of the parser.

366366--

367367-- >>> Stream.parse (Parser.lmap (\x -> x * x) (Parser.fromFold Fold.sum)) (Stream.enumerateFromTo 1 100)

368−-- 338350

368+-- Right 338350

369369--

370370-- > lmap = Parser.lmapM return

371371--

@@ -389,7 +389,7 @@ rmapM f p = D.toParserK $ D.rmapM f $ D.fromParserK p

389389-- | Include only those elements that pass a predicate.

390390--

391391-- >>> Stream.parse (Parser.filter (> 5) (Parser.fromFold Fold.sum)) $ Stream.fromList [1..10]

392−-- 40

392+-- Right 40

393393--

394394{-# INLINE filter #-}

395395filter :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b

@@ -403,7 +403,7 @@ filter f p = D.toParserK $ D.filter f $ D.fromParserK p

403403-- encounters end of input.

404404--

405405-- >>> Stream.parse ((,) <$> Parser.peek <*> Parser.satisfy (> 0)) $ Stream.fromList [1]

406−-- (1,1)

406+-- Right (1,1)

407407--

408408-- @

409409-- peek = lookAhead (satisfy True)

@@ -416,7 +416,7 @@ peek = D.toParserK D.peek

416416-- | Succeeds if we are at the end of input, fails otherwise.

417417--

418418-- >>> Stream.parse ((,) <$> Parser.satisfy (> 0) <*> Parser.eof) $ Stream.fromList [1]

419−-- (1,())

419+-- Right (1,())

420420--

421421{-# INLINE eof #-}

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

@@ -425,7 +425,7 @@ eof = D.toParserK D.eof

425425-- | Returns the next element if it passes the predicate, fails otherwise.

426426--

427427-- >>> Stream.parse (Parser.satisfy (== 1)) $ Stream.fromList [1,0,1]

428−-- 1

428+-- Right 1

429429--

430430-- >>> toMaybe f x = if f x then Just x else Nothing

431431-- >>> satisfy f = Parser.maybe (toMaybe f)

@@ -551,19 +551,19 @@ either = D.toParserK . D.either

551551-- @

552552--

553553-- >>> takeBetween' 2 4 [1, 2, 3, 4, 5]

554−-- [1,2,3,4]

554+-- Right [1,2,3,4]

555555--

556556-- >>> takeBetween' 2 4 [1, 2]

557−-- [1,2]

557+-- Right [1,2]

558558--

559559-- >>> takeBetween' 2 4 [1]

560−-- *** Exception: ParseError "takeBetween: Expecting alteast 2 elements, got 1"

560+-- Left (ParseError "takeBetween: Expecting alteast 2 elements, got 1")

561561--

562562-- >>> takeBetween' 0 0 [1, 2]

563−-- []

563+-- Right []

564564--

565565-- >>> takeBetween' 0 1 []

566−-- []

566+-- Right []

567567--

568568-- @takeBetween@ is the most general take operation, other take operations can

569569-- be defined in terms of takeBetween. For example:

@@ -586,7 +586,7 @@ takeBetween m n = D.toParserK . D.takeBetween m n

586586-- exactly @n@ elements.

587587--

588588-- >>> Stream.parse (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1]

589−-- *** Exception: ParseError "takeEQ: Expecting exactly 4 elements, input terminated on 3"

589+-- Left (ParseError "takeEQ: Expecting exactly 4 elements, input terminated on 3")

590590--

591591{-# INLINE takeEQ #-}

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

@@ -599,10 +599,10 @@ takeEQ n = D.toParserK . D.takeEQ n

599599-- elements.

600600--

601601-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1]

602−-- *** Exception: ParseError "takeGE: Expecting at least 4 elements, input terminated on 3"

602+-- Left (ParseError "takeGE: Expecting at least 4 elements, input terminated on 3")

603603--

604604-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1,0,1]

605−-- [1,0,1,0,1]

605+-- Right [1,0,1,0,1]

606606--

607607-- /Pre-release/

608608--

@@ -644,7 +644,7 @@ takeWhileP cond p = D.toParserK $ D.takeWhileP cond (D.fromParserK p)

644644-- * Fails - never.

645645--

646646-- >>> Stream.parse (Parser.takeWhile (== 0) Fold.toList) $ Stream.fromList [0,0,1,0,1]

647−-- [0,0]

647+-- Right [0,0]

648648--

649649-- >>> takeWhile cond f = Parser.takeWhileP cond (Parser.fromFold f)

650650--

@@ -752,14 +752,14 @@ takeEitherSepBy _cond = undefined -- D.toParserK . D.takeEitherSepBy cond

752752-- >>> p = Parser.takeStartBy (== ',') Fold.toList

753753-- >>> leadingComma = Stream.parse p . Stream.fromList

754754-- >>> leadingComma "a,b"

755−-- *** Exception: ParseError "takeStartBy: missing frame start"

755+-- Left (ParseError "takeStartBy: missing frame start")

756756-- ...

757757-- >>> leadingComma ",,"

758−-- ","

758+-- Right ","

759759-- >>> leadingComma ",a,b"

760−-- ",a"

760+-- Right ",a"

761761-- >>> leadingComma ""

762−-- ""

762+-- Right ""

763763--

764764-- /Pre-release/

765765--

@@ -802,13 +802,13 @@ takeEndByEsc isEsc isEnd p =

802802--

803803-- >>> p = Parser.takeFramedByEsc_ (== '\\') (== '{') (== '}') Fold.toList

804804-- >>> Stream.parse p $ Stream.fromList "{hello}"

805−-- "hello"

805+-- Right "hello"

806806-- >>> Stream.parse p $ Stream.fromList "{hello {world}}"

807−-- "hello {world}"

807+-- Right "hello {world}"

808808-- >>> Stream.parse p $ Stream.fromList "{hello \\{world}"

809−-- "hello {world"

809+-- Right "hello {world"

810810-- >>> Stream.parse p $ Stream.fromList "{hello {world}"

811−-- *** Exception: ParseError "takeFramedByEsc_: missing frame end"

811+-- Left (ParseError "takeFramedByEsc_: missing frame end")

812812--

813813-- /Pre-release/

814814{-# INLINE takeFramedByEsc_ #-}

@@ -865,17 +865,17 @@ wordBy f = D.toParserK . D.wordBy f

865865--

866866-- >>> braces = Parser.wordFramedBy (== '\\') (== '{') (== '}') isSpace Fold.toList

867867-- >>> Stream.parse braces $ Stream.fromList "{ab} cd"

868−-- "ab"

868+-- Right "ab"

869869-- >>> Stream.parse braces $ Stream.fromList "{ab}{cd}"

870−-- "abcd"

870+-- Right "abcd"

871871-- >>> Stream.parse braces $ Stream.fromList "a{b} cd"

872−-- "ab"

872+-- Right "ab"

873873-- >>> Stream.parse braces $ Stream.fromList "a{{b}} cd"

874−-- "a{b}"

874+-- Right "a{b}"

875875--

876876-- >>> quotes = Parser.wordFramedBy (== '\\') (== '"') (== '"') isSpace Fold.toList

877877-- >>> Stream.parse quotes $ Stream.fromList "\"a\"\"b\""

878−-- "ab"

878+-- Right "ab"

879879--

880880{-# INLINE wordFramedBy #-}

881881wordFramedBy :: Monad m =>

@@ -903,10 +903,10 @@ wordFramedBy isEsc isBegin isEnd isSpc =

903903-- >>> p kQ = Parser.wordQuotedBy kQ (== '\\') q q id isSpace Fold.toList

904904--

905905-- >>> Stream.parse (p False) $ Stream.fromList "a\"b'c\";'d\"e'f ghi"

906−-- "ab'c;d\"ef"

906+-- Right "ab'c;d\"ef"

907907--

908908-- >>> Stream.parse (p True) $ Stream.fromList "a\"b'c\";'d\"e'f ghi"

909−-- "a\"b'c\";'d\"e'f"

909+-- Right "a\"b'c\";'d\"e'f"

910910--

911911{-# INLINE wordQuotedBy #-}

912912wordQuotedBy :: (Monad m, Eq a) =>

@@ -942,10 +942,10 @@ wordQuotedBy keepQuotes isEsc isBegin isEnd toRight isSpc =

942942-- []

943943--

944944-- >>> runGroupsBy (<) [1]

945−-- [[1]]

945+-- [Right [1]]

946946--

947947-- >>> runGroupsBy (<) [3, 5, 4, 1, 2, 0]

948−-- [[3,5,4],[1,2],[0]]

948+-- [Right [3,5,4],Right [1,2],Right [0]]

949949--

950950{-# INLINE groupBy #-}

951951groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b

@@ -974,10 +974,10 @@ groupBy eq = D.toParserK . D.groupBy eq

974974-- []

975975--

976976-- >>> runGroupsByRolling (<) [1]

977−-- [[1]]

977+-- [Right [1]]

978978--

979979-- >>> runGroupsByRolling (<) [3, 5, 4, 1, 2, 0]

980−-- [[3,5],[4],[1,2],[0]]

980+-- [Right [3,5],Right [4],Right [1,2],Right [0]]

981981--

982982-- /Pre-release/

983983--

@@ -1023,10 +1023,10 @@ eqBy cmp = D.toParserK . D.eqBy cmp . Stream.toStreamD

10231023-- Examples:

10241024--

10251025-- >>> Stream.parse (Parser.listEqBy (==) "string") $ Stream.fromList "string"

1026−-- "string"

1026+-- Right "string"

10271027--

10281028-- >>> Stream.parse (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match"

1029−-- *** Exception: ParseError "eqBy: mismtach occurred"

1029+-- Left (ParseError "eqBy: mismtach occurred")

10301030--

10311031{-# INLINE listEqBy #-}

10321032listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]

@@ -1186,7 +1186,7 @@ teeWithMin f p1 p2 =

11861186-- will fail:

11871187--

11881188-- >>> Stream.parse (Parser.satisfy (> 0) `Parser.alt` undefined) $ Stream.fromList [1..10]

1189−-- 1

1189+-- Right 1

11901190--

11911191-- Compare with 'Alternative' instance method '<|>'. This implementation allows

11921192-- stream fusion but has quadratic complexity. This can fuse with other

@@ -1235,10 +1235,10 @@ lookAhead p = D.toParserK $ D.lookAhead $ D.fromParserK p

12351235-- * Fails - when the collecting parser fails.

12361236--

12371237-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 2 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]

1238−-- [1,2]

1238+-- Right [1,2]

12391239--

12401240-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]

1241−-- *** Exception: ParseError "takeEQ: Expecting exactly 5 elements, input terminated on 4"

1241+-- Left (ParseError "takeEQ: Expecting exactly 5 elements, input terminated on 4")

12421242--

12431243-- /Internal/

12441244{-# INLINE takeP #-}

core/src/Streamly/Internal/Data/Parser/Chunked.hs+8−8

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

2626#include "assert.hs"

2727#include "inline.hs"

2828

29−import Control.Monad.Catch (MonadThrow, throwM)

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

3130import GHC.Types (SPEC(..))

3231import Streamly.Internal.Data.Array.Type (Array(..))

@@ -42,6 +41,7 @@ import qualified Streamly.Internal.Data.Parser.ParserD as D

4241 hiding (fromParserK, toParserK)

4342import qualified Streamly.Internal.Data.Stream.StreamK as StreamK

4443import qualified Streamly.Internal.Data.Stream.Type as Stream

44+import Streamly.Internal.Data.Parser.ParserD (ParseError(..))

4545

4646-------------------------------------------------------------------------------

4747-- Driver

@@ -84,10 +84,10 @@ parserDone (K.Failure n e) _ _ = return $ K.Error n e

8484-- | Run a 'Parser' over a stream and return rest of the Stream.

8585{-# INLINE_NORMAL parseBreak #-}

8686parseBreak

87− :: (MonadThrow m, Unbox a)

87+ :: (Monad m, Unbox a)

8888 => ParserChunked a m b

8989 -> Stream m (Array a)

90− -> m (b, Stream m (Array a))

90+ -> m (Either ParseError b, Stream m (Array a))

9191parseBreak parser input = do

9292 let parserk = \arr -> K.runParser parser 0 0 arr parserDone

9393 in go [] parserk (Stream.toStreamK input)

@@ -116,13 +116,13 @@ parseBreak parser input = do

116116 let (s1, backBuf1) = backTrack n1 backBuf StreamK.nil

117117 in go backBuf1 cont1 s1

118118 K.Done 0 b ->

119− return (b, Stream.nil)

119+ return (Right b, Stream.nil)

120120 K.Done n b -> do

121121 let n1 = negate n

122122 assertM(n1 >= 0 && n1 <= sum (map Array.length backBuf))

123123 let (s1, _) = backTrack n1 backBuf StreamK.nil

124− in return (b, Stream.fromStreamK s1)

125− K.Error _ err -> throwM $ D.ParseError err

124+ in return (Right b, Stream.fromStreamK s1)

125+ K.Error _ err -> return (Left (ParseError err), Stream.nil)

126126

127127 seekErr n len =

128128 error $ "parseBreak: Partial: forward seek not implemented n = "

@@ -164,8 +164,8 @@ parseBreak parser input = do

164164 let n1 = len - n

165165 assertM(n1 <= sum (map Array.length (arr:backBuf)))

166166 let (s1, _) = backTrack n1 (arr:backBuf) stream

167− in return (b, Stream.fromStreamK s1)

168− K.Error _ err -> throwM $ D.ParseError err

167+ in return (Right b, Stream.fromStreamK s1)

168+ K.Error _ err -> return (Left (ParseError err), Stream.nil)

169169

170170 go backBuf parserk stream = do

171171 let stop = goStop backBuf parserk

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

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

12951295-- argument. The following code will fail:

12961296--

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

1298−-- 1

1298+-- Right 1

12991299--

13001300instance Monad m => Alternative (Parser a m) where

13011301 {-# INLINE empty #-}

core/src/Streamly/Internal/Data/Stream/Eliminate.hs+8−9

@@ -77,9 +77,8 @@ where

7777

7878#include "inline.hs"

7979

80−import Control.Monad.Catch (MonadThrow)

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

82−import Streamly.Internal.Data.Parser (Parser (..))

81+import Streamly.Internal.Data.Parser (Parser (..), ParseError (..))

8382import Streamly.Internal.Data.Unboxed (Unbox)

8483

8584import qualified Streamly.Internal.Data.Array.Type as Array

@@ -216,7 +215,7 @@ foldlS f z =

216215-- /Internal/

217216--

218217{-# INLINE_NORMAL parseD #-}

219−parseD :: MonadThrow m => PRD.Parser a m b -> Stream m a -> m b

218+parseD :: Monad m => PRD.Parser a m b -> Stream m a -> m (Either ParseError b)

220219parseD p = D.parse p . toStreamD

221220

222221-- XXX Drive directly as parserK rather than converting to parserD first.

@@ -225,7 +224,7 @@ parseD p = D.parse p . toStreamD

225224--

226225-- /Internal/

227226{-# INLINE parseK #-}

228−parseK :: MonadThrow m => PRK.Parser a m b -> Stream m a -> m b

227+parseK :: Monad m => PRK.Parser a m b -> Stream m a -> m (Either ParseError b)

229228parseK = parse

230229

231230-- | Parse a stream using the supplied 'Parser'.

@@ -236,17 +235,17 @@ parseK = parse

236235-- error. For example:

237236--

238237-- >>> Stream.parse (Parser.takeEQ 1 Fold.drain) Stream.nil

239−-- *** Exception: ParseError "takeEQ: Expecting exactly 1 elements, input terminated on 0"

238+-- Left (ParseError "takeEQ: Expecting exactly 1 elements, input terminated on 0")

240239--

241240-- Note: @parse p@ is not the same as @head . parseMany p@ on an empty stream.

242241--

243242{-# INLINE [3] parse #-}

244−parse :: MonadThrow m => Parser a m b -> Stream m a -> m b

243+parse :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b)

245244parse = parseD . PRD.fromParserK

246245

247246{-# INLINE_NORMAL parseBreakD #-}

248−parseBreakD :: MonadThrow m =>

249− PRD.Parser a m b -> Stream m a -> m (b, Stream m a)

247+parseBreakD :: Monad m =>

248+ PRD.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)

250249parseBreakD parser strm = do

251250 (b, strmD) <- D.parseBreak parser (toStreamD strm)

252251 return $! (b, fromStreamD strmD)

@@ -256,7 +255,7 @@ parseBreakD parser strm = do

256255-- /Not fused/

257256--

258257{-# INLINE parseBreak #-}

259−parseBreak :: MonadThrow m => Parser a m b -> Stream m a -> m (b, Stream m a)

258+parseBreak :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)

260259parseBreak p strm = fmap f $ K.parseBreak (PRD.fromParserK p) (toStreamK strm)

261260

262261 where

core/src/Streamly/Internal/Data/Stream/Reduce.hs+9−9

@@ -56,11 +56,11 @@ module Streamly.Internal.Data.Stream.Reduce

5656 )

5757where

5858

59−import Control.Monad.Catch (MonadThrow)

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

6160import Streamly.Internal.Data.Array.Type (Array)

6261import Streamly.Internal.Data.Fold.Type (Fold (..))

6362import Streamly.Internal.Data.Parser (Parser (..))

63+import Streamly.Internal.Data.Parser.ParserD (ParseError)

6464import Streamly.Internal.Data.Refold.Type (Refold (..))

6565import Streamly.Internal.Data.Stream.Bottom (foldManyPost)

6666import Streamly.Internal.Data.Stream.Type (Stream, fromStreamD, toStreamD)

@@ -331,7 +331,7 @@ splitOnAny _subseq _f _m =

331331-- >>> s = Stream.fromList [1..10]

332332-- >>> parser = Parser.takeBetween 0 2 Fold.sum

333333-- >>> Stream.fold Fold.toList $ Stream.parseMany parser s

334−-- [3,7,11,15,19]

334+-- [Right 3,Right 7,Right 11,Right 15,Right 19]

335335--

336336-- foldMany f = Stream.parseMany (Parser.fromFold f)

337337--

@@ -340,10 +340,10 @@ splitOnAny _subseq _f _m =

340340--

341341{-# INLINE parseMany #-}

342342parseMany

343− :: MonadThrow m

343+ :: Monad m

344344 => Parser a m b

345345 -> Stream m a

346− -> Stream m b

346+ -> Stream m (Either ParseError b)

347347parseMany p m =

348348 fromStreamD $ D.parseMany (ParserD.fromParserK p) (toStreamD m)

349349

@@ -353,10 +353,10 @@ parseMany p m =

353353--

354354{-# INLINE parseManyD #-}

355355parseManyD

356− :: MonadThrow m

356+ :: Monad m

357357 => ParserD.Parser a m b

358358 -> Stream m a

359− -> Stream m b

359+ -> Stream m (Either ParseError b)

360360parseManyD p m =

361361 fromStreamD $ D.parseMany p (toStreamD m)

362362

@@ -398,7 +398,7 @@ parseManyTill = undefined

398398--

399399-- >>> import Data.Monoid (Sum(..))

400400-- >>> s = Stream.fromList [1..10]

401−-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) 0 $ fmap Sum s

401+-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.rights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s

402402-- [3,10,21,36,55,55]

403403--

404404-- This is the streaming equivalent of monad like sequenced application of

@@ -408,11 +408,11 @@ parseManyTill = undefined

408408--

409409{-# INLINE parseIterate #-}

410410parseIterate

411− :: MonadThrow m

411+ :: Monad m

412412 => (b -> Parser a m b)

413413 -> b

414414 -> Stream m a

415− -> Stream m b

415+ -> Stream m (Either ParseError b)

416416parseIterate f i m = fromStreamD $

417417 D.parseIterate (ParserD.fromParserK . f) i (toStreamD m)

418418

core/src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs+1−1

@@ -189,7 +189,7 @@ parseBreak (PRD.Parser pstep initial extract) stream@(Stream step state) = do

189189 let (src0, buf1) = splitAt n (x:getList buf)

190190 src = Prelude.reverse src0

191191 gobuf SPEC s (List buf1) (List src) pst1

192− PR.Done 0 b -> return $ (Right b, Stream step s)

192+ PR.Done 0 b -> return (Right b, Stream step s)

193193 PR.Done n b -> do

194194 assert (n <= length (x:getList buf)) (return ())

195195 let src0 = Prelude.take n (x:getList buf)

core/src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs+55−21

@@ -150,7 +150,6 @@ where

150150#include "ArrayMacros.h"

151151

152152import Control.Exception (assert)

153−import Control.Monad.Catch (MonadThrow, throwM)

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

155154import Data.Bits (shiftR, shiftL, (.|.), (.&.))

156155import Data.Functor.Identity ( Identity )

@@ -1363,7 +1362,7 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) =

13631362 stepOuter _ (ParseChunksYield a next) = return $ Yield a next

13641363

13651364{-# ANN type ConcatParseState Fuse #-}

1366−data ConcatParseState b inpBuf st p m a =

1365+data ConcatParseState c b inpBuf st p m a =

13671366 ConcatParseInit inpBuf st p

13681367 | ConcatParseInitBuf inpBuf p

13691368 | ConcatParseInitLeftOver inpBuf

@@ -1375,16 +1374,16 @@ data ConcatParseState b inpBuf st p m a =

13751374 inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))

13761375 | forall s. ConcatParseExtract

13771376 inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))

1378− | ConcatParseYield b (ConcatParseState b inpBuf st p m a)

1377+ | ConcatParseYield c (ConcatParseState c b inpBuf st p m a)

13791378

13801379-- XXX Review the changes

13811380{-# INLINE_NORMAL parseIterate #-}

13821381parseIterate

1383− :: MonadThrow m

1382+ :: Monad m

13841383 => (b -> PRD.Parser a m b)

13851384 -> b

13861385 -> Stream m a

1387− -> Stream m b

1386+ -> Stream m (Either ParseError b)

13881387parseIterate func seed (Stream step state) =

13891388 Stream stepOuter (ConcatParseInit [] state (func seed))

13901389

@@ -1399,8 +1398,13 @@ parseIterate func seed (Stream step state) =

13991398 return $ Skip $ ConcatParseStream st [] pstep ps extract

14001399 PRD.IDone pb ->

14011400 let next = ConcatParseInit [] st (func pb)

1402− in return $ Skip $ ConcatParseYield pb next

1403− PRD.IError err -> throwM $ ParseError err

1401+ in return $ Skip $ ConcatParseYield (Right pb) next

1402+ PRD.IError err ->

1403+ return

1404+ $ Skip

1405+ $ ConcatParseYield

1406+ (Left (ParseError err))

1407+ (ConcatParseInitLeftOver [])

14041408

14051409 -- Buffer is not empty, go to buffered processing loop

14061410 stepOuter _ (ConcatParseInit src st

@@ -1411,8 +1415,13 @@ parseIterate func seed (Stream step state) =

14111415 return $ Skip $ ConcatParseBuf src st [] pstep ps extract

14121416 PRD.IDone pb ->

14131417 let next = ConcatParseInit src st (func pb)

1414− in return $ Skip $ ConcatParseYield pb next

1415− PRD.IError err -> throwM $ ParseError err

1418+ in return $ Skip $ ConcatParseYield (Right pb) next

1419+ PRD.IError err ->

1420+ return

1421+ $ Skip

1422+ $ ConcatParseYield

1423+ (Left (ParseError err))

1424+ (ConcatParseInitLeftOver [])

14161425

14171426 -- This is simplified ConcatParseInit

14181427 stepOuter _ (ConcatParseInitBuf src

@@ -1423,8 +1432,13 @@ parseIterate func seed (Stream step state) =

14231432 return $ Skip $ ConcatParseExtract src [] pstep ps extract

14241433 PRD.IDone pb ->

14251434 let next = ConcatParseInitBuf src (func pb)

1426− in return $ Skip $ ConcatParseYield pb next

1427− PRD.IError err -> throwM $ ParseError err

1435+ in return $ Skip $ ConcatParseYield (Right pb) next

1436+ PRD.IError err ->

1437+ return

1438+ $ Skip

1439+ $ ConcatParseYield

1440+ (Left (ParseError err))

1441+ (ConcatParseInitLeftOver [])

14281442

14291443 -- XXX we just discard any leftover input at the end

14301444 stepOuter _ (ConcatParseInitLeftOver _) = return Stop

@@ -1455,8 +1469,13 @@ parseIterate func seed (Stream step state) =

14551469 assert (n <= length (x:buf)) (return ())

14561470 let src = Prelude.reverse (Prelude.take n (x:buf))

14571471 return $ Skip $

1458− ConcatParseYield b (ConcatParseInit src s (func b))

1459− PR.Error err -> throwM $ ParseError err

1472+ ConcatParseYield (Right b) (ConcatParseInit src s (func b))

1473+ PR.Error err ->

1474+ return

1475+ $ Skip

1476+ $ ConcatParseYield

1477+ (Left (ParseError err))

1478+ (ConcatParseInitLeftOver [])

14601479 Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract

14611480 Stop -> return $ Skip $ ConcatParseStop buf pstep pst extract

14621481

@@ -1485,9 +1504,14 @@ parseIterate func seed (Stream step state) =

14851504 PR.Done n b -> do

14861505 assert (n <= length (x:buf)) (return ())

14871506 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs

1488− return $ Skip $ ConcatParseYield b

1507+ return $ Skip $ ConcatParseYield (Right b)

14891508 (ConcatParseInit src s (func b))

1490− PR.Error err -> throwM $ ParseError err

1509+ PR.Error err ->

1510+ return

1511+ $ Skip

1512+ $ ConcatParseYield

1513+ (Left (ParseError err))

1514+ (ConcatParseInitLeftOver [])

14911515

14921516 -- This is simplified ConcatParseBuf

14931517 stepOuter _ (ConcatParseExtract [] buf pstep pst extract) =

@@ -1511,12 +1535,17 @@ parseIterate func seed (Stream step state) =

15111535 src = Prelude.reverse src0 ++ xs

15121536 return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract

15131537 PR.Done 0 b ->

1514− return $ Skip $ ConcatParseYield b (ConcatParseInitBuf xs (func b))

1538+ return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf xs (func b))

15151539 PR.Done n b -> do

15161540 assert (n <= length (x:buf)) (return ())

15171541 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs

1518− return $ Skip $ ConcatParseYield b (ConcatParseInitBuf src (func b))

1519− PR.Error err -> throwM $ ParseError err

1542+ return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))

1543+ PR.Error err ->

1544+ return

1545+ $ Skip

1546+ $ ConcatParseYield

1547+ (Left (ParseError err))

1548+ (ConcatParseInitLeftOver [])

15201549

15211550 -- This is simplified ConcatParseExtract

15221551 stepOuter _ (ConcatParseStop buf pstep pst extract) = do

@@ -1532,13 +1561,18 @@ parseIterate func seed (Stream step state) =

15321561 return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract

15331562 PR.Done 0 b -> do

15341563 return $ Skip $

1535− ConcatParseYield b (ConcatParseInitLeftOver [])

1564+ ConcatParseYield (Right b) (ConcatParseInitLeftOver [])

15361565 PR.Done n b -> do

15371566 assert (n <= length buf) (return ())

15381567 let src = Prelude.reverse (Prelude.take n buf)

15391568 return $ Skip $

1540− ConcatParseYield b (ConcatParseInitBuf src (func b))

1541− PR.Error err -> throwM $ ParseError err

1569+ ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))

1570+ PR.Error err ->

1571+ return

1572+ $ Skip

1573+ $ ConcatParseYield

1574+ (Left (ParseError err))

1575+ (ConcatParseInitLeftOver [])

15421576

15431577 stepOuter _ (ConcatParseYield a next) = return $ Yield a next

15441578

core/src/Streamly/Internal/Data/Stream/StreamK.hs+12−12

@@ -177,7 +177,6 @@ where

177177

178178#include "assert.hs"

179179

180−import Control.Monad.Catch (MonadThrow, throwM)

181180import Control.Monad (void, join)

182181import Streamly.Internal.Data.Fold.Type (Fold(..))

183182import Streamly.Internal.Data.SVar.Type (adaptState, defState)

@@ -193,6 +192,7 @@ import Prelude

193192 foldr1, (!!), replicate, reverse, concatMap, iterate, splitAt)

194193

195194import Streamly.Internal.Data.Stream.StreamK.Type

195+import Streamly.Internal.Data.Parser.ParserD (ParseError(..))

196196

197197-- $setup

198198-- >>> :m

@@ -998,16 +998,16 @@ splitAt n ls

998998-- | Run a 'Parser' over a stream and return rest of the Stream.

999999{-# INLINE_NORMAL parseBreak #-}

10001000parseBreak

1001− :: MonadThrow m

1001+ :: Monad m

10021002 => PR.Parser a m b

10031003 -> Stream m a

1004− -> m (b, Stream m a)

1004+ -> m (Either ParseError b, Stream m a)

10051005parseBreak (PR.Parser pstep initial extract) stream = do

10061006 res <- initial

10071007 case res of

10081008 PR.IPartial s -> goStream stream [] s

1009− PR.IDone b -> return (b, stream)

1010− PR.IError err -> throwM $ PR.ParseError err

1009+ PR.IDone b -> return (Right b, stream)

1010+ PR.IError err -> return (Left (ParseError err), stream)

10111011

10121012 where

10131013

@@ -1021,12 +1021,12 @@ parseBreak (PR.Parser pstep initial extract) stream = do

10211021 let stop = do

10221022 r <- extract pst

10231023 case r of

1024− PR.Error err -> throwM $ PR.ParseError err

1024+ PR.Error err -> return (Left (ParseError err), nil)

10251025 PR.Done n b -> do

10261026 assertM(n <= length buf)

10271027 let src0 = Prelude.take n buf

10281028 src = Prelude.reverse src0

1029− return (b, fromList src)

1029+ return (Right b, fromList src)

10301030 PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"

10311031 PR.Continue 0 s -> goStream nil buf s

10321032 PR.Continue n s -> do

@@ -1050,13 +1050,13 @@ parseBreak (PR.Parser pstep initial extract) stream = do

10501050 let (src0, buf1) = splitAt n (x:buf)

10511051 src = Prelude.reverse src0

10521052 goBuf r buf1 src s

1053− PR.Done 0 b -> return (b, r)

1053+ PR.Done 0 b -> return (Right b, r)

10541054 PR.Done n b -> do

10551055 assertM(n <= length (x:buf))

10561056 let src0 = Prelude.take n (x:buf)

10571057 src = Prelude.reverse src0

1058− return (b, serial (fromList src) r)

1059− PR.Error err -> throwM $ PR.ParseError err

1058+ return (Right b, serial (fromList src) r)

1059+ PR.Error err -> return (Left (ParseError err), r)

10601060 in foldStream defState yieldk single stop st

10611061

10621062 goBuf st buf [] !pst = goStream st buf pst

@@ -1079,5 +1079,5 @@ parseBreak (PR.Parser pstep initial extract) stream = do

10791079 assert (n <= length (x:buf)) (return ())

10801080 let src0 = Prelude.take n (x:buf)

10811081 src = Prelude.reverse src0

1082− return (b, serial (fromList src) st)

1083− PR.Error err -> throwM $ PR.ParseError err

1082+ return (Right b, serial (fromList src) st)

1083+ PR.Error err -> return (Left (ParseError err), nil)

core/src/Streamly/Internal/Data/Stream/Top.hs+2−3

@@ -42,7 +42,6 @@ where

4242

4343#include "inline.hs"

4444

45−import Control.Monad.Catch (MonadThrow)

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

4746import Control.Monad.Trans.State.Strict (get, put)

4847import Data.Function ((&))

@@ -111,7 +110,7 @@ sampleFromThen offset stride =

111110-- /Pre-release/

112111--

113112{-# INLINE sortBy #-}

114−sortBy :: MonadThrow m => (a -> a -> Ordering) -> Stream m a -> Stream m a

113+sortBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a

115114-- sortBy f = Stream.concatPairsWith (Stream.mergeBy f) Stream.fromPure

116115sortBy cmp =

117116 let p =

@@ -120,7 +119,7 @@ sortBy cmp =

120119 Fold.toStreamRev

121120 Fold.toStream

122121 in Stream.concatPairsWith (Stream.mergeBy cmp) id

123− . Stream.parseMany (fmap (either id id) p)

122+ . Stream.rights . Stream.parseMany (fmap (either id id) p)

124123

125124------------------------------------------------------------------------------

126125-- SQL Joins

core/src/Streamly/Internal/Unicode/String.hs+8−3

@@ -34,7 +34,10 @@ module Streamly.Internal.Unicode.String

3434 ( str

3535 ) where

3636

37+

3738import Control.Applicative (Alternative(..))

39+import Control.Exception (displayException)

40+import Data.Functor.Identity (runIdentity)

3841import Streamly.Internal.Data.Parser (Parser)

3942

4043import Language.Haskell.TH

@@ -100,9 +103,11 @@ strExp xs = appE [| concat |] $ listE $ map strSegmentExp xs

100103

101104expandVars :: String -> Q Exp

102105expandVars ln =

103− case Stream.parse strParser (Stream.fromList ln) of

104− Left _ -> fail "Parsing of str quoted string failed."

105− Right xs -> strExp xs

106+ case runIdentity $ Stream.parse strParser (Stream.fromList ln) of

107+ Left e ->

108+ fail $ "str QuasiQuoter parse error: " ++ displayException e

109+ Right x ->

110+ strExp x

106111

107112-- | A QuasiQuoter that treats the input as a string literal:

108113--

src/Streamly/Internal/Data/Fold/Concurrent.hs+1

@@ -44,6 +44,7 @@ import Streamly.Internal.Data.Fold.Concurrent.Channel

4444-- Imports for example snippets in this module.

4545--

4646-- >>> :m

47+-- >>> :set -XFlexibleContexts

4748-- >>> import Control.Concurrent (threadDelay)

4849-- >>> import qualified Streamly.Data.Array as Array

4950-- >>> import qualified Streamly.Data.Fold as Fold

src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs+9−10

@@ -152,7 +152,6 @@ where

152152#include "inline.hs"

153153

154154import Control.Exception (assert)

155−import Control.Monad.Catch (MonadThrow)

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

157156import Data.Heap (Entry(..))

158157import Data.Kind (Type)

@@ -163,7 +162,7 @@ import Streamly.Internal.Control.Concurrent (MonadAsync)

163162import Streamly.Internal.Data.Fold.Type (Fold (..))

164163import Streamly.Internal.Data.IsMap (IsMap(..))

165164import Streamly.Internal.Data.Refold.Type (Refold (..))

166−import Streamly.Internal.Data.Parser (Parser (..))

165+import Streamly.Internal.Data.Parser (Parser (..), ParseError)

167166import Streamly.Internal.Data.Array.Type (Array)

168167import Streamly.Internal.Data.Stream.IsStream.Common

169168 ( fold

@@ -363,7 +362,7 @@ refoldIterateM c i m = fromStreamD $ D.refoldIterateM c i (toStreamD m)

363362-- parse combinator.

364363--

365364-- >>> Stream.toList $ Stream.parseMany (Parser.takeBetween 0 2 Fold.sum) $ Stream.fromList [1..10]

366−-- [3,7,11,15,19]

365+-- [Right 3,Right 7,Right 11,Right 15,Right 19]

367366--

368367-- @

369368-- > Stream.toList $ Stream.parseMany (Parser.line Fold.toList) $ Stream.fromList "hello\\nworld"

@@ -382,10 +381,10 @@ refoldIterateM c i m = fromStreamD $ D.refoldIterateM c i (toStreamD m)

382381--

383382{-# INLINE parseMany #-}

384383parseMany

385− :: (IsStream t, MonadThrow m)

384+ :: (IsStream t, Monad m)

386385 => Parser a m b

387386 -> t m a

388− -> t m b

387+ -> t m (Either ParseError b)

389388parseMany p m =

390389 fromStreamD $ D.parseMany (PRD.fromParserK p) (toStreamD m)

391390

@@ -395,10 +394,10 @@ parseMany p m =

395394--

396395{-# INLINE parseManyD #-}

397396parseManyD

398− :: (IsStream t, MonadThrow m)

397+ :: (IsStream t, Monad m)

399398 => PRD.Parser a m b

400399 -> t m a

401− -> t m b

400+ -> t m (Either ParseError b)

402401parseManyD p m =

403402 fromStreamD $ D.parseMany p (toStreamD m)

404403

@@ -439,7 +438,7 @@ parseManyTill = undefined

439438-- the result is used to generate the next parser and so on.

440439--

441440-- >>> import Data.Monoid (Sum(..))

442−-- >>> Stream.toList $ Stream.map getSum $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) 0 $ Stream.map Sum $ Stream.fromList [1..10]

441+-- >>> Stream.toList $ fmap getSum $ Stream.rights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum $ Stream.fromList [1..10]

443442-- [3,10,21,36,55,55]

444443--

445444-- This is the streaming equivalent of monad like sequenced application of

@@ -449,11 +448,11 @@ parseManyTill = undefined

449448--

450449{-# INLINE parseIterate #-}

451450parseIterate

452− :: (IsStream t, MonadThrow m)

451+ :: (IsStream t, Monad m)

453452 => (b -> Parser a m b)

454453 -> b

455454 -> t m a

456− -> t m b

455+ -> t m (Either ParseError b)

457456parseIterate f i m = fromStreamD $

458457 D.parseIterate (PRD.fromParserK . f) i (toStreamD m)

459458

src/Streamly/Internal/Data/Stream/IsStream/Top.hs+2−1

@@ -250,7 +250,8 @@ sortBy cmp =

250250 Fold.toStreamRev

251251 Fold.toStream

252252 in Stream.concatPairsWith (Stream.mergeBy cmp) id

253− . Stream.parseMany (fmap (either id id) p)

253+ . Stream.rights . Stream.parseMany (fmap (either id id) p)

254+

254255

255256------------------------------------------------------------------------------

256257-- SQL Joins

src/Streamly/Internal/FileSystem/Event/Darwin.hs+1−1

@@ -505,7 +505,7 @@ readOneEvent = do

505505

506506watchToStream :: Watch -> Stream IO Event

507507watchToStream (Watch handle _ _) =

508− S.parseMany readOneEvent $ S.unfold FH.reader handle

508+ S.rights $ S.parseMany readOneEvent $ S.unfold FH.reader handle

509509

510510-- XXX Write tests for all the points in macOS specific behavior.

511511--

src/Streamly/Internal/FileSystem/Event/Linux.hs+1−1

@@ -868,7 +868,7 @@ watchToStream cfg wt@(Watch handle _) = do

868868 -- sizeof(struct inotify_event) + NAME_MAX + 1

869869 --

870870 -- will be sufficient to read at least one event.

871− S.parseMany (readOneEvent cfg wt) $ S.unfold FH.reader handle

871+ S.rights $ S.parseMany (readOneEvent cfg wt) $ S.unfold FH.reader handle

872872

873873-- XXX We should not go across the mount points of network file systems or file

874874-- systems that are known to not generate any events.

test/Streamly/Test/Data/Parser.hs+87−69

@@ -1,6 +1,6 @@

11module Main (main) where

3−import Control.Exception (SomeException(..), displayException, try)

3+import Control.Exception (displayException)

44import Data.Foldable (for_)

55import Data.Word (Word8, Word32, Word64)

66import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)

@@ -24,6 +24,8 @@ import qualified Test.Hspec as H

2424#if MIN_VERSION_QuickCheck(2,14,0)

2525

2626import Test.QuickCheck (chooseAny)

27+import Control.Monad.Identity (Identity(runIdentity, Identity))

28+import Streamly.Internal.Data.Parser.ParserD (ParseError(..))

2729

2830#else

2931

@@ -56,46 +58,49 @@ max_length = 1000

5658fromFold :: Property

5759fromFold =

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

59− case (==) <$> S.parse (P.fromFold FL.sum) (S.fromList ls)

60− <*> S.fold FL.sum (S.fromList ls) of

61− Right is_equal -> is_equal

62− Left _ -> False

61+ monadicIO $ do

62+ s1 <- S.parse (P.fromFold FL.sum) (S.fromList ls)

63+ o2 <- S.fold FL.sum (S.fromList ls)

64+ return $

65+ case s1 of

66+ Right o1 -> o1 == o2

67+ Left _ -> False

6368

6469fromPure :: Property

6570fromPure =

6671 forAll (chooseInt (min_value, max_value)) $ \x ->

67− case S.parse (P.fromPure x) (S.fromList [1 :: Int]) of

72+ case runIdentity $ S.parse (P.fromPure x) (S.fromList [1 :: Int]) of

6873 Right r -> r == x

6974 Left _ -> False

7075

7176fromEffect :: Property

7277fromEffect =

7378 forAll (chooseInt (min_value, max_value)) $ \x ->

74− case S.parse (P.fromEffect $ return x) (S.fromList [1 :: Int]) of

79+ case runIdentity $ S.parse (P.fromEffect $ return x) (S.fromList [1 :: Int]) of

7580 Right r -> r == x

7681 Left _ -> False

7782

7883die :: Property

7984die =

8085 property $

81− case S.parse (P.die "die test") (S.fromList [0 :: Int]) of

86+ case runIdentity $ S.parse (P.die "die test") (S.fromList [0 :: Int]) of

8287 Right _ -> False

8388 Left _ -> True

8489

8590dieM :: Property

8691dieM =

8792 property $

88− case S.parse (P.dieM (Right "die test")) (S.fromList [0 :: Int]) of

93+ case runIdentity $ S.parse (P.dieM (Identity "die test")) (S.fromList [0 :: Int]) of

8994 Right _ -> False

9095 Left _ -> True

9196

9297parserFail :: Property

9398parserFail =

9499 property $

95− case S.parse (fail err) (S.fromList [0 :: Int]) of

96− Right _ -> False

97− Left (SomeException e) -> err == displayException e

98− where

100+ case runIdentity $ S.parse (fail err) (S.fromList [0 :: Int]) of

101+ Right _ -> False

102+ Left (ParseError e) -> err == e

103+ where

99104 err = "Testing MonadFail.fail."

100105

101106-- Element Parser Tests

@@ -104,7 +109,7 @@ peekPass :: Property

104109peekPass =

105110 forAll (chooseInt (1, max_length)) $ \list_length ->

106111 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->

107− case S.parse P.peek (S.fromList ls) of

112+ case runIdentity $ S.parse P.peek (S.fromList ls) of

108113 Right head_value -> case ls of

109114 head_ls : _ -> head_value == head_ls

110115 _ -> False

@@ -112,13 +117,13 @@ peekPass =

112117

113118peekFail :: Property

114119peekFail =

115− property (case S.parse P.peek (S.fromList []) of

120+ property (case runIdentity $ S.parse P.peek (S.fromList []) of

116121 Right _ -> False

117122 Left _ -> True)

118123

119124eofPass :: Property

120125eofPass =

121− property (case S.parse P.eof (S.fromList []) of

126+ property (case runIdentity $ S.parse P.eof (S.fromList []) of

122127 Right _ -> True

123128 Left _ -> False)

124129

@@ -126,7 +131,7 @@ eofFail :: Property

126131eofFail =

127132 forAll (chooseInt (1, max_length)) $ \list_length ->

128133 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->

129− case S.parse P.eof (S.fromList ls) of

134+ case runIdentity $ S.parse P.eof (S.fromList ls) of

130135 Right _ -> False

131136 Left _ -> True

132137

@@ -138,14 +143,14 @@ satisfyPass =

138143 ls = first_element : ls_tail

139144 predicate = (>= mid_value)

140145 in

141− case S.parse (P.satisfy predicate) (S.fromList ls) of

146+ case runIdentity $ S.parse (P.satisfy predicate) (S.fromList ls) of

142147 Right r -> r == first_element

143148 Left _ -> False

144149

145150satisfy :: Property

146151satisfy =

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

148− case S.parse (P.satisfy predicate) (S.fromList ls) of

153+ case runIdentity $ S.parse (P.satisfy predicate) (S.fromList ls) of

149154 Right r -> case ls of

150155 [] -> False

151156 (x : _) -> predicate x && (r == x)

@@ -158,15 +163,16 @@ satisfy =

158163onePass :: Property

159164onePass =

160165 forAll (chooseInt (1, max_value)) $ \int ->

161− property (case S.parse P.one (S.fromList [int]) of

166+ property (case runIdentity $ S.parse P.one (S.fromList [int]) of

162167 Right i -> i == int

163168 Left _ -> False)

164169

165170one :: Property

166171one =

167− property (case S.parse P.one (S.fromList []) of

168− Left _ -> True

169− Right _ -> False)

172+ property $

173+ case runIdentity $ S.parse P.one (S.fromList []) of

174+ Left _ -> True

175+ Right _ -> False

170176

171177-- Sequence Parsers Tests

172178takeBetweenPass :: Property

@@ -176,7 +182,7 @@ takeBetweenPass =

176182 forAll (chooseInt (m, max_value)) $ \list_length ->

177183 forAll (vectorOf list_length (chooseInt (min_value, max_value)))

178184 $ \ls ->

179− case S.parse (P.takeBetween m n FL.toList)

185+ case runIdentity $ S.parse (P.takeBetween m n FL.toList)

180186 (S.fromList ls) of

181187 Right parsed_list ->

182188 let lpl = Prelude.length parsed_list

@@ -195,25 +201,25 @@ takeBetween =

195201

196202 go m n ls =

197203 let inputLen = Prelude.length ls

198− in monadicIO $ do

204+ in do

199205 let p = P.takeBetween m n FL.toList

200− r <- run $ try $ S.parse p (S.fromList ls)

201− return $ case r of

206+ case runIdentity $ S.parse p (S.fromList ls) of

202207 Right xs ->

203208 let parsedLen = Prelude.length xs

204− in if inputLen >= m && parsedLen >= m && parsedLen <= n

209+ in if inputLen >= m && parsedLen >= m && parsedLen <= n

205210 then checkListEqual xs $ Prelude.take parsedLen ls

206211 else property False

207− Left (_ :: SomeException) ->

212+ Left _ ->

208213 property ((m >= 0 && n >= 0 && m > n) || inputLen < m)

209214

215+

210216takeEQPass :: Property

211217takeEQPass =

212218 forAll (chooseInt (min_value, max_value)) $ \n ->

213219 forAll (chooseInt (n, max_value)) $ \list_length ->

214220 forAll (vectorOf list_length

215221 (chooseInt (min_value, max_value))) $ \ls ->

216− case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of

222+ case runIdentity $ S.parse (P.takeEQ n FL.toList) (S.fromList ls) of

217223 Right parsed_list ->

218224 checkListEqual parsed_list (Prelude.take n ls)

219225 Left _ -> property False

@@ -225,7 +231,7 @@ takeEQ =

225231 let

226232 list_length = Prelude.length ls

227233 in

228− case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of

234+ case runIdentity $ S.parse (P.takeEQ n FL.toList) (S.fromList ls) of

229235 Right parsed_list ->

230236 if n <= list_length

231237 then checkListEqual parsed_list (Prelude.take n ls)

@@ -238,7 +244,7 @@ takeGEPass =

238244 forAll (chooseInt (n, max_value)) $ \list_length ->

239245 forAll (vectorOf list_length (chooseInt (min_value, max_value)))

240246 $ \ls ->

241− case S.parse (P.takeGE n FL.toList) (S.fromList ls) of

247+ case runIdentity $ S.parse (P.takeGE n FL.toList) (S.fromList ls) of

242248 Right parsed_list -> checkListEqual parsed_list ls

243249 Left _ -> property False

244250

@@ -249,24 +255,25 @@ takeGE =

249255 let

250256 list_length = Prelude.length ls

251257 in

252− case S.parse (P.takeGE n FL.toList) (S.fromList ls) of

258+ case runIdentity $S.parse (P.takeGE n FL.toList) (S.fromList ls) of

253259 Right parsed_list ->

254260 if n <= list_length

255261 then checkListEqual parsed_list ls

256262 else property False

257263 Left _ -> property (n > list_length)

258264

265+

259266nLessThanEqual0 ::

260267 ( Int

261− -> FL.Fold (Either SomeException) Int [Int]

262− -> P.Parser Int (Either SomeException) [Int]

268+ -> FL.Fold Identity Int [Int]

269+ -> P.Parser Int Identity [Int]

263270 )

264271 -> (Int -> [Int] -> [Int])

265272 -> Property

266273nLessThanEqual0 tk ltk =

267274 forAll (elements [0, (-1)]) $ \n ->

268275 forAll (listOf arbitrary) $ \ls ->

269− case S.parse (tk n FL.toList) (S.fromList ls) of

276+ case runIdentity $ S.parse (tk n FL.toList) (S.fromList ls) of

270277 Right parsed_list -> checkListEqual parsed_list (ltk n ls)

271278 Left _ -> property False

272279

@@ -330,7 +337,7 @@ takeProperties =

330337takeEndBy_ :: Property

331338takeEndBy_ =

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

333− case S.parse (P.takeEndBy_ predicate prsr) (S.fromList ls) of

340+ case runIdentity $ S.parse (P.takeEndBy_ predicate prsr) (S.fromList ls) of

334341 Right parsed_list ->

335342 checkListEqual parsed_list (tkwhl ls)

336343 Left _ -> property False

@@ -344,7 +351,7 @@ takeStartBy =

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

345352 let ls1 = 1:ls

346353 in

347− case S.parse parser (S.fromList ls1) of

354+ case runIdentity $ S.parse parser (S.fromList ls1) of

348355 Right parsed_list ->

349356 if not $ Prelude.null ls1

350357 then

@@ -362,7 +369,7 @@ takeStartBy =

362369takeWhile :: Property

363370takeWhile =

364371 forAll (listOf (chooseInt (0, 1))) $ \ ls ->

365− case S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of

372+ case runIdentity $ S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of

366373 Right parsed_list ->

367374 checkListEqual parsed_list (Prelude.takeWhile predicate ls)

368375 Left _ -> property False

@@ -375,7 +382,7 @@ takeP =

375382 ((,) <$> chooseInt (min_value, max_value)

376383 <*> listOf (chooseInt (0, 1)))

377384 $ \(takeNum, ls) ->

378− case S.parse

385+ case runIdentity $ S.parse

379386 (P.takeP takeNum (P.fromFold FL.toList))

380387 (S.fromList ls) of

381388 Right parsed_list ->

@@ -385,7 +392,7 @@ takeP =

385392takeWhile1 :: Property

386393takeWhile1 =

387394 forAll (listOf (chooseInt (0, 1))) $ \ ls ->

388− case S.parse (P.takeWhile1 predicate FL.toList) (S.fromList ls) of

395+ case runIdentity $ S.parse (P.takeWhile1 predicate FL.toList) (S.fromList ls) of

389396 Right parsed_list -> case ls of

390397 [] -> property False

391398 (x : _) ->

@@ -415,7 +422,7 @@ takeWhileP =

415422 takeWhileTillLen maxLen prd list =

416423 Prelude.take maxLen $ Prelude.takeWhile prd list

417424 in

418− case S.parse prsr (S.fromList ls) of

425+ case runIdentity $ S.parse prsr (S.fromList ls) of

419426 Right parsed_list ->

420427 checkListEqual

421428 parsed_list

@@ -444,7 +451,7 @@ groupBy :: Property

444451groupBy =

445452 forAll (listOf (chooseInt (0, 1)))

446453 $ \ls ->

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

454+ case runIdentity $ S.parse parser (S.fromList ls) of

448455 Right parsed -> checkListEqual parsed (groupByLF ls)

449456 Left _ -> property False

450457

@@ -460,7 +467,7 @@ wordBy :: Property

460467wordBy =

461468 forAll (listOf (elements [' ', 's']))

462469 $ \ls ->

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

470+ case runIdentity $ S.parse parser (S.fromList ls) of

464471 Right parsed -> checkListEqual parsed (words' ls)

465472 Left _ -> property False

466473

@@ -486,7 +493,7 @@ parseManyWordQuotedBy =

486493 spc _ = False

487494

488495 parser = P.wordQuotedBy kQ esc lQ rQ fromLQ spc FL.toList

489− result <- H.runIO $ S.fold FL.toList $ S.parseMany parser inpStrm

496+ result <- H.runIO $ S.fold FL.toList $ S.rights $ S.parseMany parser inpStrm

490497 H.it (showCase c) $ result `H.shouldBe` expected

491498

492499 where

@@ -595,7 +602,7 @@ parseManyWordQuotedBy =

595602deintercalate :: Property

596603deintercalate =

597604 forAll (listOf (chooseAny :: Gen Int)) $ \ls ->

598− case S.parse p (S.fromList ls) of

605+ case runIdentity $ S.parse p (S.fromList ls) of

599606 Right evenOdd -> evenOdd == List.partition even ls

600607 Left _ -> False

601608

@@ -645,7 +652,7 @@ many =

645652 prsr =

646653 flip P.many concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList

647654 in

648− case S.parse prsr (S.fromList ls) of

655+ case runIdentity $ S.parse prsr (S.fromList ls) of

649656 Right res_list -> checkListEqual res_list

650657 $ Prelude.filter (== 0) ls

651658 Left _ -> property False

@@ -666,7 +673,7 @@ some =

666673 prsr =

667674 flip P.some concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList

668675 in

669− case S.parse prsr (S.fromList ls) of

676+ case runIdentity $ S.parse prsr (S.fromList ls) of

670677 Right res_list -> res_list == Prelude.filter (== 0) ls

671678 Left _ -> False

672679

@@ -689,10 +696,11 @@ applicative =

689696 <$> P.fromFold (FL.take (length list1) FL.toList)

690697 <*> P.fromFold (FL.take (length list2) FL.toList)

691698 in monadicIO $ do

692− (olist1, olist2) <-

693− run $ S.parse parser (S.fromList $ list1 ++ list2)

694− listEquals (==) olist1 list1

695− listEquals (==) olist2 list2

699+ s <- S.parse parser (S.fromList $ list1 ++ list2)

700+ return $

701+ case s of

702+ Right (olist1, olist2) -> olist1 == list1 && olist2 == list2

703+ Left _ -> False

696704

697705sequence :: Property

698706sequence =

@@ -703,7 +711,10 @@ sequence =

703711 S.parse

704712 (Prelude.sequence $ fmap p ins)

705713 (S.fromList $ concat ins)

706− listEquals (==) outs ins

714+ return $

715+ case outs of

716+ Right ls -> ls == ins

717+ Left _ -> False

707718

708719monad :: Property

709720monad =

@@ -714,10 +725,11 @@ monad =

714725 olist2 <- P.fromFold (FL.take (length list2) FL.toList)

715726 return (olist1, olist2)

716727 in monadicIO $ do

717− (olist1, olist2) <-

718− run $ S.parse parser (S.fromList $ list1 ++ list2)

719− listEquals (==) olist1 list1

720− listEquals (==) olist2 list2

728+ s <- S.parse parser (S.fromList $ list1 ++ list2)

729+ return $

730+ case s of

731+ Right (olist1, olist2) -> olist1 == list1 && olist2 == list2

732+ Left _ -> False

721733

722734-------------------------------------------------------------------------------

723735-- Stream parsing

@@ -732,6 +744,7 @@ parseMany =

732744 let p = P.fromFold $ FL.take len FL.toList

733745 run

734746 $ S.fold FL.toList

747+ $ S.rights

735748 $ S.parseMany p (S.fromList $ concat ins)

736749 listEquals (==) outs ins

737750

@@ -786,6 +799,7 @@ parseMany2Events =

786799 xs <-

787800 ( run

788801 $ S.fold FL.toList

802+ $ S.rights

789803 $ S.parseMany readOneEvent

790804 $ S.fromList (concat (replicate 2 event))

791805 )

@@ -805,8 +819,11 @@ manyEqParseMany =

805819 monadicIO $ do

806820 let strm = S.fromList lst

807821 r1 <- run $ S.parse (P.many (split i) FL.toList) strm

808− r2 <- run $ S.fold FL.toList $ S.parseMany (split i) strm

809− assert $ r1 == r2

822+ r2 <- run $ S.fold FL.toList $ S.rights $ S.parseMany (split i) strm

823+ return $

824+ case r1 of

825+ Right o1 -> o1 == r2

826+ Left _ -> False

810827

811828 where

812829

@@ -816,7 +833,7 @@ manyEqParseMany =

816833takeEndBy1 :: Property

817834takeEndBy1 =

818835 forAll (listOf (chooseInt (0, 1))) $ \ls ->

819− case S.parse (P.takeEndBy predicate prsr) (S.fromList ls) of

836+ case runIdentity $ S.parse (P.takeEndBy predicate prsr) (S.fromList ls) of

820837 Right parsed_list ->

821838 checkListEqual

822839 parsed_list

@@ -847,8 +864,9 @@ takeEndBy2 =

847864 predicate = (==0)

848865

849866 eitherParsedList =

850− S.fold FL.toList $

851− S.parseMany (P.takeEndBy predicate prsr) strm

867+ S.fold FL.toList

868+ $ S.rights

869+ $ S.parseMany (P.takeEndBy predicate prsr) strm

852870

853871 where

854872

@@ -905,7 +923,7 @@ takeEndByEsc =

905923 Just _ ->

906924 x : escapeSep Nothing xs

907925 in

908− case S.parse prsr (S.fromList ls) of

926+ case runIdentity $ S.parse prsr (S.fromList ls) of

909927 Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls

910928 Left err -> property (displayException err == msg)

911929

@@ -981,7 +999,7 @@ takeFramedByEsc_ =

981999 in

9821000 helper l Nothing (0 :: Int)

9831001 in

984− case S.parse prsr (S.fromList ls) of

1002+ case runIdentity $ S.parse prsr (S.fromList ls) of

9851003 Right parsed_list ->

9861004 if checkPassBeg ls

9871005 then checkListEqual parsed_list $

@@ -1038,7 +1056,7 @@ takeFramedByEsc_Pass =

10381056 in

10391057 helper l Nothing (0 :: Int)

10401058 in

1041− case S.parse prsr (S.fromList ls) of

1059+ case runIdentity $ S.parse prsr (S.fromList ls) of

10421060 Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls

10431061 _ -> property False

10441062

@@ -1057,7 +1075,7 @@ takeFramedByEsc_Fail1 =

10571075

10581076 ls = [0 :: Int]

10591077 in

1060− case S.parse prsr (S.fromList ls) of

1078+ case runIdentity $ S.parse prsr (S.fromList ls) of

10611079 Right _ -> property False

10621080 Left err -> property (displayException err == msg)

10631081

@@ -1076,7 +1094,7 @@ takeFramedByEsc_Fail2 =

10761094

10771095 ls = [1 :: Int]

10781096 in

1079− case S.parse prsr (S.fromList ls) of

1097+ case runIdentity $ S.parse prsr (S.fromList ls) of

10801098 Right _ -> property False

10811099 Left err -> property (displayException err == msg)

10821100

@@ -1095,7 +1113,7 @@ takeFramedByEsc_Fail3 =

10951113

10961114 ls = [2 :: Int]

10971115 in

1098− case S.parse prsr (S.fromList ls) of

1116+ case runIdentity $ S.parse prsr (S.fromList ls) of

10991117 Right _ -> property False

11001118 Left err -> property $ (displayException err == msg)

11011119

@@ -1105,7 +1123,7 @@ takeStartBy_ =

11051123 let ls1 = 1:ls

11061124 msg = "takeFramedByGeneric: empty token"

11071125 in

1108− case S.parse parser (S.fromList ls1) of

1126+ case runIdentity $ S.parse parser (S.fromList ls1) of

11091127 Right parsed_list ->

11101128 if not $ Prelude.null ls1

11111129 then

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

@@ -1,17 +1,16 @@

11module Main (main) where

3−import Control.Monad.Catch (MonadThrow)

43-- import Control.Exception (SomeException(..), displayException, try)

54-- import Data.Foldable (for_)

65-- import Data.Word (Word8, Word32, Word64)

6+import Streamly.Internal.Data.Parser (ParseError)

77import Streamly.Internal.Data.Unboxed (Unbox)

8−import Streamly.Test.Common (listEquals)

98import Test.Hspec (hspec, describe)

109import Test.Hspec.QuickCheck

1110import Test.QuickCheck

1211 (forAll, Property, listOf,

1312 Gen)

14−import Test.QuickCheck.Monadic (monadicIO, run)

13+import Test.QuickCheck.Monadic (monadicIO)

1514

1615import Prelude hiding (sequence)

1716

@@ -685,8 +684,8 @@ some =

685684-- Instances

686685-------------------------------------------------------------------------------

687686

688−parse :: (MonadThrow f, Unbox a) =>

689− P.ParserChunked a f b -> S.Stream f (A.Array a) -> f b

687+parse :: (Monad f, Unbox a) =>

688+ P.ParserChunked a f b -> S.Stream f (A.Array a) -> f (Either ParseError b)

690689parse parser stream = fmap fst (P.parseBreak parser stream)

691690

692691applicative :: Property

@@ -699,10 +698,12 @@ applicative =

699698 <*> ParserD.fromFold (FL.take (length list2) FL.toList)

700699 in monadicIO $ do

701700 let arrays = [A.fromList list1, A.fromList list2]

702− (olist1, olist2) <-

703− run $ parse (P.fromParserD parser) (S.fromList arrays)

704− listEquals (==) olist1 list1

705− listEquals (==) olist2 list2

701+ s1 <- parse (P.fromParserD parser) (S.fromList arrays)

702+ return $

703+ case s1 of

704+ Right (olist1, olist2) -> olist1 == list1 && olist2 == list2

705+ Left _ -> False

706+

706707

707708{-

708709sequence :: Property

@@ -727,10 +728,11 @@ monad =

727728 return (olist1, olist2)

728729 in monadicIO $ do

729730 let arrays = [A.fromList list1, A.fromList list2]

730− (olist1, olist2) <-

731− run $ parse (P.fromParserD parser) (S.fromList arrays)

732− listEquals (==) olist1 list1

733− listEquals (==) olist2 list2

731+ s1 <- parse (P.fromParserD parser) (S.fromList arrays)

732+ return $

733+ case s1 of

734+ Right (olist1, olist2) -> olist1 == list1 && olist2 == list2

735+ Left _ -> False

734736

735737{-

736738-------------------------------------------------------------------------------

test/Streamly/Test/Data/Parser/ParserD.hs+100−84

@@ -3,8 +3,8 @@ module Main (main) where

33import Control.Applicative ((<|>))

44import Control.Exception (SomeException(..), try)

55import Data.Word (Word8, Word32, Word64)

6−import Streamly.Test.Common (listEquals, checkListEqual, chooseInt, equals)

7−import Test.Hspec (Spec, hspec, describe, Expectation, it, shouldReturn)

6+import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)

7+import Test.Hspec (Spec, hspec, describe)

88import Test.Hspec.QuickCheck

99import Test.QuickCheck

1010 (arbitrary, forAll, elements, Property,

@@ -28,7 +28,7 @@ import Prelude hiding (sequence)

2828#if MIN_VERSION_QuickCheck(2,14,0)

2929

3030import Test.QuickCheck (chooseAny)

31−

31+import Control.Monad.Identity (runIdentity, Identity (Identity))

3232

3333#else

3434

@@ -65,7 +65,7 @@ fromFold :: Property

6565fromFold =

6666 forAll (listOf $ chooseInt (min_value, max_value))

6767 $ \ls ->

68− case (==) <$> (S.parseD (P.fromFold FL.sum) (S.fromList ls))

68+ case (==) <$> runIdentity (S.parseD (P.fromFold FL.sum) (S.fromList ls))

6969 <*> (S.fold FL.sum (S.fromList ls)) of

7070 Right is_equal -> is_equal

7171 Left _ -> False

@@ -73,28 +73,28 @@ fromFold =

7373fromPure :: Property

7474fromPure =

7575 forAll (chooseInt (min_value, max_value)) $ \x ->

76− case S.parseD (P.fromPure x) (S.fromList [1 :: Int]) of

76+ case runIdentity $ S.parseD (P.fromPure x) (S.fromList [1 :: Int]) of

7777 Right r -> r == x

7878 Left _ -> False

7979

8080fromEffect :: Property

8181fromEffect =

8282 forAll (chooseInt (min_value, max_value)) $ \x ->

83− case S.parseD (P.fromEffect $ return x) (S.fromList [1 :: Int]) of

83+ case runIdentity $ S.parseD (P.fromEffect $ return x) (S.fromList [1 :: Int]) of

8484 Right r -> r == x

8585 Left _ -> False

8686

8787die :: Property

8888die =

8989 property $

90− case S.parseD (P.die "die test") (S.fromList [0 :: Int]) of

90+ case runIdentity (S.parseD (P.die "die test") (S.fromList [0 :: Int])) of

9191 Right _ -> False

9292 Left _ -> True

9393

9494dieM :: Property

9595dieM =

9696 property $

97− case S.parseD (P.dieM (Right "die test")) (S.fromList [0 :: Int]) of

97+ case runIdentity (S.parseD (P.dieM (Identity "die test")) (S.fromList [0 :: Int])) of

9898 Right _ -> False

9999 Left _ -> True

100100

@@ -104,7 +104,7 @@ peekPass :: Property

104104peekPass =

105105 forAll (chooseInt (1, max_length)) $ \list_length ->

106106 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->

107− case S.parseD P.peek (S.fromList ls) of

107+ case runIdentity $ S.parseD P.peek (S.fromList ls) of

108108 Right head_value -> case ls of

109109 head_ls : _ -> head_value == head_ls

110110 _ -> False

@@ -112,7 +112,7 @@ peekPass =

112112

113113peekFail :: Property

114114peekFail =

115− property (case S.parseD P.peek (S.fromList []) of

115+ property (case runIdentity $ S.parseD P.peek (S.fromList []) of

116116 Right _ -> False

117117 Left _ -> True)

118118

@@ -126,7 +126,7 @@ eofFail :: Property

126126eofFail =

127127 forAll (chooseInt (1, max_length)) $ \list_length ->

128128 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->

129− case S.parseD P.eof (S.fromList ls) of

129+ case runIdentity $S.parseD P.eof (S.fromList ls) of

130130 Right _ -> False

131131 Left _ -> True

132132

@@ -138,14 +138,14 @@ satisfyPass =

138138 ls = first_element : ls_tail

139139 predicate = (>= mid_value)

140140 in

141− case S.parseD (P.satisfy predicate) (S.fromList ls) of

141+ case runIdentity $ S.parseD (P.satisfy predicate) (S.fromList ls) of

142142 Right r -> r == first_element

143143 Left _ -> False

144144

145145satisfy :: Property

146146satisfy =

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

148− case S.parseD (P.satisfy predicate) (S.fromList ls) of

148+ case runIdentity $ S.parseD (P.satisfy predicate) (S.fromList ls) of

149149 Right r -> case ls of

150150 [] -> False

151151 (x : _) -> predicate x && (r == x)

@@ -162,7 +162,7 @@ takeBetweenPass =

162162 forAll (chooseInt (m, max_value)) $ \n ->

163163 forAll (chooseInt (m, max_value)) $ \list_length ->

164164 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->

165− case S.parseD (P.takeBetween m n FL.toList) (S.fromList ls) of

165+ case runIdentity $ S.parseD (P.takeBetween m n FL.toList) (S.fromList ls) of

166166 Right parsed_list ->

167167 let lpl = Prelude.length parsed_list

168168 in checkListEqual parsed_list (Prelude.take lpl ls)

@@ -180,13 +180,16 @@ takeBetween =

180180 let p = P.takeBetween m n FL.toList

181181 r <- run $ try $ S.parseD p (S.fromList ls)

182182 return $ case r of

183− Right parsed_list ->

184− if m <= list_length && n >= m

185− then

186− let len = Prelude.length parsed_list

187− in checkListEqual

188− parsed_list (Prelude.take len ls)

189− else property False

183+ Right x -> case x of

184+ Right parsed_list ->

185+ if m <= list_length && n >= m

186+ then

187+ let len = Prelude.length parsed_list

188+ in checkListEqual

189+ parsed_list (Prelude.take len ls)

190+ else property False

191+ Left _ ->

192+ property (m > n || list_length < m)

190193 Left (_ :: SomeException) ->

191194 property (m > n || list_length < m)

192195

@@ -194,7 +197,7 @@ take :: Property

194197take =

195198 forAll (chooseInt (min_value, max_value)) $ \n ->

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

197− case S.parseD (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of

200+ case runIdentity $ S.parseD (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of

198201 Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)

199202 Left _ -> property False

200203

@@ -203,7 +206,7 @@ takeEQPass =

203206 forAll (chooseInt (min_value, max_value)) $ \n ->

204207 forAll (chooseInt (n, max_value)) $ \list_length ->

205208 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->

206− case S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of

209+ case runIdentity $ S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of

207210 Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)

208211 Left _ -> property False

209212

@@ -214,7 +217,7 @@ takeEQ =

214217 let

215218 list_length = Prelude.length ls

216219 in

217− case S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of

220+ case runIdentity $ S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of

218221 Right parsed_list ->

219222 if (n <= list_length) then

220223 checkListEqual parsed_list (Prelude.take n ls)

@@ -227,7 +230,7 @@ takeGEPass =

227230 forAll (chooseInt (min_value, max_value)) $ \n ->

228231 forAll (chooseInt (n, max_value)) $ \list_length ->

229232 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->

230− case S.parseD (P.takeGE n FL.toList) (S.fromList ls) of

233+ case runIdentity $ S.parseD (P.takeGE n FL.toList) (S.fromList ls) of

231234 Right parsed_list -> checkListEqual parsed_list ls

232235 Left _ -> property False

233236

@@ -238,7 +241,7 @@ takeGE =

238241 let

239242 list_length = Prelude.length ls

240243 in

241− case S.parseD (P.takeGE n FL.toList) (S.fromList ls) of

244+ case runIdentity $ S.parseD (P.takeGE n FL.toList) (S.fromList ls) of

242245 Right parsed_list ->

243246 if (n <= list_length) then

244247 checkListEqual parsed_list ls

@@ -248,15 +251,15 @@ takeGE =

248251

249252nLessThanEqual0 ::

250253 ( Int

251− -> FL.Fold (Either SomeException) Int [Int]

252− -> P.Parser Int (Either SomeException) [Int]

254+ -> FL.Fold Identity Int [Int]

255+ -> P.Parser Int Identity [Int]

253256 )

254257 -> (Int -> [Int] -> [Int])

255258 -> Property

256259nLessThanEqual0 tk ltk =

257260 forAll (elements [0, (-1)]) $ \n ->

258261 forAll (listOf arbitrary) $ \ls ->

259− case S.parseD (tk n FL.toList) (S.fromList ls) of

262+ case runIdentity $ S.parseD (tk n FL.toList) (S.fromList ls) of

260263 Right parsed_list -> checkListEqual parsed_list (ltk n ls)

261264 Left _ -> property False

262265

@@ -283,7 +286,7 @@ lookAheadPass =

283286 in

284287 forAll (chooseInt (n+1, max_value)) $ \list_length ->

285288 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->

286− case S.parseD parseTwice (S.fromList ls) of

289+ case runIdentity $ S.parseD parseTwice (S.fromList ls) of

287290 Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)

288291 Left _ -> property $ False

289292

@@ -298,7 +301,7 @@ lookAhead =

298301 return (parsed_list_1, parsed_list_2)

299302 in

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

301− case S.parseD parseTwice (S.fromList ls) of

304+ case runIdentity $ S.parseD parseTwice (S.fromList ls) of

302305 Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)

303306 Left _ -> property ((list_length < n) || (list_length == n && n == 0))

304307 where

@@ -307,7 +310,7 @@ lookAhead =

307310takeWhile :: Property

308311takeWhile =

309312 forAll (listOf (chooseInt (0, 1))) $ \ ls ->

310− case S.parseD (P.takeWhile predicate FL.toList) (S.fromList ls) of

313+ case runIdentity $ S.parseD (P.takeWhile predicate FL.toList) (S.fromList ls) of

311314 Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile predicate ls)

312315 Left _ -> property False

313316 where

@@ -316,7 +319,7 @@ takeWhile =

316319takeWhile1 :: Property

317320takeWhile1 =

318321 forAll (listOf (chooseInt (0, 1))) $ \ ls ->

319− case S.parseD (P.takeWhile1 predicate FL.toList) (S.fromList ls) of

322+ case runIdentity $ S.parseD (P.takeWhile1 predicate FL.toList) (S.fromList ls) of

320323 Right parsed_list -> case ls of

321324 [] -> property False

322325 (x : _) ->

@@ -334,7 +337,7 @@ groupBy :: Property

334337groupBy =

335338 forAll (listOf (chooseInt (0, 1)))

336339 $ \ls ->

337− case S.parseD parser (S.fromList ls) of

340+ case runIdentity $ S.parseD parser (S.fromList ls) of

338341 Right parsed -> checkListEqual parsed (groupByLF ls)

339342 Left _ -> property False

340343

@@ -350,7 +353,7 @@ groupByRolling :: Property

350353groupByRolling =

351354 forAll (listOf (chooseInt (0, 1)))

352355 $ \ls ->

353− case S.parseD parser (S.fromList ls) of

356+ case runIdentity $ S.parseD parser (S.fromList ls) of

354357 Right parsed -> checkListEqual parsed (groupByLF Nothing ls)

355358 Left _ -> property False

356359

@@ -369,7 +372,7 @@ takeEndByOrMax :: Property

369372takeEndByOrMax =

370373 forAll (chooseInt (min_value, max_value)) $ \n ->

371374 forAll (listOf (chooseInt (0, 1))) $ \ls ->

372− case S.parseD (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of

375+ case runIdentity $ S.parseD (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of

373376 Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))

374377 Left _ -> property False

375378 where

@@ -379,7 +382,7 @@ wordBy :: Property

379382wordBy =

380383 forAll (listOf (elements [' ', 's']))

381384 $ \ls ->

382− case S.parseD parser (S.fromList ls) of

385+ case runIdentity $ S.parseD parser (S.fromList ls) of

383386 Right parsed -> checkListEqual parsed (words' ls)

384387 Left _ -> property False

385388

@@ -395,7 +398,7 @@ wordBy =

395398splitWith :: Property

396399splitWith =

397400 forAll (listOf (chooseInt (0, 1))) $ \ls ->

398− case S.parseD (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of

401+ case runIdentity $ S.parseD (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of

399402 Right (result_first, result_second) -> case ls of

400403 0 : 1 : _ -> (result_first == 0) && (result_second == 1)

401404 _ -> False

@@ -405,19 +408,19 @@ splitWith =

405408

406409splitWithFailLeft :: Property

407410splitWithFailLeft =

408− property (case S.parseD (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of

411+ property (case runIdentity $ S.parseD (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of

409412 Right _ -> False

410413 Left _ -> True)

411414

412415splitWithFailRight :: Property

413416splitWithFailRight =

414− property (case S.parseD (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of

417+ property (case runIdentity $ S.parseD (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of

415418 Right _ -> False

416419 Left _ -> True)

417420

418421splitWithFailBoth :: Property

419422splitWithFailBoth =

420− property (case S.parseD (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of

423+ property (case runIdentity $ S.parseD (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of

421424 Right _ -> False

422425 Left _ -> True)

423426

@@ -528,14 +531,14 @@ many =

528531 prsr =

529532 flip P.many concatFold

530533 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList

531− in case S.parseD prsr (S.fromList ls) of

534+ in case runIdentity $ S.parseD prsr (S.fromList ls) of

532535 Right res_list ->

533536 checkListEqual res_list (Prelude.filter (== 0) ls)

534537 Left _ -> property False

535538

536539many_empty :: Property

537540many_empty =

538− property (case S.parseD (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of

541+ property (case runIdentity $ S.parseD (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of

539542 Right res_list -> checkListEqual res_list ([] :: [Int])

540543 Left _ -> property False)

541544

@@ -548,13 +551,13 @@ some =

548551 prsr =

549552 flip P.some concatFold

550553 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList

551− in case S.parseD prsr (S.fromList ls) of

554+ in case runIdentity $ S.parseD prsr (S.fromList ls) of

552555 Right res_list -> res_list == Prelude.filter (== 0) ls

553556 Left _ -> False

554557

555558someFail :: Property

556559someFail =

557− property (case S.parseD (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of

560+ property (case runIdentity $ S.parseD (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of

558561 Right _ -> False

559562 Left _ -> True)

560563

@@ -566,54 +569,66 @@ applicative :: Property

566569applicative =

567570 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->

568571 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->

572+ monadicIO $ do

569573 let parser =

570574 (,)

571575 <$> P.fromFold (FL.take (length list1) FL.toList)

572576 <*> P.fromFold (FL.take (length list2) FL.toList)

573− in monadicIO $ do

574− (olist1, olist2) <-

575− run $ S.parseD parser (S.fromList $ list1 ++ list2)

576− listEquals (==) olist1 list1

577− listEquals (==) olist2 list2

577+

578+ return $

579+ case runIdentity $ S.parseD parser (S.fromList $ list1 ++ list2) of

580+ Right (olist1, olist2) -> olist1 == list1 && olist2 == list2

581+ Left _ -> False

578582

579583sequence :: Property

580584sequence =

581585 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->

586+ monadicIO $ do

582587 let parsers = fmap (\xs -> P.fromFold $ FL.take (length xs) FL.toList) ins

583− in monadicIO $ do

584− outs <- run $

585− S.parseD

586− (Prelude.sequence parsers)

587− (S.fromList $ concat ins)

588− listEquals (==) outs ins

589−

590−altEOF1 :: Expectation

588+ outs <- S.parseD

589+ (Prelude.sequence parsers)

590+ (S.fromList $ concat ins)

591+ return $

592+ case outs of

593+ Right x -> x == ins

594+ Left _ -> False

595+

596+altEOF1 :: Property

591597altEOF1 =

592− S.parseD

598+ monadicIO $ do

599+ s1 <- S.parseD

593600 (P.satisfy (> 0) <|> return 66)

594601 (S.fromList ([]::[Int]))

595− `shouldReturn` 66

602+ return $

603+ case s1 of

604+ Right x -> x == 66

605+ Left _ -> False

596606

597−altEOF2 :: Expectation

607+altEOF2 :: Property

598608altEOF2 =

599− S.parseD

609+ monadicIO $ do

610+ s1 <- S.parseD

600611 ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList))

601612 (S.fromList ([51]::[Int]))

602− `shouldReturn` [51]

613+ return $

614+ case s1 of

615+ Right x -> x == [51]

616+ Left _ -> False

603617

604618monad :: Property

605619monad =

606620 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->

607621 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->

622+ monadicIO $ do

608623 let parser = do

609624 olist1 <- P.fromFold (FL.take (length list1) FL.toList)

610625 olist2 <- P.fromFold (FL.take (length list2) FL.toList)

611626 return (olist1, olist2)

612− in monadicIO $ do

613− (olist1, olist2) <-

614− run $ S.parseD parser (S.fromList $ list1 ++ list2)

615− listEquals (==) olist1 list1

616− listEquals (==) olist2 list2

627+ s1 <- S.parseD parser (S.fromList $ list1 ++ list2)

628+ return $

629+ case s1 of

630+ Right (olist1, olist2) -> olist1 == list1 && olist2 == list2

631+ Left _ -> False

617632

618633-------------------------------------------------------------------------------

619634-- Stream parsing

@@ -624,13 +639,11 @@ parseMany =

624639 forAll (chooseInt (1,100)) $ \len ->

625640 forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->

626641 monadicIO $ do

627− outs <-

628− ( run

629− $ toList

630− $ S.parseManyD

631− (P.fromFold $ FL.take len FL.toList) (S.fromList $ concat ins)

632− )

633− listEquals (==) outs ins

642+ outs <-

643+ (toList $ S.rights $ S.parseManyD

644+ (P.fromFold $ FL.take len FL.toList) (S.fromList $ concat ins)

645+ )

646+ return $ outs == ins

634647

635648-- basic sanity test for parsing from arrays

636649parseUnfold :: Property

@@ -664,13 +677,15 @@ parserSequence :: Property

664677parserSequence =

665678 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ins ->

666679 monadicIO $ do

667− let parsers = D.fromList

668− $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins

669− let sequencedParser = P.sequence parsers FL.sum

670− outs <-

671− run $

672− S.parseD sequencedParser $ S.concatMap S.fromList (S.fromList ins)

673− equals (==) outs (sum $ map sum ins)

680+ let parsers = D.fromList

681+ $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins

682+ let sequencedParser = P.sequence parsers FL.sum

683+ outs <-

684+ S.parseD sequencedParser $ S.concatMap S.fromList (S.fromList ins)

685+ return $

686+ case outs of

687+ Right x -> x == sum (map sum ins)

688+ Left _ -> False

674689

675690-------------------------------------------------------------------------------

676691-- Test for a particular case hit during fs events testing

@@ -722,6 +737,7 @@ parseMany2Events =

722737 xs <-

723738 ( run

724739 $ toList

740+ $ S.rights

725741 $ S.parseManyD readOneEvent

726742 $ S.fromList (concat (replicate 2 event))

727743 )

@@ -750,8 +766,8 @@ main =

750766

751767 describe "Instances" $ do

752768 prop "applicative" applicative

753− it "Alternative: end of input 1" altEOF1

754− it "Alternative: end of input 2" altEOF2

769+ prop "Alternative: end of input 1" altEOF1

770+ prop "Alternative: end of input 2" altEOF2

755771 prop "monad" monad

756772 prop "sequence" sequence

757773