git.iko.soy/streamly
on 3feeec2 help sign in
streamly/src/Streamly/Internal/Data/Stream/StreamD/Lift.hs
112 lines 3.7 kB history raw
1-- |
2-- Module : Streamly.Internal.Data.Stream.StreamD.Lift
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
8--
9-- Transform the underlying monad of a stream.
11module Streamly.Internal.Data.Stream.StreamD.Lift
12 (
13 -- * Generalize Inner Monad
14 hoist
15 , generally -- XXX generalize
17 -- * Transform Inner Monad
18 , liftInner
19 , runReaderT
20 , evalStateT
21 , runStateT
22 )
23where
25#include "inline.hs"
27import Control.Monad.Trans.Class (MonadTrans(lift))
28import Control.Monad.Trans.Reader (ReaderT)
29import Control.Monad.Trans.State.Strict (StateT)
30import Data.Functor.Identity (Identity(..))
31import Streamly.Internal.Data.SVar (adaptState)
33import qualified Control.Monad.Trans.Reader as Reader
34import qualified Control.Monad.Trans.State.Strict as State
36import Streamly.Internal.Data.Stream.StreamD.Type
38-------------------------------------------------------------------------------
39-- Generalize Inner Monad
40-------------------------------------------------------------------------------
42{-# INLINE_NORMAL hoist #-}
43hoist :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a
44hoist f (Stream step state) = (Stream step' state)
45 where
46 {-# INLINE_LATE step' #-}
47 step' gst st = do
48 r <- f $ step (adaptState gst) st
49 return $ case r of
50 Yield x s -> Yield x s
51 Skip s -> Skip s
52 Stop -> Stop
54{-# INLINE generally #-}
55generally :: Monad m => Stream Identity a -> Stream m a
56generally = hoist (return . runIdentity)
58-------------------------------------------------------------------------------
59-- Transform Inner Monad
60-------------------------------------------------------------------------------
62{-# INLINE_NORMAL liftInner #-}
63liftInner :: (Monad m, MonadTrans t, Monad (t m))
64 => Stream m a -> Stream (t m) a
65liftInner (Stream step state) = Stream step' state
66 where
67 {-# INLINE_LATE step' #-}
68 step' gst st = do
69 r <- lift $ step (adaptState gst) st
70 return $ case r of
71 Yield x s -> Yield x s
72 Skip s -> Skip s
73 Stop -> Stop
75{-# INLINE_NORMAL runReaderT #-}
76runReaderT :: Monad m => m s -> Stream (ReaderT s m) a -> Stream m a
77runReaderT env (Stream step state) = Stream step' (state, env)
78 where
79 {-# INLINE_LATE step' #-}
80 step' gst (st, action) = do
81 sv <- action
82 r <- Reader.runReaderT (step (adaptState gst) st) sv
83 return $ case r of
84 Yield x s -> Yield x (s, return sv)
85 Skip s -> Skip (s, return sv)
86 Stop -> Stop
88{-# INLINE_NORMAL evalStateT #-}
89evalStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m a
90evalStateT initial (Stream step state) = Stream step' (state, initial)
91 where
92 {-# INLINE_LATE step' #-}
93 step' gst (st, action) = do
94 sv <- action
95 (r, !sv') <- State.runStateT (step (adaptState gst) st) sv
96 return $ case r of
97 Yield x s -> Yield x (s, return sv')
98 Skip s -> Skip (s, return sv')
99 Stop -> Stop
101{-# INLINE_NORMAL runStateT #-}
102runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)
103runStateT initial (Stream step state) = Stream step' (state, initial)
104 where
105 {-# INLINE_LATE step' #-}
106 step' gst (st, action) = do
107 sv <- action
108 (r, !sv') <- State.runStateT (step (adaptState gst) st) sv
109 return $ case r of
110 Yield x s -> Yield (sv', x) (s, return sv')
111 Skip s -> Skip (s, return sv')
112 Stop -> Stop