-- |
-- Module      : Streamly.Internal.Data.Stream.StreamD.Lift
-- Copyright   : (c) 2018 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- Transform the underlying monad of a stream.

module Streamly.Internal.Data.Stream.StreamD.Lift
    (
    -- * Generalize Inner Monad
      hoist
    , generally -- XXX generalize

    -- * Transform Inner Monad
    , liftInner
    , runReaderT
    , evalStateT
    , runStateT
    )
where

#include "inline.hs"

import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.State.Strict (StateT)
import Data.Functor.Identity (Identity(..))
import Streamly.Internal.Data.SVar.Type (adaptState)

import qualified Control.Monad.Trans.Reader as Reader
import qualified Control.Monad.Trans.State.Strict as State

import Streamly.Internal.Data.Stream.StreamD.Type

-------------------------------------------------------------------------------
-- Generalize Inner Monad
-------------------------------------------------------------------------------

{-# INLINE_NORMAL hoist #-}
hoist :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a
hoist :: forall (n :: * -> *) (m :: * -> *) a.
Monad n =>
(forall x. m x -> n x) -> Stream m a -> Stream n a
hoist forall x. m x -> n x
f (Stream State Stream m a -> s -> m (Step s a)
step s
state) = forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream forall {m :: * -> *} {a}. State Stream m a -> s -> n (Step s a)
step' s
state
    where
    {-# INLINE_LATE step' #-}
    step' :: State Stream m a -> s -> n (Step s a)
step' State Stream m a
gst s
st = do
        Step s a
r <- forall x. m x -> n x
f forall a b. (a -> b) -> a -> b
$ State Stream m a -> s -> m (Step s a)
step (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
x s
s -> forall s a. a -> s -> Step s a
Yield a
x s
s
            Skip  s
s   -> forall s a. s -> Step s a
Skip s
s
            Step s a
Stop      -> forall s a. Step s a
Stop

{-# INLINE generally #-}
generally :: Monad m => Stream Identity a -> Stream m a
generally :: forall (m :: * -> *) a. Monad m => Stream Identity a -> Stream m a
generally = forall (n :: * -> *) (m :: * -> *) a.
Monad n =>
(forall x. m x -> n x) -> Stream m a -> Stream n a
hoist (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity)

-------------------------------------------------------------------------------
-- Transform Inner Monad
-------------------------------------------------------------------------------

{-# INLINE_NORMAL liftInner #-}
liftInner :: (Monad m, MonadTrans t, Monad (t m))
    => Stream m a -> Stream (t m) a
liftInner :: forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, Monad (t m)) =>
Stream m a -> Stream (t m) a
liftInner (Stream State Stream m a -> s -> m (Step s a)
step s
state) = forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a}.
(MonadTrans t, Monad (t m)) =>
State Stream m a -> s -> t m (Step s a)
step' s
state
    where
    {-# INLINE_LATE step' #-}
    step' :: State Stream m a -> s -> t m (Step s a)
step' State Stream m a
gst s
st = do
        Step s a
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ State Stream m a -> s -> m (Step s a)
step (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
x s
s -> forall s a. a -> s -> Step s a
Yield a
x s
s
            Skip s
s    -> forall s a. s -> Step s a
Skip s
s
            Step s a
Stop      -> forall s a. Step s a
Stop

{-# INLINE_NORMAL runReaderT #-}
runReaderT :: Monad m => m s -> Stream (ReaderT s m) a -> Stream m a
runReaderT :: forall (m :: * -> *) s a.
Monad m =>
m s -> Stream (ReaderT s m) a -> Stream m a
runReaderT m s
env (Stream State Stream (ReaderT s m) a -> s -> ReaderT s m (Step s a)
step s
state) = forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream forall {m :: * -> *} {m :: * -> *} {a}.
Monad m =>
State Stream m a -> (s, m s) -> m (Step (s, m s) a)
step' (s
state, m s
env)
    where
    {-# INLINE_LATE step' #-}
    step' :: State Stream m a -> (s, m s) -> m (Step (s, m s) a)
step' State Stream m a
gst (s
st, m s
action) = do
        s
sv <- m s
action
        Step s a
r <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
Reader.runReaderT (State Stream (ReaderT s m) a -> s -> ReaderT s m (Step s a)
step (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st) s
sv
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
x s
s -> forall s a. a -> s -> Step s a
Yield a
x (s
s, forall (m :: * -> *) a. Monad m => a -> m a
return s
sv)
            Skip  s
s   -> forall s a. s -> Step s a
Skip (s
s, forall (m :: * -> *) a. Monad m => a -> m a
return s
sv)
            Step s a
Stop      -> forall s a. Step s a
Stop

{-# INLINE_NORMAL evalStateT #-}
evalStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m a
evalStateT :: forall (m :: * -> *) s a.
Monad m =>
m s -> Stream (StateT s m) a -> Stream m a
evalStateT m s
initial (Stream State Stream (StateT s m) a -> s -> StateT s m (Step s a)
step s
state) = forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream forall {m :: * -> *} {m :: * -> *} {a}.
Monad m =>
State Stream m a -> (s, m s) -> m (Step (s, m s) a)
step' (s
state, m s
initial)
    where
    {-# INLINE_LATE step' #-}
    step' :: State Stream m a -> (s, m s) -> m (Step (s, m s) a)
step' State Stream m a
gst (s
st, m s
action) = do
        s
sv <- m s
action
        (Step s a
r, !s
sv') <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.runStateT (State Stream (StateT s m) a -> s -> StateT s m (Step s a)
step (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st) s
sv
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
x s
s -> forall s a. a -> s -> Step s a
Yield a
x (s
s, forall (m :: * -> *) a. Monad m => a -> m a
return s
sv')
            Skip  s
s   -> forall s a. s -> Step s a
Skip (s
s, forall (m :: * -> *) a. Monad m => a -> m a
return s
sv')
            Step s a
Stop      -> forall s a. Step s a
Stop

{-# INLINE_NORMAL runStateT #-}
runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)
runStateT :: forall (m :: * -> *) s a.
Monad m =>
m s -> Stream (StateT s m) a -> Stream m (s, a)
runStateT m s
initial (Stream State Stream (StateT s m) a -> s -> StateT s m (Step s a)
step s
state) = forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream forall {m :: * -> *} {m :: * -> *} {a}.
Monad m =>
State Stream m a -> (s, m s) -> m (Step (s, m s) (s, a))
step' (s
state, m s
initial)
    where
    {-# INLINE_LATE step' #-}
    step' :: State Stream m a -> (s, m s) -> m (Step (s, m s) (s, a))
step' State Stream m a
gst (s
st, m s
action) = do
        s
sv <- m s
action
        (Step s a
r, !s
sv') <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.runStateT (State Stream (StateT s m) a -> s -> StateT s m (Step s a)
step (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st) s
sv
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
x s
s -> forall s a. a -> s -> Step s a
Yield (s
sv', a
x) (s
s, forall (m :: * -> *) a. Monad m => a -> m a
return s
sv')
            Skip  s
s   -> forall s a. s -> Step s a
Skip (s
s, forall (m :: * -> *) a. Monad m => a -> m a
return s
sv')
            Step s a
Stop      -> forall s a. Step s a
Stop