{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{- |
Handling monad transformers.
-}
module LiveCoding.Cell.Monad.Trans where

-- base
import Control.Arrow (arr, (>>>))
import Data.Data (Data)

-- transformers
import Control.Monad.Trans.Reader (runReaderT, ReaderT)
import Control.Monad.Trans.State.Strict (StateT (..), runStateT, evalStateT)
import Control.Monad.Trans.Writer.Strict

-- essence-of-live-coding
import LiveCoding.Cell
import LiveCoding.Cell.Monad

-- | Push effectful state into the internal state of a cell
runStateC
  :: (Data stateT, Monad m)
  => Cell (StateT stateT m) a  b
  -- ^ A cell with a state effect
  -> stateT
  -- ^ The initial state
  -> Cell                m  a (b, stateT)
  -- ^ The cell, returning its current state
runStateC :: Cell (StateT stateT m) a b -> stateT -> Cell m a (b, stateT)
runStateC Cell (StateT stateT m) a b
cell stateT
stateT = (forall s.
 (s -> a -> StateT stateT m (b, s))
 -> State stateT s -> a -> m ((b, stateT), State stateT s))
-> (forall s. s -> State stateT s)
-> Cell (StateT stateT m) a b
-> Cell m a (b, stateT)
forall (m1 :: * -> *) (m2 :: * -> *) (t :: * -> *) a1 b1 a2 b2.
(Monad m1, Monad m2, forall s. Data s => Data (t s)) =>
(forall s. (s -> a1 -> m1 (b1, s)) -> t s -> a2 -> m2 (b2, t s))
-> (forall s. s -> t s) -> Cell m1 a1 b1 -> Cell m2 a2 b2
hoistCellKleisliStateChange forall s.
(s -> a -> StateT stateT m (b, s))
-> State stateT s -> a -> m ((b, stateT), State stateT s)
forall (m :: * -> *) t t stateT a stateInternal.
Monad m =>
(t -> t -> StateT stateT m (a, stateInternal))
-> State stateT t
-> t
-> m ((a, stateT), State stateT stateInternal)
morph forall s. s -> State stateT s
init Cell (StateT stateT m) a b
cell
  where
    morph :: (t -> t -> StateT stateT m (a, stateInternal))
-> State stateT t
-> t
-> m ((a, stateT), State stateT stateInternal)
morph t -> t -> StateT stateT m (a, stateInternal)
step State { t
stateT
stateInternal :: forall stateT stateInternal.
State stateT stateInternal -> stateInternal
stateT :: forall stateT stateInternal. State stateT stateInternal -> stateT
stateInternal :: t
stateT :: stateT
.. } t
a = do
      ((a
b, stateInternal
stateInternal), stateT
stateT) <- StateT stateT m (a, stateInternal)
-> stateT -> m ((a, stateInternal), stateT)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (t -> t -> StateT stateT m (a, stateInternal)
step t
stateInternal t
a) stateT
stateT
      ((a, stateT), State stateT stateInternal)
-> m ((a, stateT), State stateT stateInternal)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
b, stateT
stateT), State :: forall stateT stateInternal.
stateT -> stateInternal -> State stateT stateInternal
State { stateT
stateInternal
stateT :: stateT
stateInternal :: stateInternal
stateInternal :: stateInternal
stateT :: stateT
.. })
    init :: stateInternal -> State stateT stateInternal
init stateInternal
stateInternal = State :: forall stateT stateInternal.
stateT -> stateInternal -> State stateT stateInternal
State { stateT
stateInternal
stateInternal :: stateInternal
stateInternal :: stateInternal
stateT :: stateT
stateT :: stateT
.. }

-- | Like 'runStateC', but does not return the current state.
runStateC_
  :: (Data stateT, Monad m)
  => Cell (StateT stateT m) a b
  -- ^ A cell with a state effect
  -> stateT
  -- ^ The initial state
  -> Cell                m  a b
runStateC_ :: Cell (StateT stateT m) a b -> stateT -> Cell m a b
runStateC_ Cell (StateT stateT m) a b
cell stateT
stateT = Cell (StateT stateT m) a b -> stateT -> Cell m a (b, stateT)
forall stateT (m :: * -> *) a b.
(Data stateT, Monad m) =>
Cell (StateT stateT m) a b -> stateT -> Cell m a (b, stateT)
runStateC Cell (StateT stateT m) a b
cell stateT
stateT Cell m a (b, stateT) -> Cell m (b, stateT) b -> Cell m a b
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((b, stateT) -> b) -> Cell m (b, stateT) b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (b, stateT) -> b
forall a b. (a, b) -> a
fst

-- | The internal state of a cell to which 'runStateC' or 'runStateL' has been applied.
data State stateT stateInternal = State
  { State stateT stateInternal -> stateT
stateT :: stateT
  , State stateT stateInternal -> stateInternal
stateInternal :: stateInternal
  }
  deriving (Typeable (State stateT stateInternal)
DataType
Constr
Typeable (State stateT stateInternal)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> State stateT stateInternal
    -> c (State stateT stateInternal))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c (State stateT stateInternal))
-> (State stateT stateInternal -> Constr)
-> (State stateT stateInternal -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c (State stateT stateInternal)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (State stateT stateInternal)))
-> ((forall b. Data b => b -> b)
    -> State stateT stateInternal -> State stateT stateInternal)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> State stateT stateInternal
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> State stateT stateInternal
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> State stateT stateInternal -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> State stateT stateInternal -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> State stateT stateInternal -> m (State stateT stateInternal))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> State stateT stateInternal -> m (State stateT stateInternal))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> State stateT stateInternal -> m (State stateT stateInternal))
-> Data (State stateT stateInternal)
State stateT stateInternal -> DataType
State stateT stateInternal -> Constr
(forall b. Data b => b -> b)
-> State stateT stateInternal -> State stateT stateInternal
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> State stateT stateInternal
-> c (State stateT stateInternal)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (State stateT stateInternal)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (State stateT stateInternal))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> State stateT stateInternal -> u
forall u.
(forall d. Data d => d -> u) -> State stateT stateInternal -> [u]
forall stateT stateInternal.
(Data stateT, Data stateInternal) =>
Typeable (State stateT stateInternal)
forall stateT stateInternal.
(Data stateT, Data stateInternal) =>
State stateT stateInternal -> DataType
forall stateT stateInternal.
(Data stateT, Data stateInternal) =>
State stateT stateInternal -> Constr
forall stateT stateInternal.
(Data stateT, Data stateInternal) =>
(forall b. Data b => b -> b)
-> State stateT stateInternal -> State stateT stateInternal
forall stateT stateInternal u.
(Data stateT, Data stateInternal) =>
Int
-> (forall d. Data d => d -> u) -> State stateT stateInternal -> u
forall stateT stateInternal u.
(Data stateT, Data stateInternal) =>
(forall d. Data d => d -> u) -> State stateT stateInternal -> [u]
forall stateT stateInternal r r'.
(Data stateT, Data stateInternal) =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> State stateT stateInternal
-> r
forall stateT stateInternal r r'.
(Data stateT, Data stateInternal) =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> State stateT stateInternal
-> r
forall stateT stateInternal (m :: * -> *).
(Data stateT, Data stateInternal, Monad m) =>
(forall d. Data d => d -> m d)
-> State stateT stateInternal -> m (State stateT stateInternal)
forall stateT stateInternal (m :: * -> *).
(Data stateT, Data stateInternal, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> State stateT stateInternal -> m (State stateT stateInternal)
forall stateT stateInternal (c :: * -> *).
(Data stateT, Data stateInternal) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (State stateT stateInternal)
forall stateT stateInternal (c :: * -> *).
(Data stateT, Data stateInternal) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> State stateT stateInternal
-> c (State stateT stateInternal)
forall stateT stateInternal (t :: * -> *) (c :: * -> *).
(Data stateT, Data stateInternal, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (State stateT stateInternal))
forall stateT stateInternal (t :: * -> * -> *) (c :: * -> *).
(Data stateT, Data stateInternal, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (State stateT stateInternal))
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> State stateT stateInternal
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> State stateT stateInternal
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> State stateT stateInternal -> m (State stateT stateInternal)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> State stateT stateInternal -> m (State stateT stateInternal)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (State stateT stateInternal)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> State stateT stateInternal
-> c (State stateT stateInternal)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (State stateT stateInternal))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (State stateT stateInternal))
$cState :: Constr
$tState :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> State stateT stateInternal -> m (State stateT stateInternal)
$cgmapMo :: forall stateT stateInternal (m :: * -> *).
(Data stateT, Data stateInternal, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> State stateT stateInternal -> m (State stateT stateInternal)
gmapMp :: (forall d. Data d => d -> m d)
-> State stateT stateInternal -> m (State stateT stateInternal)
$cgmapMp :: forall stateT stateInternal (m :: * -> *).
(Data stateT, Data stateInternal, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> State stateT stateInternal -> m (State stateT stateInternal)
gmapM :: (forall d. Data d => d -> m d)
-> State stateT stateInternal -> m (State stateT stateInternal)
$cgmapM :: forall stateT stateInternal (m :: * -> *).
(Data stateT, Data stateInternal, Monad m) =>
(forall d. Data d => d -> m d)
-> State stateT stateInternal -> m (State stateT stateInternal)
gmapQi :: Int
-> (forall d. Data d => d -> u) -> State stateT stateInternal -> u
$cgmapQi :: forall stateT stateInternal u.
(Data stateT, Data stateInternal) =>
Int
-> (forall d. Data d => d -> u) -> State stateT stateInternal -> u
gmapQ :: (forall d. Data d => d -> u) -> State stateT stateInternal -> [u]
$cgmapQ :: forall stateT stateInternal u.
(Data stateT, Data stateInternal) =>
(forall d. Data d => d -> u) -> State stateT stateInternal -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> State stateT stateInternal
-> r
$cgmapQr :: forall stateT stateInternal r r'.
(Data stateT, Data stateInternal) =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> State stateT stateInternal
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> State stateT stateInternal
-> r
$cgmapQl :: forall stateT stateInternal r r'.
(Data stateT, Data stateInternal) =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> State stateT stateInternal
-> r
gmapT :: (forall b. Data b => b -> b)
-> State stateT stateInternal -> State stateT stateInternal
$cgmapT :: forall stateT stateInternal.
(Data stateT, Data stateInternal) =>
(forall b. Data b => b -> b)
-> State stateT stateInternal -> State stateT stateInternal
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (State stateT stateInternal))
$cdataCast2 :: forall stateT stateInternal (t :: * -> * -> *) (c :: * -> *).
(Data stateT, Data stateInternal, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (State stateT stateInternal))
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c (State stateT stateInternal))
$cdataCast1 :: forall stateT stateInternal (t :: * -> *) (c :: * -> *).
(Data stateT, Data stateInternal, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (State stateT stateInternal))
dataTypeOf :: State stateT stateInternal -> DataType
$cdataTypeOf :: forall stateT stateInternal.
(Data stateT, Data stateInternal) =>
State stateT stateInternal -> DataType
toConstr :: State stateT stateInternal -> Constr
$ctoConstr :: forall stateT stateInternal.
(Data stateT, Data stateInternal) =>
State stateT stateInternal -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (State stateT stateInternal)
$cgunfold :: forall stateT stateInternal (c :: * -> *).
(Data stateT, Data stateInternal) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (State stateT stateInternal)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> State stateT stateInternal
-> c (State stateT stateInternal)
$cgfoldl :: forall stateT stateInternal (c :: * -> *).
(Data stateT, Data stateInternal) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> State stateT stateInternal
-> c (State stateT stateInternal)
$cp1Data :: forall stateT stateInternal.
(Data stateT, Data stateInternal) =>
Typeable (State stateT stateInternal)
Data, State stateT stateInternal -> State stateT stateInternal -> Bool
(State stateT stateInternal -> State stateT stateInternal -> Bool)
-> (State stateT stateInternal
    -> State stateT stateInternal -> Bool)
-> Eq (State stateT stateInternal)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall stateT stateInternal.
(Eq stateT, Eq stateInternal) =>
State stateT stateInternal -> State stateT stateInternal -> Bool
/= :: State stateT stateInternal -> State stateT stateInternal -> Bool
$c/= :: forall stateT stateInternal.
(Eq stateT, Eq stateInternal) =>
State stateT stateInternal -> State stateT stateInternal -> Bool
== :: State stateT stateInternal -> State stateT stateInternal -> Bool
$c== :: forall stateT stateInternal.
(Eq stateT, Eq stateInternal) =>
State stateT stateInternal -> State stateT stateInternal -> Bool
Eq, Int -> State stateT stateInternal -> ShowS
[State stateT stateInternal] -> ShowS
State stateT stateInternal -> String
(Int -> State stateT stateInternal -> ShowS)
-> (State stateT stateInternal -> String)
-> ([State stateT stateInternal] -> ShowS)
-> Show (State stateT stateInternal)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall stateT stateInternal.
(Show stateT, Show stateInternal) =>
Int -> State stateT stateInternal -> ShowS
forall stateT stateInternal.
(Show stateT, Show stateInternal) =>
[State stateT stateInternal] -> ShowS
forall stateT stateInternal.
(Show stateT, Show stateInternal) =>
State stateT stateInternal -> String
showList :: [State stateT stateInternal] -> ShowS
$cshowList :: forall stateT stateInternal.
(Show stateT, Show stateInternal) =>
[State stateT stateInternal] -> ShowS
show :: State stateT stateInternal -> String
$cshow :: forall stateT stateInternal.
(Show stateT, Show stateInternal) =>
State stateT stateInternal -> String
showsPrec :: Int -> State stateT stateInternal -> ShowS
$cshowsPrec :: forall stateT stateInternal.
(Show stateT, Show stateInternal) =>
Int -> State stateT stateInternal -> ShowS
Show)

-- | Supply a 'ReaderT' environment before running the cell
runReaderC
  ::               r
  -> Cell (ReaderT r m) a b
  -> Cell            m  a b
runReaderC :: r -> Cell (ReaderT r m) a b -> Cell m a b
runReaderC r
r = (forall x. ReaderT r m x -> m x)
-> Cell (ReaderT r m) a b -> Cell m a b
forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell ((forall x. ReaderT r m x -> m x)
 -> Cell (ReaderT r m) a b -> Cell m a b)
-> (forall x. ReaderT r m x -> m x)
-> Cell (ReaderT r m) a b
-> Cell m a b
forall a b. (a -> b) -> a -> b
$ (ReaderT r m x -> r -> m x) -> r -> ReaderT r m x -> m x
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT r m x -> r -> m x
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT r
r

-- | Supply a 'ReaderT' environment live
runReaderC'
  :: Monad m
  => Cell (ReaderT r m) a b
  -> Cell m (r, a) b
runReaderC' :: Cell (ReaderT r m) a b -> Cell m (r, a) b
runReaderC' = (forall s. (a -> ReaderT r m (b, s)) -> (r, a) -> m (b, s))
-> Cell (ReaderT r m) a b -> Cell m (r, a) b
forall (m1 :: * -> *) (m2 :: * -> *) a1 b1 a2 b2.
(Monad m1, Monad m2) =>
(forall s. (a1 -> m1 (b1, s)) -> a2 -> m2 (b2, s))
-> Cell m1 a1 b1 -> Cell m2 a2 b2
hoistCellKleisli_ ((forall s. (a -> ReaderT r m (b, s)) -> (r, a) -> m (b, s))
 -> Cell (ReaderT r m) a b -> Cell m (r, a) b)
-> (forall s. (a -> ReaderT r m (b, s)) -> (r, a) -> m (b, s))
-> Cell (ReaderT r m) a b
-> Cell m (r, a) b
forall a b. (a -> b) -> a -> b
$ \a -> ReaderT r m (b, s)
action (r, a) -> ReaderT r m (b, s) -> r -> m (b, s)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT r m (b, s)
action a
a) r
r

-- | Run the effects of the 'WriterT' monad,
--   collecting all its output in the second element of the tuple.
runWriterC :: (Monoid w, Monad m) => Cell (WriterT w m) a b -> Cell m a (w, b)
runWriterC :: Cell (WriterT w m) a b -> Cell m a (w, b)
runWriterC = (forall s. WriterT w m (b, s) -> m ((w, b), s))
-> Cell (WriterT w m) a b -> Cell m a (w, b)
forall (m1 :: * -> *) (m2 :: * -> *) b1 b2 a.
(Monad m1, Monad m2) =>
(forall s. m1 (b1, s) -> m2 (b2, s))
-> Cell m1 a b1 -> Cell m2 a b2
hoistCellOutput ((forall s. WriterT w m (b, s) -> m ((w, b), s))
 -> Cell (WriterT w m) a b -> Cell m a (w, b))
-> (forall s. WriterT w m (b, s) -> m ((w, b), s))
-> Cell (WriterT w m) a b
-> Cell m a (w, b)
forall a b. (a -> b) -> a -> b
$ (((b, s), w) -> ((w, b), s)) -> m ((b, s), w) -> m ((w, b), s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b, s), w) -> ((w, b), s)
forall b b a. ((b, b), a) -> ((a, b), b)
reorder (m ((b, s), w) -> m ((w, b), s))
-> (WriterT w m (b, s) -> m ((b, s), w))
-> WriterT w m (b, s)
-> m ((w, b), s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m (b, s) -> m ((b, s), w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
  where
    reorder :: ((b, b), a) -> ((a, b), b)
reorder ((b
b, b
s), a
w) = ((a
w, b
b), b
s)