d28e231 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Use Applicative instead of Monad where possible

d28e231Harendra Kumar5 years ago

.hlint.ignore−1

compare with master

unifiedsplit

@@ -3,7 +3,6 @@ src/Streamly/Internal/Data/Stream/PreludeCommon.hs

3src/Streamly/Internal/Data/Stream/Serial.hs

4src/Streamly/Internal/Data/Stream/Zip.hs

5src/Streamly/Internal/Data/Stream/StreamK/Type.hs

6−src/Streamly/Internal/Data/Stream/StreamD/Type.hs

7src/Streamly/Internal/Data/Pipe/Type.hs

6src/Streamly/Internal/Data/Pipe/Type.hs

8src/Streamly/Internal/Data/SmallArray/Type.hs

7src/Streamly/Internal/Data/SmallArray/Type.hs

9src/Streamly/Internal/Unicode/Stream.hs

8src/Streamly/Internal/Unicode/Stream.hs

src/Streamly/Internal/Data/Stream/StreamD/Type.hs+61−57

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

92import Control.Monad (when)

93import Control.Monad.Catch (MonadThrow, throwM)

94import Control.Monad.Trans.Class (lift, MonadTrans)

95+import Data.Functor (($>))

95import Data.Functor.Identity (Identity(..))

96import Data.Functor.Identity (Identity(..))

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

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

97import GHC.Base (build)

98import GHC.Base (build)

@@ -134,22 +135,22 @@ pattern Stream step state <- (unShare -> UnStream step state)

134

135

135-- | An empty 'Stream' with a side effect.

136-- | An empty 'Stream' with a side effect.

136{-# INLINE_NORMAL nilM #-}

137{-# INLINE_NORMAL nilM #-}

137−nilM :: Monad m => m b -> Stream m a

138+nilM :: Applicative m => m b -> Stream m a

138−nilM m = Stream (\_ _ -> m >> return Stop) ()

139+nilM m = Stream (\_ _ -> m $> Stop) ()

139

140

140{-# INLINE_NORMAL consM #-}

141{-# INLINE_NORMAL consM #-}

141−consM :: Monad m => m a -> Stream m a -> Stream m a

142+consM :: Applicative m => m a -> Stream m a -> Stream m a

142consM m (Stream step state) = Stream step1 Nothing

143consM m (Stream step state) = Stream step1 Nothing

144+

143 where

145 where

146+

144 {-# INLINE_LATE step1 #-}

147 {-# INLINE_LATE step1 #-}

145− step1 _ Nothing = m >>= \x -> return $ Yield x (Just state)

148+ step1 _ Nothing = (`Yield` Just state) <$> m

146 step1 gst (Just st) = do

149 step1 gst (Just st) = do

147− r <- step gst st

148− return $

149− case r of

150+ (\case

150 Yield a s -> Yield a (Just s)

151 Yield a s -> Yield a (Just s)

151 Skip s -> Skip (Just s)

152 Skip s -> Skip (Just s)

152− Stop -> Stop

153+ Stop -> Stop) <$> step gst st

153

154

154-- | Does not fuse, has the same performance as the StreamK version.

155-- | Does not fuse, has the same performance as the StreamK version.

155{-# INLINE_NORMAL uncons #-}

156{-# INLINE_NORMAL uncons #-}

@@ -172,17 +173,18 @@ data UnfoldState s = UnfoldNothing | UnfoldJust s

172-- | Convert an 'Unfold' into a 'Stream' by supplying it a seed.

173-- | Convert an 'Unfold' into a 'Stream' by supplying it a seed.

173--

174--

174{-# INLINE_NORMAL unfold #-}

175{-# INLINE_NORMAL unfold #-}

175−unfold :: Monad m => Unfold m a b -> a -> Stream m b

176+unfold :: Applicative m => Unfold m a b -> a -> Stream m b

176unfold (Unfold ustep inject) seed = Stream step UnfoldNothing

177unfold (Unfold ustep inject) seed = Stream step UnfoldNothing

178+

177− where

179+ where

180+

178 {-# INLINE_LATE step #-}

181 {-# INLINE_LATE step #-}

179− step _ UnfoldNothing = inject seed >>= return . Skip . UnfoldJust

182+ step _ UnfoldNothing = Skip . UnfoldJust <$> inject seed

180 step _ (UnfoldJust st) = do

183 step _ (UnfoldJust st) = do

181− r <- ustep st

182− return $ case r of

184+ (\case

183 Yield x s -> Yield x (UnfoldJust s)

185 Yield x s -> Yield x (UnfoldJust s)

184 Skip s -> Skip (UnfoldJust s)

186 Skip s -> Skip (UnfoldJust s)

185− Stop -> Stop

187+ Stop -> Stop) <$> ustep st

186

188

187------------------------------------------------------------------------------

189------------------------------------------------------------------------------

188-- From Values

190-- From Values

@@ -199,12 +201,14 @@ fromPure x = Stream (\_ s -> pure $ step undefined s) True

199

201

200-- | Create a singleton 'Stream' from a monadic action.

202-- | Create a singleton 'Stream' from a monadic action.

201{-# INLINE_NORMAL fromEffect #-}

203{-# INLINE_NORMAL fromEffect #-}

202−fromEffect :: Monad m => m a -> Stream m a

204+fromEffect :: Applicative m => m a -> Stream m a

203fromEffect m = Stream step True

205fromEffect m = Stream step True

206+

204− where

207+ where

208+

205 {-# INLINE_LATE step #-}

209 {-# INLINE_LATE step #-}

206− step _ True = m >>= \x -> return $ Yield x False

210+ step _ True = (`Yield` False) <$> m

207− step _ False = return Stop

211+ step _ False = pure Stop

208

212

209------------------------------------------------------------------------------

213------------------------------------------------------------------------------

210-- From Containers

214-- From Containers

@@ -226,13 +230,13 @@ fromList = Stream step

226

230

227-- | Convert a CPS encoded StreamK to direct style step encoded StreamD

231-- | Convert a CPS encoded StreamK to direct style step encoded StreamD

228{-# INLINE_LATE fromStreamK #-}

232{-# INLINE_LATE fromStreamK #-}

229−fromStreamK :: Monad m => K.Stream m a -> Stream m a

233+fromStreamK :: Applicative m => K.Stream m a -> Stream m a

230fromStreamK = Stream step

234fromStreamK = Stream step

231 where

235 where

232 step gst m1 =

236 step gst m1 =

233− let stop = return Stop

237+ let stop = pure Stop

234− single a = return $ Yield a K.nil

238+ single a = pure $ Yield a K.nil

235− yieldk a r = return $ Yield a r

239+ yieldk a r = pure $ Yield a r

236 in K.foldStreamShared gst yieldk single stop m1

240 in K.foldStreamShared gst yieldk single stop m1

237

241

238-- | Convert a direct style step encoded StreamD to a CPS encoded StreamK

242-- | Convert a direct style step encoded StreamD to a CPS encoded StreamK

@@ -261,7 +265,7 @@ toStreamK (Stream step state) = go state

261------------------------------------------------------------------------------

265------------------------------------------------------------------------------

262

266

263{-# INLINE_NORMAL fold #-}

267{-# INLINE_NORMAL fold #-}

264−fold :: (Monad m) => Fold m a b -> Stream m a -> m b

268+fold :: Monad m => Fold m a b -> Stream m a -> m b

265fold fld strm = do

269fold fld strm = do

266 (b, _) <- fold_ fld strm

270 (b, _) <- fold_ fld strm

267 return b

271 return b

@@ -349,7 +353,7 @@ foldrMx fstep final convert (Stream step state) = convert $ go SPEC state

349--

353--

350{-# INLINE_NORMAL foldr #-}

354{-# INLINE_NORMAL foldr #-}

351foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b

355foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b

352−foldr f z = foldrM (\a b -> liftA2 f (return a) b) (return z)

356+foldr f z = foldrM (liftA2 f . return) (return z)

353

357

354-- this performs horribly, should not be used

358-- this performs horribly, should not be used

355{-# INLINE_NORMAL foldrS #-}

359{-# INLINE_NORMAL foldrS #-}

@@ -409,8 +413,8 @@ foldlMx' fstep begin done (Stream step state) =

409

413

410{-# INLINE foldlx' #-}

414{-# INLINE foldlx' #-}

411foldlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> m b

415foldlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> m b

412−foldlx' fstep begin done m =

416+foldlx' fstep begin done =

413− foldlMx' (\b a -> return (fstep b a)) (return begin) (return . done) m

417+ foldlMx' (\b a -> return (fstep b a)) (return begin) (return . done)

414

418

415-- Adapted from the vector package.

419-- Adapted from the vector package.

416-- XXX implement in terms of foldlMx'?

420-- XXX implement in terms of foldlMx'?

@@ -576,17 +580,18 @@ instance Functor m => Functor (Stream m) where

576

580

577-- Adapted from the vector package.

581-- Adapted from the vector package.

578{-# INLINE_NORMAL take #-}

582{-# INLINE_NORMAL take #-}

579−take :: Monad m => Int -> Stream m a -> Stream m a

583+take :: Applicative m => Int -> Stream m a -> Stream m a

580take n (Stream step state) = n `seq` Stream step' (state, 0)

584take n (Stream step state) = n `seq` Stream step' (state, 0)

585+

581− where

586+ where

587+

582 {-# INLINE_LATE step' #-}

588 {-# INLINE_LATE step' #-}

583 step' gst (st, i) | i < n = do

589 step' gst (st, i) | i < n = do

584− r <- step gst st

585− return $ case r of

590+ (\case

586 Yield x s -> Yield x (s, i + 1)

591 Yield x s -> Yield x (s, i + 1)

587 Skip s -> Skip (s, i)

592 Skip s -> Skip (s, i)

588− Stop -> Stop

593+ Stop -> Stop) <$> step gst st

589− step' _ (_, _) = return Stop

594+ step' _ (_, _) = pure Stop

590

595

591-- Adapted from the vector package.

596-- Adapted from the vector package.

592{-# INLINE_NORMAL takeWhileM #-}

597{-# INLINE_NORMAL takeWhileM #-}

@@ -613,17 +618,20 @@ takeWhile f = takeWhileM (return . f)

613

618

614{-# INLINE_NORMAL concatAp #-}

619{-# INLINE_NORMAL concatAp #-}

615concatAp :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b

620concatAp :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b

616−concatAp (Stream stepa statea) (Stream stepb stateb) = Stream step' (Left statea)

621+concatAp (Stream stepa statea) (Stream stepb stateb) =

622+ Stream step' (Left statea)

623+

617− where

624+ where

625+

618 {-# INLINE_LATE step' #-}

626 {-# INLINE_LATE step' #-}

619 step' gst (Left st) = fmap

627 step' gst (Left st) = fmap

620− (\r -> case r of

628+ (\case

621 Yield f s -> Skip (Right (f, s, stateb))

629 Yield f s -> Skip (Right (f, s, stateb))

622 Skip s -> Skip (Left s)

630 Skip s -> Skip (Left s)

623 Stop -> Stop)

631 Stop -> Stop)

624 (stepa (adaptState gst) st)

632 (stepa (adaptState gst) st)

625 step' gst (Right (f, os, st)) = fmap

633 step' gst (Right (f, os, st)) = fmap

626− (\r -> case r of

634+ (\case

627 Yield a s -> Yield (f a) (Right (f, os, s))

635 Yield a s -> Yield (f a) (Right (f, os, s))

628 Skip s -> Skip (Right (f,os, s))

636 Skip s -> Skip (Right (f,os, s))

629 Stop -> Skip (Left os))

637 Stop -> Skip (Left os))

@@ -639,19 +647,17 @@ apSequence (Stream stepa statea) (Stream stepb stateb) =

639 {-# INLINE_LATE step #-}

647 {-# INLINE_LATE step #-}

640 step gst (Left st) =

648 step gst (Left st) =

641 fmap

649 fmap

642− (\r ->

643− case r of

650+ (\case

644− Yield _ s -> Skip (Right (s, stateb))

651+ Yield _ s -> Skip (Right (s, stateb))

645− Skip s -> Skip (Left s)

652+ Skip s -> Skip (Left s)

646− Stop -> Stop)

653+ Stop -> Stop)

647 (stepa (adaptState gst) st)

654 (stepa (adaptState gst) st)

648 step gst (Right (ostate, st)) =

655 step gst (Right (ostate, st)) =

649 fmap

656 fmap

650− (\r ->

651− case r of

657+ (\case

652− Yield b s -> Yield b (Right (ostate, s))

658+ Yield b s -> Yield b (Right (ostate, s))

653− Skip s -> Skip (Right (ostate, s))

659+ Skip s -> Skip (Right (ostate, s))

654− Stop -> Skip (Left ostate))

660+ Stop -> Skip (Left ostate))

655 (stepb gst st)

661 (stepb gst st)

656

662

657{-# INLINE_NORMAL apDiscardSnd #-}

663{-# INLINE_NORMAL apDiscardSnd #-}

@@ -664,19 +670,17 @@ apDiscardSnd (Stream stepa statea) (Stream stepb stateb) =

664 {-# INLINE_LATE step #-}

670 {-# INLINE_LATE step #-}

665 step gst (Left st) =

671 step gst (Left st) =

666 fmap

672 fmap

667− (\r ->

668− case r of

673+ (\case

669− Yield b s -> Skip (Right (s, stateb, b))

674+ Yield b s -> Skip (Right (s, stateb, b))

670− Skip s -> Skip (Left s)

675+ Skip s -> Skip (Left s)

671− Stop -> Stop)

676+ Stop -> Stop)

672 (stepa gst st)

677 (stepa gst st)

673 step gst (Right (ostate, st, b)) =

678 step gst (Right (ostate, st, b)) =

674 fmap

679 fmap

675− (\r ->

676− case r of

680+ (\case

677− Yield _ s -> Yield b (Right (ostate, s, b))

681+ Yield _ s -> Yield b (Right (ostate, s, b))

678− Skip s -> Skip (Right (ostate, s, b))

682+ Skip s -> Skip (Right (ostate, s, b))

679− Stop -> Skip (Left ostate))

683+ Stop -> Skip (Left ostate))

680 (stepb (adaptState gst) st)

684 (stepb (adaptState gst) st)

681

685

682instance Applicative f => Applicative (Stream f) where

686instance Applicative f => Applicative (Stream f) where

@@ -728,7 +732,7 @@ unfoldMany (Unfold istep inject) (Stream ostep ost) =

728 i <- inject a

732 i <- inject a

729 i `seq` return (Skip (ConcatMapUInner o' i))

733 i `seq` return (Skip (ConcatMapUInner o' i))

730 Skip o' -> return $ Skip (ConcatMapUOuter o')

734 Skip o' -> return $ Skip (ConcatMapUOuter o')

731− Stop -> return $ Stop

735+ Stop -> return Stop

732

736

733 step _ (ConcatMapUInner o i) = do

737 step _ (ConcatMapUInner o i) = do

734 r <- istep i

738 r <- istep i

src/Streamly/Internal/Data/Stream/StreamK/Type.hs+17−18

@@ -179,7 +179,7 @@ fromYieldK k = mkStream $ \_ _ sng _ -> k sng

179

180-- | Add a yield function at the head of the stream.

181consK :: YieldK m a -> Stream m a -> Stream m a

182−consK k r = mkStream $ \_ yld _ _ -> k (\x -> yld x r)

182+consK k r = mkStream $ \_ yld _ _ -> k (`yld` r)

183

184-- XXX Build a stream from a repeating callback function.

185

@@ -241,8 +241,8 @@ nil = mkStream $ \_ _ _ stp -> stp

241--

242-- /Pre-release/

243{-# INLINE_NORMAL nilM #-}

244−nilM :: Monad m => m b -> Stream m a

244+nilM :: Applicative m => m b -> Stream m a

245−nilM m = mkStream $ \_ _ _ stp -> m >> stp

245+nilM m = mkStream $ \_ _ _ stp -> m *> stp

246

247{-# INLINE_NORMAL fromPure #-}

248fromPure :: a -> Stream m a

@@ -259,8 +259,8 @@ infixr 5 `consM`

259-- SPECIALIZE in the instance definition.

260{-# INLINE consM #-}

261{-# SPECIALIZE consM :: IO a -> Stream IO a -> Stream IO a #-}

262−consM :: (Monad m) => m a -> Stream m a -> Stream m a

262+consM :: Monad m => m a -> Stream m a -> Stream m a

263−consM m r = MkStream $ \_ yld _ _ -> m >>= \a -> yld a r

263+consM m r = MkStream $ \_ yld _ _ -> m >>= (`yld` r)

264

265-- XXX specialize to IO?

266{-# INLINE consMBy #-}

@@ -1270,30 +1270,29 @@ fromFoldableM = Prelude.foldr consM nil

1270-------------------------------------------------------------------------------

1271

1272{-# INLINE uncons #-}

1273−uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))

1273+uncons :: Applicative m => Stream m a -> m (Maybe (a, Stream m a))

1274uncons m =

1275− let stop = return Nothing

1275+ let stop = pure Nothing

1276− single a = return (Just (a, nil))

1276+ single a = pure (Just (a, nil))

1277− yieldk a r = return (Just (a, r))

1277+ yieldk a r = pure (Just (a, r))

1278 in foldStream defState yieldk single stop m

1279

1280{-# INLINE tail #-}

1281−tail :: Monad m => Stream m a -> m (Maybe (Stream m a))

1281+tail :: Applicative m => Stream m a -> m (Maybe (Stream m a))

1282tail =

1283− let stop = return Nothing

1283+ let stop = pure Nothing

1284− single _ = return $ Just nil

1284+ single _ = pure $ Just nil

1285− yieldk _ r = return $ Just r

1285+ yieldk _ r = pure $ Just r

1286 in foldStream defState yieldk single stop

1287

1288{-# INLINE init #-}

1289−init :: Monad m => Stream m a -> m (Maybe (Stream m a))

1289+init :: Applicative m => Stream m a -> m (Maybe (Stream m a))

1290init = go1

1291 where

1292 go1 m1 = do

1293− r <- uncons m1

1294− case r of

1293+ (\case

1295− Nothing -> return Nothing

1294+ Nothing -> Nothing

1296− Just (h, t) -> return . Just $ go h t

1295+ Just (h, t) -> Just $ go h t) <$> uncons m1

1297 go p m1 = mkStream $ \_ yld sng stp ->

1296 go p m1 = mkStream $ \_ yld sng stp ->

1298 let single _ = sng p

1297 let single _ = sng p

1299 yieldk a x = yld p $ go a x

1298 yieldk a x = yld p $ go a x

src/Streamly/Internal/Data/Unfold.hs+94−103

@@ -250,6 +250,7 @@ import Control.Exception (Exception, mask_)

250import Control.Monad.Catch (MonadCatch)

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

252import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp_)

253+import Data.Functor (($>))

253import GHC.Types (SPEC(..))

254import GHC.Types (SPEC(..))

254import Streamly.Internal.Control.Concurrent (MonadAsync)

255import Streamly.Internal.Control.Concurrent (MonadAsync)

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

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

@@ -417,25 +418,20 @@ mapMWithInput f (Unfold ustep uinject) = Unfold step inject

417--

418--

418-- /Internal/

419-- /Internal/

419{-# INLINE_NORMAL either #-}

420{-# INLINE_NORMAL either #-}

420−either :: Monad m => Unfold m a b -> Unfold m (Either a a) (Either b b)

421+either :: Applicative m => Unfold m a b -> Unfold m (Either a a) (Either b b)

421either (Unfold step1 inject1) = Unfold step inject

422either (Unfold step1 inject1) = Unfold step inject

422

423

423 where

424 where

424

425

425− inject (Left a) = do

426+ inject (Left a) = (, Left) <$> inject1 a

426− r <- inject1 a

427− return (r, Left)

428− inject (Right a) = do

427+ inject (Right a) = (, Right) <$> inject1 a

429− r <- inject1 a

430− return (r, Right)

431

428

432 {-# INLINE_LATE step #-}

429 {-# INLINE_LATE step #-}

433 step (st, f) = do

430 step (st, f) = do

434− r <- step1 st

435− return $ case r of

431+ (\case

436 Yield x s -> Yield (f x) (s, f)

432 Yield x s -> Yield (f x) (s, f)

437 Skip s -> Skip (s, f)

433 Skip s -> Skip (s, f)

438− Stop -> Stop

434+ Stop -> Stop) <$> step1 st

439

435

440-- See StreamD.scanlM' for implementing this.

436-- See StreamD.scanlM' for implementing this.

441--

437--

@@ -452,30 +448,29 @@ scanlM' = undefined

452-------------------------------------------------------------------------------

448-------------------------------------------------------------------------------

453

449

454{-# INLINE_NORMAL fromStreamD #-}

450{-# INLINE_NORMAL fromStreamD #-}

455−fromStreamD :: Monad m => Unfold m (Stream m a) a

451+fromStreamD :: Applicative m => Unfold m (Stream m a) a

456−fromStreamD = Unfold step return

452+fromStreamD = Unfold step pure

453+

457 where

454 where

458

455

459 {-# INLINE_LATE step #-}

456 {-# INLINE_LATE step #-}

460− step (UnStream step1 state1) = do

457+ step (UnStream step1 state1) =

461− r <- step1 defState state1

462− return $ case r of

458+ (\case

463 Yield x s -> Yield x (Stream step1 s)

459 Yield x s -> Yield x (Stream step1 s)

464 Skip s -> Skip (Stream step1 s)

460 Skip s -> Skip (Stream step1 s)

465− Stop -> Stop

461+ Stop -> Stop) <$> step1 defState state1

466

462

467{-# INLINE_NORMAL fromStreamK #-}

463{-# INLINE_NORMAL fromStreamK #-}

468−fromStreamK :: Monad m => Unfold m (K.Stream m a) a

464+fromStreamK :: Applicative m => Unfold m (K.Stream m a) a

469−fromStreamK = Unfold step return

465+fromStreamK = Unfold step pure

470

466

471 where

467 where

472

468

473 {-# INLINE_LATE step #-}

469 {-# INLINE_LATE step #-}

474 step stream = do

470 step stream = do

475− r <- K.uncons stream

476− return $ case r of

471+ (\case

477 Just (x, xs) -> Yield x xs

472 Just (x, xs) -> Yield x xs

478− Nothing -> Stop

473+ Nothing -> Stop) <$> K.uncons stream

479

474

480-- XXX Using Unfold.fromStreamD seems to be faster (using cross product test

475-- XXX Using Unfold.fromStreamD seems to be faster (using cross product test

481-- case) than using fromStream even if it is implemented using fromStreamD.

476-- case) than using fromStream even if it is implemented using fromStreamD.

@@ -486,7 +481,7 @@ fromStreamK = Unfold step return

486-- /Since: 0.8.0/

481-- /Since: 0.8.0/

487--

482--

488{-# INLINE_NORMAL fromStream #-}

483{-# INLINE_NORMAL fromStream #-}

489−fromStream :: (IsStream t, Monad m) => Unfold m (t m a) a

484+fromStream :: (IsStream t, Applicative m) => Unfold m (t m a) a

490fromStream = lmap IsStream.toStream fromStreamK

485fromStream = lmap IsStream.toStream fromStreamK

491

486

492-------------------------------------------------------------------------------

487-------------------------------------------------------------------------------

@@ -497,59 +492,61 @@ fromStream = lmap IsStream.toStream fromStreamK

497-- effect.

492-- effect.

498--

493--

499{-# INLINE nilM #-}

494{-# INLINE nilM #-}

500−nilM :: Monad m => (a -> m c) -> Unfold m a b

495+nilM :: Applicative m => (a -> m c) -> Unfold m a b

501−nilM f = Unfold step return

496+nilM f = Unfold step pure

497+

502 where

498 where

499+

503 {-# INLINE_LATE step #-}

500 {-# INLINE_LATE step #-}

504− step x = f x >> return Stop

501+ step x = f x $> Stop

505

502

506-- | Prepend a monadic single element generator function to an 'Unfold'. The

503-- | Prepend a monadic single element generator function to an 'Unfold'. The

507-- same seed is used in the action as well as the unfold.

504-- same seed is used in the action as well as the unfold.

508--

505--

509-- /Pre-release/

506-- /Pre-release/

510{-# INLINE_NORMAL consM #-}

507{-# INLINE_NORMAL consM #-}

511−consM :: Monad m => (a -> m b) -> Unfold m a b -> Unfold m a b

508+consM :: Applicative m => (a -> m b) -> Unfold m a b -> Unfold m a b

512consM action unf = Unfold step inject

509consM action unf = Unfold step inject

513

510

514 where

511 where

515

512

516− inject = return . Left

513+ inject = pure . Left

517

514

518 {-# INLINE_LATE step #-}

515 {-# INLINE_LATE step #-}

519− step (Left a) =

520− action a >>= \r -> return $ Yield r (Right (D.unfold unf a))

516+ step (Left a) = (`Yield` Right (D.unfold unf a)) <$> action a

521 step (Right (UnStream step1 st)) = do

517 step (Right (UnStream step1 st)) = do

518+ (\case

519+ Yield x s -> Yield x (Right (Stream step1 s))

520+ Skip s -> Skip (Right (Stream step1 s))

522− res <- step1 defState st

521+ Stop -> Stop) <$> step1 defState st

523− case res of

524− Yield x s -> return $ Yield x (Right (Stream step1 s))

525− Skip s -> return $ Skip (Right (Stream step1 s))

526− Stop -> return Stop

527

522

528-- | Convert a list of pure values to a 'Stream'

523-- | Convert a list of pure values to a 'Stream'

529--

524--

530-- /Since: 0.8.0/

525-- /Since: 0.8.0/

531--

526--

532{-# INLINE_LATE fromList #-}

527{-# INLINE_LATE fromList #-}

533−fromList :: Monad m => Unfold m [a] a

528+fromList :: Applicative m => Unfold m [a] a

534−fromList = Unfold step inject

529+fromList = Unfold step pure

530+

535− where

531+ where

536− inject = return

532+

537 {-# INLINE_LATE step #-}

533 {-# INLINE_LATE step #-}

538− step (x:xs) = return $ Yield x xs

534+ step (x:xs) = pure $ Yield x xs

539− step [] = return Stop

535+ step [] = pure Stop

540

536

541-- | Convert a list of monadic values to a 'Stream'

537-- | Convert a list of monadic values to a 'Stream'

542--

538--

543-- /Since: 0.8.0/

539-- /Since: 0.8.0/

544--

540--

545{-# INLINE_LATE fromListM #-}

541{-# INLINE_LATE fromListM #-}

546−fromListM :: Monad m => Unfold m [m a] a

542+fromListM :: Applicative m => Unfold m [m a] a

547−fromListM = Unfold step inject

543+fromListM = Unfold step pure

544+

548− where

545+ where

549− inject = return

546+

550 {-# INLINE_LATE step #-}

547 {-# INLINE_LATE step #-}

551− step (x:xs) = x >>= \r -> return $ Yield r xs

548+ step (x:xs) = (`Yield` xs) <$> x

552− step [] = return Stop

549+ step [] = pure Stop

553

550

554------------------------------------------------------------------------------

551------------------------------------------------------------------------------

555-- Specialized Generation

552-- Specialized Generation

@@ -560,31 +557,31 @@ fromListM = Unfold step inject

560-- /Since: 0.8.0/

557-- /Since: 0.8.0/

561--

558--

562{-# INLINE replicateM #-}

559{-# INLINE replicateM #-}

563−replicateM :: Monad m => Int -> Unfold m (m a) a

560+replicateM :: Applicative m => Int -> Unfold m (m a) a

564replicateM n = Unfold step inject

561replicateM n = Unfold step inject

565

562

566 where

563 where

567

564

568− inject x = return (x, n)

565+ inject action = pure (action, n)

569

566

570 {-# INLINE_LATE step #-}

567 {-# INLINE_LATE step #-}

571− step (x, i) =

568+ step (action, i) =

572 if i <= 0

569 if i <= 0

573− then return Stop

570+ then pure Stop

574− else do

571+ else (\x -> Yield x (action, i - 1)) <$> action

575− x1 <- x

576− return $ Yield x1 (x, i - 1)

577

572

578-- | Generates an infinite stream repeating the seed.

573-- | Generates an infinite stream repeating the seed.

579--

574--

580-- /Since: 0.8.0/

575-- /Since: 0.8.0/

581--

576--

582{-# INLINE repeatM #-}

577{-# INLINE repeatM #-}

583−repeatM :: Monad m => Unfold m (m a) a

578+repeatM :: Applicative m => Unfold m (m a) a

584−repeatM = Unfold step return

579+repeatM = Unfold step pure

580+

585 where

581 where

582+

586 {-# INLINE_LATE step #-}

583 {-# INLINE_LATE step #-}

587− step x = x >>= \x1 -> return $ Yield x1 x

584+ step action = (`Yield` action) <$> action

588

585

589-- | Generates an infinite stream starting with the given seed and applying the

586-- | Generates an infinite stream starting with the given seed and applying the

590-- given function repeatedly.

587-- given function repeatedly.

@@ -592,13 +589,13 @@ repeatM = Unfold step return

592-- /Since: 0.8.0/

589-- /Since: 0.8.0/

593--

590--

594{-# INLINE iterateM #-}

591{-# INLINE iterateM #-}

595−iterateM :: Monad m => (a -> m a) -> Unfold m (m a) a

592+iterateM :: Applicative m => (a -> m a) -> Unfold m (m a) a

596iterateM f = Unfold step id

593iterateM f = Unfold step id

594+

597 where

595 where

596+

598 {-# INLINE_LATE step #-}

597 {-# INLINE_LATE step #-}

599− step x = do

598+ step x = Yield x <$> f x

600− fx <- f x

601− return $ Yield x fx

602

599

603-- | @fromIndicesM gen@ generates an infinite stream of values using @gen@

600-- | @fromIndicesM gen@ generates an infinite stream of values using @gen@

604-- starting from the seed.

601-- starting from the seed.

@@ -610,13 +607,13 @@ iterateM f = Unfold step id

610-- /Pre-release/

607-- /Pre-release/

611--

608--

612{-# INLINE_NORMAL fromIndicesM #-}

609{-# INLINE_NORMAL fromIndicesM #-}

613−fromIndicesM :: Monad m => (Int -> m a) -> Unfold m Int a

610+fromIndicesM :: Applicative m => (Int -> m a) -> Unfold m Int a

614−fromIndicesM gen = Unfold step return

611+fromIndicesM gen = Unfold step pure

612+

615− where

613+ where

614+

616 {-# INLINE_LATE step #-}

615 {-# INLINE_LATE step #-}

617− step i = do

618− x <- gen i

619− return $ Yield x (i + 1)

616+ step i = (`Yield` (i + 1)) <$> gen i

620

617

621-------------------------------------------------------------------------------

618-------------------------------------------------------------------------------

622-- Filtering

619-- Filtering

@@ -630,20 +627,20 @@ fromIndicesM gen = Unfold step return

630-- /Since: 0.8.0/

627-- /Since: 0.8.0/

631--

628--

632{-# INLINE_NORMAL take #-}

629{-# INLINE_NORMAL take #-}

633−take :: Monad m => Int -> Unfold m a b -> Unfold m a b

630+take :: Applicative m => Int -> Unfold m a b -> Unfold m a b

634take n (Unfold step1 inject1) = Unfold step inject

631take n (Unfold step1 inject1) = Unfold step inject

632+

635− where

633+ where

634+

636− inject x = do

635+ inject x = (, 0) <$> inject1 x

637− s <- inject1 x

636+

638− return (s, 0)

639 {-# INLINE_LATE step #-}

637 {-# INLINE_LATE step #-}

640 step (st, i) | i < n = do

638 step (st, i) | i < n = do

641− r <- step1 st

642− return $ case r of

639+ (\case

643 Yield x s -> Yield x (s, i + 1)

640 Yield x s -> Yield x (s, i + 1)

644 Skip s -> Skip (s, i)

641 Skip s -> Skip (s, i)

645− Stop -> Stop

642+ Stop -> Stop) <$> step1 st

646− step (_, _) = return Stop

643+ step (_, _) = pure Stop

647

644

648-- | Same as 'filter' but with a monadic predicate.

645-- | Same as 'filter' but with a monadic predicate.

649--

646--

@@ -676,31 +673,25 @@ filter f = filterM (return . f)

676-- /Since: 0.8.0/

673-- /Since: 0.8.0/

677--

674--

678{-# INLINE_NORMAL drop #-}

675{-# INLINE_NORMAL drop #-}

679−drop :: Monad m => Int -> Unfold m a b -> Unfold m a b

676+drop :: Applicative m => Int -> Unfold m a b -> Unfold m a b

680drop n (Unfold step inject) = Unfold step' inject'

677drop n (Unfold step inject) = Unfold step' inject'

681

678

682 where

679 where

683

680

684− inject' a = do

681+ inject' a = (, n) <$> inject a

685− b <- inject a

686− return (b, n)

687

682

688 {-# INLINE_LATE step' #-}

683 {-# INLINE_LATE step' #-}

689 step' (st, i)

684 step' (st, i)

690 | i > 0 = do

685 | i > 0 = do

691− r <- step st

692− return

693− $ case r of

686+ (\case

694− Yield _ s -> Skip (s, i - 1)

687+ Yield _ s -> Skip (s, i - 1)

695− Skip s -> Skip (s, i)

688+ Skip s -> Skip (s, i)

696− Stop -> Stop

689+ Stop -> Stop) <$> step st

697 | otherwise = do

690 | otherwise = do

691+ (\case

692+ Yield x s -> Yield x (s, 0)

693+ Skip s -> Skip (s, 0)

698− r <- step st

694+ Stop -> Stop) <$> step st

699− return

700− $ case r of

701− Yield x s -> Yield x (s, 0)

702− Skip s -> Skip (s, 0)

703− Stop -> Stop

704

695

705-- | @dropWhileM f unf@ drops elements from the stream generated by @unf@ while

696-- | @dropWhileM f unf@ drops elements from the stream generated by @unf@ while

706-- the condition holds true. The condition function @f@ is /monadic/ in nature.

697-- the condition holds true. The condition function @f@ is /monadic/ in nature.

@@ -793,10 +784,10 @@ gbracket_ bef exc aft (Unfold estep einject) (Unfold step1 inject1) =

793 return $ Skip (Left r)

784 return $ Skip (Left r)

794 step (Left st) = do

785 step (Left st) = do

795 res <- estep st

786 res <- estep st

796− case res of

787+ return $ case res of

797− Yield x s -> return $ Yield x (Left s)

788+ Yield x s -> Yield x (Left s)

798− Skip s -> return $ Skip (Left s)

789+ Skip s -> Skip (Left s)

799− Stop -> return Stop

790+ Stop -> Stop

800

791

801-- | Run the alloc action @a -> m c@ with async exceptions disabled but keeping

792-- | Run the alloc action @a -> m c@ with async exceptions disabled but keeping

802-- blocking operations interruptible (see 'Control.Exception.mask'). Use the

793-- blocking operations interruptible (see 'Control.Exception.mask'). Use the

@@ -858,10 +849,10 @@ gbracket bef exc aft (Unfold estep einject) (Unfold step1 inject1) =

858 return $ Skip (Left r)

849 return $ Skip (Left r)

859 step (Left st) = do

850 step (Left st) = do

860 res <- estep st

851 res <- estep st

861− case res of

852+ return $ case res of

862− Yield x s -> return $ Yield x (Left s)

853+ Yield x s -> Yield x (Left s)

863− Skip s -> return $ Skip (Left s)

854+ Skip s -> Skip (Left s)

864− Stop -> return Stop

855+ Stop -> Stop

865

856

866-- | Run a side effect @a -> m c@ on the input @a@ before unfolding it using

857-- | Run a side effect @a -> m c@ on the input @a@ before unfolding it using

867-- @Unfold m a b@.

858-- @Unfold m a b@.

@@ -964,10 +955,10 @@ onException action (Unfold step1 inject1) = Unfold step inject

964 {-# INLINE_LATE step #-}

955 {-# INLINE_LATE step #-}

965 step (st, v) = do

956 step (st, v) = do

966 res <- step1 st `MC.onException` action v

957 res <- step1 st `MC.onException` action v

967− case res of

958+ return $ case res of

968− Yield x s -> return $ Yield x (s, v)

959+ Yield x s -> Yield x (s, v)

969− Skip s -> return $ Skip (s, v)

960+ Skip s -> Skip (s, v)

970− Stop -> return Stop

961+ Stop -> Stop

971

962

972{-# INLINE_NORMAL _finally #-}

963{-# INLINE_NORMAL _finally #-}

973_finally :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b

964_finally :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b