on master help sign in
Add generic inner monad lifting ops

These ops do not depend on the "transformers" package.

commit1349b8cd8106589f6d4f9d8f15382296a091858f authorHarendra Kumar <harendra@composewell.com> dateTue 6 Dec 2022, 19:46 (4 years ago) parentb2dc236
6 files changed+119−26
core/src/Streamly/Internal/Data/Stream/Bottom.hs+4−6 core/src/Streamly/Internal/Data/Stream/Lift.hs+40−1 core/src/Streamly/Internal/Data/Stream/StreamD/Lift.hs+59 core/src/Streamly/Internal/Data/Stream/Transform.hs+5−7 core/src/Streamly/Internal/Data/Stream/Transformer.hs+1−1 core/streamly-core.cabal+10−11
core/src/Streamly/Internal/Data/Stream/Bottom.hs+4−6
@@ -89,17 +89,15 @@ import Streamly.Internal.Data.Stream.Type
8989-- $setup
9090-- >>> :m
9191-- >>> import Control.Monad (join, (>=>), (<=<))
92−-- >>> import Control.Monad.Trans.Class (lift)
9392-- >>> import Data.Function (fix, (&))
9493-- >>> import Data.Maybe (fromJust, isJust)
95−-- >>> import Data.Semigroup (cycle1)
9694-- >>> import Prelude hiding (take, takeWhile, drop, reverse)
9795-- >>> import System.IO.Unsafe (unsafePerformIO)
98−-- >>> import Streamly.Internal.Data.Stream as Stream
9996-- >>> import qualified Streamly.Data.Array as Array
100−-- >>> import qualified Streamly.Internal.Data.Fold as Fold
101−-- >>> import qualified Streamly.Internal.Data.Parser as Parser
102−-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold
97+-- >>> import qualified Streamly.Data.Fold as Fold
98+-- >>> import qualified Streamly.Data.Parser as Parser
99+-- >>> import qualified Streamly.Data.Unfold as Unfold
100+-- >>> import Streamly.Internal.Data.Stream as Stream
103101
104102------------------------------------------------------------------------------
105103-- Generation - Time related
core/src/Streamly/Internal/Data/Stream/Lift.hs+40−1
@@ -11,12 +11,19 @@ module Streamly.Internal.Data.Stream.Lift
1111 -- * Generalize Inner Monad
1212 hoist
1313 , generally
14+
15+ -- * Transform Inner Monad
16+ , liftInnerWith
17+ , runInnerWith
18+ , runInnerWithState
1419 )
1520where
1621
1722import Data.Functor.Identity (Identity (..))
18−import Streamly.Internal.Data.Stream.Type (Stream, fromStreamK, toStreamK)
23+import Streamly.Internal.Data.Stream.Type
24+ (Stream, fromStreamD, toStreamD, fromStreamK, toStreamK)
1925
26+import qualified Streamly.Internal.Data.Stream.StreamD as D
2027import qualified Streamly.Internal.Data.Stream.StreamK as K
2128
2229-- $setup
@@ -46,3 +53,35 @@ hoist f xs = fromStreamK $ K.hoist f (toStreamK xs)
4653{-# INLINE generally #-}
4754generally :: Monad m => Stream Identity a -> Stream m a
4855generally xs = fromStreamK $ K.hoist (return . runIdentity) (toStreamK xs)
56+
57+------------------------------------------------------------------------------
58+-- Add and remove a monad transformer
59+------------------------------------------------------------------------------
60+
61+-- | Lift the inner monad @m@ of a stream @Stream m a@ to @t m@ using the
62+-- supplied lift function.
63+--
64+{-# INLINE liftInnerWith #-}
65+liftInnerWith :: (Monad m, Monad (t m))
66+ => (forall b. m b -> t m b) -> Stream m a -> Stream (t m) a
67+liftInnerWith lift xs = fromStreamD $ D.liftInnerWith lift (toStreamD xs)
68+
69+-- | Evaluate the inner monad of a stream using the supplied runner function.
70+--
71+{-# INLINE runInnerWith #-}
72+runInnerWith :: (Monad m, Applicative (t m)) =>
73+ (forall b. t m b -> m b) -> Stream (t m) a -> Stream m a
74+runInnerWith run xs = fromStreamD $ D.runInnerWith run (toStreamD xs)
75+
76+-- | Evaluate the inner monad of a stream using the supplied stateful runner
77+-- function and the initial state. The state returned by an invocation of the
78+-- runner is supplied as input state to the next invocation.
79+--
80+{-# INLINE runInnerWithState #-}
81+runInnerWithState :: (Monad m, Applicative (t m)) =>
82+ (forall b. s -> t m b -> m (b, s))
83+ -> m s
84+ -> Stream (t m) a
85+ -> Stream m (s, a)
86+runInnerWithState run initial xs =
87+ fromStreamD $ D.runInnerWithState run initial (toStreamD xs)
core/src/Streamly/Internal/Data/Stream/StreamD/Lift.hs+59
@@ -13,6 +13,11 @@ module Streamly.Internal.Data.Stream.StreamD.Lift
1313 -- * Generalize Inner Monad
1414 hoist
1515 , generally -- XXX generalize
16+
17+ -- * Transform Inner Monad
18+ , liftInnerWith
19+ , runInnerWith
20+ , runInnerWithState
1621 )
1722where
1823
@@ -42,3 +47,57 @@ hoist f (Stream step state) = Stream step' state
4247{-# INLINE generally #-}
4348generally :: Monad m => Stream Identity a -> Stream m a
4449generally = hoist (return . runIdentity)
50+
51+-------------------------------------------------------------------------------
52+-- Transform Inner Monad
53+-------------------------------------------------------------------------------
54+
55+{-# INLINE_NORMAL liftInnerWith #-}
56+liftInnerWith :: (Monad (t m)) =>
57+ (forall b. m b -> t m b) -> Stream m a -> Stream (t m) a
58+liftInnerWith lift (Stream step state) = Stream step1 state
59+
60+ where
61+
62+ {-# INLINE_LATE step1 #-}
63+ step1 gst st = do
64+ r <- lift $ step (adaptState gst) st
65+ return $ case r of
66+ Yield x s -> Yield x s
67+ Skip s -> Skip s
68+ Stop -> Stop
69+
70+{-# INLINE_NORMAL runInnerWith #-}
71+runInnerWith :: Monad m =>
72+ (forall b. t m b -> m b) -> Stream (t m) a -> Stream m a
73+runInnerWith run (Stream step state) = Stream step1 state
74+
75+ where
76+
77+ {-# INLINE_LATE step1 #-}
78+ step1 gst st = do
79+ r <- run $ step (adaptState gst) st
80+ return $ case r of
81+ Yield x s -> Yield x s
82+ Skip s -> Skip s
83+ Stop -> Stop
84+
85+{-# INLINE_NORMAL runInnerWithState #-}
86+runInnerWithState :: Monad m =>
87+ (forall b. s -> t m b -> m (b, s))
88+ -> m s
89+ -> Stream (t m) a
90+ -> Stream m (s, a)
91+runInnerWithState run initial (Stream step state) =
92+ Stream step1 (state, initial)
93+
94+ where
95+
96+ {-# INLINE_LATE step1 #-}
97+ step1 gst (st, action) = do
98+ sv <- action
99+ (r, !sv1) <- run sv (step (adaptState gst) st)
100+ return $ case r of
101+ Yield x s -> Yield (sv1, x) (s, return sv1)
102+ Skip s -> Skip (s, return sv1)
103+ Stop -> Stop
core/src/Streamly/Internal/Data/Stream/Transform.hs+5−7
@@ -167,20 +167,18 @@ import Prelude hiding
167167--
168168-- $setup
169169-- >>> :m
170−-- >>> :set -package mtl
171170-- >>> import Control.Concurrent (threadDelay)
172171-- >>> import Control.Monad.IO.Class (MonadIO (liftIO))
173−-- >>> import Control.Monad.Trans (lift)
174−-- >>> import Control.Monad.Trans.Identity (runIdentityT)
175172-- >>> import Data.Either (fromLeft, fromRight, isLeft, isRight, either)
176173-- >>> import Data.Function ((&))
177174-- >>> import Data.Maybe (fromJust, isJust)
178175-- >>> import Prelude hiding (filter, drop, dropWhile, take, takeWhile, foldr, map, mapM, sequence, reverse, foldr1 , scanl, scanl1)
179−-- >>> import Streamly.Internal.Data.Stream as Stream
176+-- >>> import Streamly.Internal.Data.Stream (Stream)
180177-- >>> import qualified Streamly.Data.Fold as Fold
181−-- >>> import qualified Streamly.Internal.Data.Fold as Fold
178+-- >>> import qualified Streamly.Data.Unfold as Unfold
179+-- >>> import qualified Streamly.Internal.Data.Fold as Fold (filtering)
182180-- >>> import qualified Streamly.Internal.Data.Fold.Window as Window
183−-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold
181+-- >>> import qualified Streamly.Internal.Data.Stream as Stream
184182-- >>> import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))
185183--
186184-- >>> hSetBuffering stdout LineBuffering
@@ -693,7 +691,7 @@ intersperseBySpan _n _f _xs = undefined
693691-- | Insert an effect and its output after consuming an element of a stream.
694692--
695693-- >>> input = Stream.fromList "hello"
696−-- >>> Stream.fold Fold.toList $ Stream.trace putChar $ intersperseSuffix (putChar '.' >> return ',') input
694+-- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseSuffix (putChar '.' >> return ',') input
697695-- h.,e.,l.,l.,o.,"h,e,l,l,o,"
698696--
699697-- /Pre-release/
core/src/Streamly/Internal/Data/Stream/Transformer.hs+1−1
@@ -29,7 +29,7 @@ import qualified Streamly.Internal.Data.Stream.StreamD.Transformer as D
2929
3030-- $setup
3131-- >>> :m
32−-- >>> import Control.Monad.Trans (lift)
32+-- >>> import Control.Monad.Trans.Class (lift)
3333-- >>> import Control.Monad.Trans.Identity (runIdentityT)
3434-- >>> import qualified Streamly.Internal.Data.Stream as Stream
3535
core/streamly-core.cabal+10−11
@@ -279,6 +279,7 @@ library
279279 , Streamly.Internal.Data.Array.Generic.Mut.Type
280280
281281 -- streamly-core-streams
282+ , Streamly.Internal.Data.Stream.StreamK
282283 -- StreamD depends on streamly-array-types
283284 , Streamly.Internal.Data.Stream.StreamD.Generate
284285 , Streamly.Internal.Data.Stream.StreamD.Eliminate
@@ -286,7 +287,6 @@ library
286287 , Streamly.Internal.Data.Stream.StreamD.Transform
287288 , Streamly.Internal.Data.Stream.StreamD.Exception
288289 , Streamly.Internal.Data.Stream.StreamD.Lift
289− , Streamly.Internal.Data.Stream.StreamD.Transformer
290290 , Streamly.Internal.Data.Stream.StreamD
291291 , Streamly.Internal.Data.Stream.Common
292292
@@ -313,9 +313,14 @@ library
313313 , Streamly.Internal.Data.Stream.Exception
314314 , Streamly.Internal.Data.Stream.Expand
315315 , Streamly.Internal.Data.Stream.Lift
316− , Streamly.Internal.Data.Stream.Transformer
317316 , Streamly.Internal.Data.Stream.Reduce
318317 , Streamly.Internal.Data.Stream.Top
318+
319+ -- streamly-transformers (non-base)
320+ , Streamly.Internal.Data.Stream.StreamD.Transformer
321+ , Streamly.Internal.Data.Stream.StreamK.Transformer
322+ , Streamly.Internal.Data.Stream.Transformer
323+
319324 , Streamly.Internal.Data.Stream
320325 , Streamly.Internal.Data.Stream.Chunked
321326 , Streamly.Internal.Data.Stream.Zip
@@ -346,10 +351,6 @@ library
346351 , Streamly.Internal.Data.Ring.Unboxed
347352 , Streamly.Internal.Data.Ring
348353
349− -- Only used for benchmarks
350− , Streamly.Internal.Data.Stream.StreamK.Transformer
351− , Streamly.Internal.Data.Stream.StreamK
352−
353354 -- streamly-console
354355 , Streamly.Internal.Console.Stdio
355356
@@ -415,9 +416,10 @@ library
415416 -- packages depending on the "ghc" package (packages
416417 -- depending on doctest is a common example) can
417418 -- depend on streamly.
418− base >= 4.12 && < 4.18
419+ ghc-prim >= 0.5.3 && < 0.10
420+ , fusion-plugin-types >= 0.1 && < 0.2
421+ , base >= 4.12 && < 4.18
419422 , exceptions >= 0.8.0 && < 0.11
420− , ghc-prim >= 0.5.3 && < 0.10
421423 , transformers >= 0.5.5 && < 0.7
422424
423425 -- streamly-unicode-core
@@ -426,9 +428,6 @@ library
426428 -- streamly-filesystem-core
427429 , directory >= 1.3.3 && < 1.4
428430
429− -- fusion-plugin
430− , fusion-plugin-types >= 0.1 && < 0.2
431−
432431 -- XXX to be removed
433432 , containers >= 0.6.0 && < 0.7
434433 , heaps >= 0.3 && < 0.5