mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 19:47:10 +03:00
Use Applicative instead of Monad where possible
Only refactoring, no functional change. In Unfold, StreamD and StreamK. Also fix a few hlint issues.
This commit is contained in:
Harendra Kumar
parent
ed2c32f99a
commit
d28e2313f1
@ -3,7 +3,6 @@ src/Streamly/Internal/Data/Stream/PreludeCommon.hs
|
||||
src/Streamly/Internal/Data/Stream/Serial.hs
|
||||
src/Streamly/Internal/Data/Stream/Zip.hs
|
||||
src/Streamly/Internal/Data/Stream/StreamK/Type.hs
|
||||
src/Streamly/Internal/Data/Stream/StreamD/Type.hs
|
||||
src/Streamly/Internal/Data/Pipe/Type.hs
|
||||
src/Streamly/Internal/Data/SmallArray/Type.hs
|
||||
src/Streamly/Internal/Unicode/Stream.hs
|
||||
|
||||
@ -92,6 +92,7 @@ import Control.Applicative (liftA2)
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Catch (MonadThrow, throwM)
|
||||
import Control.Monad.Trans.Class (lift, MonadTrans)
|
||||
import Data.Functor (($>))
|
||||
import Data.Functor.Identity (Identity(..))
|
||||
import Fusion.Plugin.Types (Fuse(..))
|
||||
import GHC.Base (build)
|
||||
@ -134,22 +135,22 @@ pattern Stream step state <- (unShare -> UnStream step state)
|
||||
|
||||
-- | An empty 'Stream' with a side effect.
|
||||
{-# INLINE_NORMAL nilM #-}
|
||||
nilM :: Monad m => m b -> Stream m a
|
||||
nilM m = Stream (\_ _ -> m >> return Stop) ()
|
||||
nilM :: Applicative m => m b -> Stream m a
|
||||
nilM m = Stream (\_ _ -> m $> Stop) ()
|
||||
|
||||
{-# INLINE_NORMAL consM #-}
|
||||
consM :: Monad m => m a -> Stream m a -> Stream m a
|
||||
consM :: Applicative m => m a -> Stream m a -> Stream m a
|
||||
consM m (Stream step state) = Stream step1 Nothing
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step1 #-}
|
||||
step1 _ Nothing = m >>= \x -> return $ Yield x (Just state)
|
||||
step1 _ Nothing = (`Yield` Just state) <$> m
|
||||
step1 gst (Just st) = do
|
||||
r <- step gst st
|
||||
return $
|
||||
case r of
|
||||
(\case
|
||||
Yield a s -> Yield a (Just s)
|
||||
Skip s -> Skip (Just s)
|
||||
Stop -> Stop
|
||||
Stop -> Stop) <$> step gst st
|
||||
|
||||
-- | Does not fuse, has the same performance as the StreamK version.
|
||||
{-# INLINE_NORMAL uncons #-}
|
||||
@ -172,17 +173,18 @@ data UnfoldState s = UnfoldNothing | UnfoldJust s
|
||||
-- | Convert an 'Unfold' into a 'Stream' by supplying it a seed.
|
||||
--
|
||||
{-# INLINE_NORMAL unfold #-}
|
||||
unfold :: Monad m => Unfold m a b -> a -> Stream m b
|
||||
unfold :: Applicative m => Unfold m a b -> a -> Stream m b
|
||||
unfold (Unfold ustep inject) seed = Stream step UnfoldNothing
|
||||
where
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step _ UnfoldNothing = inject seed >>= return . Skip . UnfoldJust
|
||||
step _ UnfoldNothing = Skip . UnfoldJust <$> inject seed
|
||||
step _ (UnfoldJust st) = do
|
||||
r <- ustep st
|
||||
return $ case r of
|
||||
(\case
|
||||
Yield x s -> Yield x (UnfoldJust s)
|
||||
Skip s -> Skip (UnfoldJust s)
|
||||
Stop -> Stop
|
||||
Stop -> Stop) <$> ustep st
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- From Values
|
||||
@ -199,12 +201,14 @@ fromPure x = Stream (\_ s -> pure $ step undefined s) True
|
||||
|
||||
-- | Create a singleton 'Stream' from a monadic action.
|
||||
{-# INLINE_NORMAL fromEffect #-}
|
||||
fromEffect :: Monad m => m a -> Stream m a
|
||||
fromEffect :: Applicative m => m a -> Stream m a
|
||||
fromEffect m = Stream step True
|
||||
where
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step _ True = m >>= \x -> return $ Yield x False
|
||||
step _ False = return Stop
|
||||
step _ True = (`Yield` False) <$> m
|
||||
step _ False = pure Stop
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- From Containers
|
||||
@ -226,13 +230,13 @@ fromList = Stream step
|
||||
|
||||
-- | Convert a CPS encoded StreamK to direct style step encoded StreamD
|
||||
{-# INLINE_LATE fromStreamK #-}
|
||||
fromStreamK :: Monad m => K.Stream m a -> Stream m a
|
||||
fromStreamK :: Applicative m => K.Stream m a -> Stream m a
|
||||
fromStreamK = Stream step
|
||||
where
|
||||
step gst m1 =
|
||||
let stop = return Stop
|
||||
single a = return $ Yield a K.nil
|
||||
yieldk a r = return $ Yield a r
|
||||
let stop = pure Stop
|
||||
single a = pure $ Yield a K.nil
|
||||
yieldk a r = pure $ Yield a r
|
||||
in K.foldStreamShared gst yieldk single stop m1
|
||||
|
||||
-- | Convert a direct style step encoded StreamD to a CPS encoded StreamK
|
||||
@ -261,7 +265,7 @@ toStreamK (Stream step state) = go state
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE_NORMAL fold #-}
|
||||
fold :: (Monad m) => Fold m a b -> Stream m a -> m b
|
||||
fold :: Monad m => Fold m a b -> Stream m a -> m b
|
||||
fold fld strm = do
|
||||
(b, _) <- fold_ fld strm
|
||||
return b
|
||||
@ -349,7 +353,7 @@ foldrMx fstep final convert (Stream step state) = convert $ go SPEC state
|
||||
--
|
||||
{-# INLINE_NORMAL foldr #-}
|
||||
foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b
|
||||
foldr f z = foldrM (\a b -> liftA2 f (return a) b) (return z)
|
||||
foldr f z = foldrM (liftA2 f . return) (return z)
|
||||
|
||||
-- this performs horribly, should not be used
|
||||
{-# INLINE_NORMAL foldrS #-}
|
||||
@ -409,8 +413,8 @@ foldlMx' fstep begin done (Stream step state) =
|
||||
|
||||
{-# INLINE foldlx' #-}
|
||||
foldlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> m b
|
||||
foldlx' fstep begin done m =
|
||||
foldlMx' (\b a -> return (fstep b a)) (return begin) (return . done) m
|
||||
foldlx' fstep begin done =
|
||||
foldlMx' (\b a -> return (fstep b a)) (return begin) (return . done)
|
||||
|
||||
-- Adapted from the vector package.
|
||||
-- XXX implement in terms of foldlMx'?
|
||||
@ -576,17 +580,18 @@ instance Functor m => Functor (Stream m) where
|
||||
|
||||
-- Adapted from the vector package.
|
||||
{-# INLINE_NORMAL take #-}
|
||||
take :: Monad m => Int -> Stream m a -> Stream m a
|
||||
take :: Applicative m => Int -> Stream m a -> Stream m a
|
||||
take n (Stream step state) = n `seq` Stream step' (state, 0)
|
||||
where
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step' #-}
|
||||
step' gst (st, i) | i < n = do
|
||||
r <- step gst st
|
||||
return $ case r of
|
||||
(\case
|
||||
Yield x s -> Yield x (s, i + 1)
|
||||
Skip s -> Skip (s, i)
|
||||
Stop -> Stop
|
||||
step' _ (_, _) = return Stop
|
||||
Stop -> Stop) <$> step gst st
|
||||
step' _ (_, _) = pure Stop
|
||||
|
||||
-- Adapted from the vector package.
|
||||
{-# INLINE_NORMAL takeWhileM #-}
|
||||
@ -613,17 +618,20 @@ takeWhile f = takeWhileM (return . f)
|
||||
|
||||
{-# INLINE_NORMAL concatAp #-}
|
||||
concatAp :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b
|
||||
concatAp (Stream stepa statea) (Stream stepb stateb) = Stream step' (Left statea)
|
||||
where
|
||||
concatAp (Stream stepa statea) (Stream stepb stateb) =
|
||||
Stream step' (Left statea)
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step' #-}
|
||||
step' gst (Left st) = fmap
|
||||
(\r -> case r of
|
||||
(\case
|
||||
Yield f s -> Skip (Right (f, s, stateb))
|
||||
Skip s -> Skip (Left s)
|
||||
Stop -> Stop)
|
||||
(stepa (adaptState gst) st)
|
||||
step' gst (Right (f, os, st)) = fmap
|
||||
(\r -> case r of
|
||||
(\case
|
||||
Yield a s -> Yield (f a) (Right (f, os, s))
|
||||
Skip s -> Skip (Right (f,os, s))
|
||||
Stop -> Skip (Left os))
|
||||
@ -639,19 +647,17 @@ apSequence (Stream stepa statea) (Stream stepb stateb) =
|
||||
{-# INLINE_LATE step #-}
|
||||
step gst (Left st) =
|
||||
fmap
|
||||
(\r ->
|
||||
case r of
|
||||
Yield _ s -> Skip (Right (s, stateb))
|
||||
Skip s -> Skip (Left s)
|
||||
Stop -> Stop)
|
||||
(\case
|
||||
Yield _ s -> Skip (Right (s, stateb))
|
||||
Skip s -> Skip (Left s)
|
||||
Stop -> Stop)
|
||||
(stepa (adaptState gst) st)
|
||||
step gst (Right (ostate, st)) =
|
||||
fmap
|
||||
(\r ->
|
||||
case r of
|
||||
Yield b s -> Yield b (Right (ostate, s))
|
||||
Skip s -> Skip (Right (ostate, s))
|
||||
Stop -> Skip (Left ostate))
|
||||
(\case
|
||||
Yield b s -> Yield b (Right (ostate, s))
|
||||
Skip s -> Skip (Right (ostate, s))
|
||||
Stop -> Skip (Left ostate))
|
||||
(stepb gst st)
|
||||
|
||||
{-# INLINE_NORMAL apDiscardSnd #-}
|
||||
@ -664,19 +670,17 @@ apDiscardSnd (Stream stepa statea) (Stream stepb stateb) =
|
||||
{-# INLINE_LATE step #-}
|
||||
step gst (Left st) =
|
||||
fmap
|
||||
(\r ->
|
||||
case r of
|
||||
Yield b s -> Skip (Right (s, stateb, b))
|
||||
Skip s -> Skip (Left s)
|
||||
Stop -> Stop)
|
||||
(\case
|
||||
Yield b s -> Skip (Right (s, stateb, b))
|
||||
Skip s -> Skip (Left s)
|
||||
Stop -> Stop)
|
||||
(stepa gst st)
|
||||
step gst (Right (ostate, st, b)) =
|
||||
fmap
|
||||
(\r ->
|
||||
case r of
|
||||
Yield _ s -> Yield b (Right (ostate, s, b))
|
||||
Skip s -> Skip (Right (ostate, s, b))
|
||||
Stop -> Skip (Left ostate))
|
||||
(\case
|
||||
Yield _ s -> Yield b (Right (ostate, s, b))
|
||||
Skip s -> Skip (Right (ostate, s, b))
|
||||
Stop -> Skip (Left ostate))
|
||||
(stepb (adaptState gst) st)
|
||||
|
||||
instance Applicative f => Applicative (Stream f) where
|
||||
@ -728,7 +732,7 @@ unfoldMany (Unfold istep inject) (Stream ostep ost) =
|
||||
i <- inject a
|
||||
i `seq` return (Skip (ConcatMapUInner o' i))
|
||||
Skip o' -> return $ Skip (ConcatMapUOuter o')
|
||||
Stop -> return $ Stop
|
||||
Stop -> return Stop
|
||||
|
||||
step _ (ConcatMapUInner o i) = do
|
||||
r <- istep i
|
||||
|
||||
@ -179,7 +179,7 @@ fromYieldK k = mkStream $ \_ _ sng _ -> k sng
|
||||
|
||||
-- | Add a yield function at the head of the stream.
|
||||
consK :: YieldK m a -> Stream m a -> Stream m a
|
||||
consK k r = mkStream $ \_ yld _ _ -> k (\x -> yld x r)
|
||||
consK k r = mkStream $ \_ yld _ _ -> k (`yld` r)
|
||||
|
||||
-- XXX Build a stream from a repeating callback function.
|
||||
|
||||
@ -241,8 +241,8 @@ nil = mkStream $ \_ _ _ stp -> stp
|
||||
--
|
||||
-- /Pre-release/
|
||||
{-# INLINE_NORMAL nilM #-}
|
||||
nilM :: Monad m => m b -> Stream m a
|
||||
nilM m = mkStream $ \_ _ _ stp -> m >> stp
|
||||
nilM :: Applicative m => m b -> Stream m a
|
||||
nilM m = mkStream $ \_ _ _ stp -> m *> stp
|
||||
|
||||
{-# INLINE_NORMAL fromPure #-}
|
||||
fromPure :: a -> Stream m a
|
||||
@ -259,8 +259,8 @@ infixr 5 `consM`
|
||||
-- SPECIALIZE in the instance definition.
|
||||
{-# INLINE consM #-}
|
||||
{-# SPECIALIZE consM :: IO a -> Stream IO a -> Stream IO a #-}
|
||||
consM :: (Monad m) => m a -> Stream m a -> Stream m a
|
||||
consM m r = MkStream $ \_ yld _ _ -> m >>= \a -> yld a r
|
||||
consM :: Monad m => m a -> Stream m a -> Stream m a
|
||||
consM m r = MkStream $ \_ yld _ _ -> m >>= (`yld` r)
|
||||
|
||||
-- XXX specialize to IO?
|
||||
{-# INLINE consMBy #-}
|
||||
@ -1270,30 +1270,29 @@ fromFoldableM = Prelude.foldr consM nil
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE uncons #-}
|
||||
uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))
|
||||
uncons :: Applicative m => Stream m a -> m (Maybe (a, Stream m a))
|
||||
uncons m =
|
||||
let stop = return Nothing
|
||||
single a = return (Just (a, nil))
|
||||
yieldk a r = return (Just (a, r))
|
||||
let stop = pure Nothing
|
||||
single a = pure (Just (a, nil))
|
||||
yieldk a r = pure (Just (a, r))
|
||||
in foldStream defState yieldk single stop m
|
||||
|
||||
{-# INLINE tail #-}
|
||||
tail :: Monad m => Stream m a -> m (Maybe (Stream m a))
|
||||
tail :: Applicative m => Stream m a -> m (Maybe (Stream m a))
|
||||
tail =
|
||||
let stop = return Nothing
|
||||
single _ = return $ Just nil
|
||||
yieldk _ r = return $ Just r
|
||||
let stop = pure Nothing
|
||||
single _ = pure $ Just nil
|
||||
yieldk _ r = pure $ Just r
|
||||
in foldStream defState yieldk single stop
|
||||
|
||||
{-# INLINE init #-}
|
||||
init :: Monad m => Stream m a -> m (Maybe (Stream m a))
|
||||
init :: Applicative m => Stream m a -> m (Maybe (Stream m a))
|
||||
init = go1
|
||||
where
|
||||
go1 m1 = do
|
||||
r <- uncons m1
|
||||
case r of
|
||||
Nothing -> return Nothing
|
||||
Just (h, t) -> return . Just $ go h t
|
||||
(\case
|
||||
Nothing -> Nothing
|
||||
Just (h, t) -> Just $ go h t) <$> uncons m1
|
||||
go p m1 = mkStream $ \_ yld sng stp ->
|
||||
let single _ = sng p
|
||||
yieldk a x = yld p $ go a x
|
||||
|
||||
@ -250,6 +250,7 @@ import Control.Exception (Exception, mask_)
|
||||
import Control.Monad.Catch (MonadCatch)
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp_)
|
||||
import Data.Functor (($>))
|
||||
import GHC.Types (SPEC(..))
|
||||
import Streamly.Internal.Control.Concurrent (MonadAsync)
|
||||
import Streamly.Internal.Data.Fold.Type (Fold(..))
|
||||
@ -417,25 +418,20 @@ mapMWithInput f (Unfold ustep uinject) = Unfold step inject
|
||||
--
|
||||
-- /Internal/
|
||||
{-# INLINE_NORMAL either #-}
|
||||
either :: Monad m => Unfold m a b -> Unfold m (Either a a) (Either b b)
|
||||
either :: Applicative m => Unfold m a b -> Unfold m (Either a a) (Either b b)
|
||||
either (Unfold step1 inject1) = Unfold step inject
|
||||
|
||||
where
|
||||
|
||||
inject (Left a) = do
|
||||
r <- inject1 a
|
||||
return (r, Left)
|
||||
inject (Right a) = do
|
||||
r <- inject1 a
|
||||
return (r, Right)
|
||||
inject (Left a) = (, Left) <$> inject1 a
|
||||
inject (Right a) = (, Right) <$> inject1 a
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step (st, f) = do
|
||||
r <- step1 st
|
||||
return $ case r of
|
||||
(\case
|
||||
Yield x s -> Yield (f x) (s, f)
|
||||
Skip s -> Skip (s, f)
|
||||
Stop -> Stop
|
||||
Stop -> Stop) <$> step1 st
|
||||
|
||||
-- See StreamD.scanlM' for implementing this.
|
||||
--
|
||||
@ -452,30 +448,29 @@ scanlM' = undefined
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE_NORMAL fromStreamD #-}
|
||||
fromStreamD :: Monad m => Unfold m (Stream m a) a
|
||||
fromStreamD = Unfold step return
|
||||
fromStreamD :: Applicative m => Unfold m (Stream m a) a
|
||||
fromStreamD = Unfold step pure
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step (UnStream step1 state1) = do
|
||||
r <- step1 defState state1
|
||||
return $ case r of
|
||||
step (UnStream step1 state1) =
|
||||
(\case
|
||||
Yield x s -> Yield x (Stream step1 s)
|
||||
Skip s -> Skip (Stream step1 s)
|
||||
Stop -> Stop
|
||||
Stop -> Stop) <$> step1 defState state1
|
||||
|
||||
{-# INLINE_NORMAL fromStreamK #-}
|
||||
fromStreamK :: Monad m => Unfold m (K.Stream m a) a
|
||||
fromStreamK = Unfold step return
|
||||
fromStreamK :: Applicative m => Unfold m (K.Stream m a) a
|
||||
fromStreamK = Unfold step pure
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step stream = do
|
||||
r <- K.uncons stream
|
||||
return $ case r of
|
||||
(\case
|
||||
Just (x, xs) -> Yield x xs
|
||||
Nothing -> Stop
|
||||
Nothing -> Stop) <$> K.uncons stream
|
||||
|
||||
-- XXX Using Unfold.fromStreamD seems to be faster (using cross product test
|
||||
-- case) than using fromStream even if it is implemented using fromStreamD.
|
||||
@ -486,7 +481,7 @@ fromStreamK = Unfold step return
|
||||
-- /Since: 0.8.0/
|
||||
--
|
||||
{-# INLINE_NORMAL fromStream #-}
|
||||
fromStream :: (IsStream t, Monad m) => Unfold m (t m a) a
|
||||
fromStream :: (IsStream t, Applicative m) => Unfold m (t m a) a
|
||||
fromStream = lmap IsStream.toStream fromStreamK
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
@ -497,59 +492,61 @@ fromStream = lmap IsStream.toStream fromStreamK
|
||||
-- effect.
|
||||
--
|
||||
{-# INLINE nilM #-}
|
||||
nilM :: Monad m => (a -> m c) -> Unfold m a b
|
||||
nilM f = Unfold step return
|
||||
nilM :: Applicative m => (a -> m c) -> Unfold m a b
|
||||
nilM f = Unfold step pure
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step x = f x >> return Stop
|
||||
step x = f x $> Stop
|
||||
|
||||
-- | Prepend a monadic single element generator function to an 'Unfold'. The
|
||||
-- same seed is used in the action as well as the unfold.
|
||||
--
|
||||
-- /Pre-release/
|
||||
{-# INLINE_NORMAL consM #-}
|
||||
consM :: Monad m => (a -> m b) -> Unfold m a b -> Unfold m a b
|
||||
consM :: Applicative m => (a -> m b) -> Unfold m a b -> Unfold m a b
|
||||
consM action unf = Unfold step inject
|
||||
|
||||
where
|
||||
|
||||
inject = return . Left
|
||||
inject = pure . Left
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step (Left a) =
|
||||
action a >>= \r -> return $ Yield r (Right (D.unfold unf a))
|
||||
step (Left a) = (`Yield` Right (D.unfold unf a)) <$> action a
|
||||
step (Right (UnStream step1 st)) = do
|
||||
res <- step1 defState st
|
||||
case res of
|
||||
Yield x s -> return $ Yield x (Right (Stream step1 s))
|
||||
Skip s -> return $ Skip (Right (Stream step1 s))
|
||||
Stop -> return Stop
|
||||
(\case
|
||||
Yield x s -> Yield x (Right (Stream step1 s))
|
||||
Skip s -> Skip (Right (Stream step1 s))
|
||||
Stop -> Stop) <$> step1 defState st
|
||||
|
||||
-- | Convert a list of pure values to a 'Stream'
|
||||
--
|
||||
-- /Since: 0.8.0/
|
||||
--
|
||||
{-# INLINE_LATE fromList #-}
|
||||
fromList :: Monad m => Unfold m [a] a
|
||||
fromList = Unfold step inject
|
||||
where
|
||||
inject = return
|
||||
fromList :: Applicative m => Unfold m [a] a
|
||||
fromList = Unfold step pure
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step (x:xs) = return $ Yield x xs
|
||||
step [] = return Stop
|
||||
step (x:xs) = pure $ Yield x xs
|
||||
step [] = pure Stop
|
||||
|
||||
-- | Convert a list of monadic values to a 'Stream'
|
||||
--
|
||||
-- /Since: 0.8.0/
|
||||
--
|
||||
{-# INLINE_LATE fromListM #-}
|
||||
fromListM :: Monad m => Unfold m [m a] a
|
||||
fromListM = Unfold step inject
|
||||
where
|
||||
inject = return
|
||||
fromListM :: Applicative m => Unfold m [m a] a
|
||||
fromListM = Unfold step pure
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step (x:xs) = x >>= \r -> return $ Yield r xs
|
||||
step [] = return Stop
|
||||
step (x:xs) = (`Yield` xs) <$> x
|
||||
step [] = pure Stop
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Specialized Generation
|
||||
@ -560,31 +557,31 @@ fromListM = Unfold step inject
|
||||
-- /Since: 0.8.0/
|
||||
--
|
||||
{-# INLINE replicateM #-}
|
||||
replicateM :: Monad m => Int -> Unfold m (m a) a
|
||||
replicateM :: Applicative m => Int -> Unfold m (m a) a
|
||||
replicateM n = Unfold step inject
|
||||
|
||||
where
|
||||
|
||||
inject x = return (x, n)
|
||||
inject action = pure (action, n)
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step (x, i) =
|
||||
step (action, i) =
|
||||
if i <= 0
|
||||
then return Stop
|
||||
else do
|
||||
x1 <- x
|
||||
return $ Yield x1 (x, i - 1)
|
||||
then pure Stop
|
||||
else (\x -> Yield x (action, i - 1)) <$> action
|
||||
|
||||
-- | Generates an infinite stream repeating the seed.
|
||||
--
|
||||
-- /Since: 0.8.0/
|
||||
--
|
||||
{-# INLINE repeatM #-}
|
||||
repeatM :: Monad m => Unfold m (m a) a
|
||||
repeatM = Unfold step return
|
||||
repeatM :: Applicative m => Unfold m (m a) a
|
||||
repeatM = Unfold step pure
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step x = x >>= \x1 -> return $ Yield x1 x
|
||||
step action = (`Yield` action) <$> action
|
||||
|
||||
-- | Generates an infinite stream starting with the given seed and applying the
|
||||
-- given function repeatedly.
|
||||
@ -592,13 +589,13 @@ repeatM = Unfold step return
|
||||
-- /Since: 0.8.0/
|
||||
--
|
||||
{-# INLINE iterateM #-}
|
||||
iterateM :: Monad m => (a -> m a) -> Unfold m (m a) a
|
||||
iterateM :: Applicative m => (a -> m a) -> Unfold m (m a) a
|
||||
iterateM f = Unfold step id
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step x = do
|
||||
fx <- f x
|
||||
return $ Yield x fx
|
||||
step x = Yield x <$> f x
|
||||
|
||||
-- | @fromIndicesM gen@ generates an infinite stream of values using @gen@
|
||||
-- starting from the seed.
|
||||
@ -610,13 +607,13 @@ iterateM f = Unfold step id
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE_NORMAL fromIndicesM #-}
|
||||
fromIndicesM :: Monad m => (Int -> m a) -> Unfold m Int a
|
||||
fromIndicesM gen = Unfold step return
|
||||
where
|
||||
fromIndicesM :: Applicative m => (Int -> m a) -> Unfold m Int a
|
||||
fromIndicesM gen = Unfold step pure
|
||||
|
||||
where
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step i = do
|
||||
x <- gen i
|
||||
return $ Yield x (i + 1)
|
||||
step i = (`Yield` (i + 1)) <$> gen i
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Filtering
|
||||
@ -630,20 +627,20 @@ fromIndicesM gen = Unfold step return
|
||||
-- /Since: 0.8.0/
|
||||
--
|
||||
{-# INLINE_NORMAL take #-}
|
||||
take :: Monad m => Int -> Unfold m a b -> Unfold m a b
|
||||
take :: Applicative m => Int -> Unfold m a b -> Unfold m a b
|
||||
take n (Unfold step1 inject1) = Unfold step inject
|
||||
where
|
||||
inject x = do
|
||||
s <- inject1 x
|
||||
return (s, 0)
|
||||
|
||||
where
|
||||
|
||||
inject x = (, 0) <$> inject1 x
|
||||
|
||||
{-# INLINE_LATE step #-}
|
||||
step (st, i) | i < n = do
|
||||
r <- step1 st
|
||||
return $ case r of
|
||||
(\case
|
||||
Yield x s -> Yield x (s, i + 1)
|
||||
Skip s -> Skip (s, i)
|
||||
Stop -> Stop
|
||||
step (_, _) = return Stop
|
||||
Stop -> Stop) <$> step1 st
|
||||
step (_, _) = pure Stop
|
||||
|
||||
-- | Same as 'filter' but with a monadic predicate.
|
||||
--
|
||||
@ -676,31 +673,25 @@ filter f = filterM (return . f)
|
||||
-- /Since: 0.8.0/
|
||||
--
|
||||
{-# INLINE_NORMAL drop #-}
|
||||
drop :: Monad m => Int -> Unfold m a b -> Unfold m a b
|
||||
drop :: Applicative m => Int -> Unfold m a b -> Unfold m a b
|
||||
drop n (Unfold step inject) = Unfold step' inject'
|
||||
|
||||
where
|
||||
|
||||
inject' a = do
|
||||
b <- inject a
|
||||
return (b, n)
|
||||
inject' a = (, n) <$> inject a
|
||||
|
||||
{-# INLINE_LATE step' #-}
|
||||
step' (st, i)
|
||||
| i > 0 = do
|
||||
r <- step st
|
||||
return
|
||||
$ case r of
|
||||
Yield _ s -> Skip (s, i - 1)
|
||||
Skip s -> Skip (s, i)
|
||||
Stop -> Stop
|
||||
(\case
|
||||
Yield _ s -> Skip (s, i - 1)
|
||||
Skip s -> Skip (s, i)
|
||||
Stop -> Stop) <$> step st
|
||||
| otherwise = do
|
||||
r <- step st
|
||||
return
|
||||
$ case r of
|
||||
Yield x s -> Yield x (s, 0)
|
||||
Skip s -> Skip (s, 0)
|
||||
Stop -> Stop
|
||||
(\case
|
||||
Yield x s -> Yield x (s, 0)
|
||||
Skip s -> Skip (s, 0)
|
||||
Stop -> Stop) <$> step st
|
||||
|
||||
-- | @dropWhileM f unf@ drops elements from the stream generated by @unf@ while
|
||||
-- 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) =
|
||||
return $ Skip (Left r)
|
||||
step (Left st) = do
|
||||
res <- estep st
|
||||
case res of
|
||||
Yield x s -> return $ Yield x (Left s)
|
||||
Skip s -> return $ Skip (Left s)
|
||||
Stop -> return Stop
|
||||
return $ case res of
|
||||
Yield x s -> Yield x (Left s)
|
||||
Skip s -> Skip (Left s)
|
||||
Stop -> Stop
|
||||
|
||||
-- | Run the alloc action @a -> m c@ with async exceptions disabled but keeping
|
||||
-- blocking operations interruptible (see 'Control.Exception.mask'). Use the
|
||||
@ -858,10 +849,10 @@ gbracket bef exc aft (Unfold estep einject) (Unfold step1 inject1) =
|
||||
return $ Skip (Left r)
|
||||
step (Left st) = do
|
||||
res <- estep st
|
||||
case res of
|
||||
Yield x s -> return $ Yield x (Left s)
|
||||
Skip s -> return $ Skip (Left s)
|
||||
Stop -> return Stop
|
||||
return $ case res of
|
||||
Yield x s -> Yield x (Left s)
|
||||
Skip s -> Skip (Left s)
|
||||
Stop -> Stop
|
||||
|
||||
-- | Run a side effect @a -> m c@ on the input @a@ before unfolding it using
|
||||
-- @Unfold m a b@.
|
||||
@ -964,10 +955,10 @@ onException action (Unfold step1 inject1) = Unfold step inject
|
||||
{-# INLINE_LATE step #-}
|
||||
step (st, v) = do
|
||||
res <- step1 st `MC.onException` action v
|
||||
case res of
|
||||
Yield x s -> return $ Yield x (s, v)
|
||||
Skip s -> return $ Skip (s, v)
|
||||
Stop -> return Stop
|
||||
return $ case res of
|
||||
Yield x s -> Yield x (s, v)
|
||||
Skip s -> Skip (s, v)
|
||||
Stop -> Stop
|
||||
|
||||
{-# INLINE_NORMAL _finally #-}
|
||||
_finally :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b
|
||||
|
||||
Loading…
Reference in New Issue
Block a user