{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}

{- |
Handling monad transformers.
-}
module LiveCoding.Cell.Monad.Trans where

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

-- transformers
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import Control.Monad.Trans.State.Strict (StateT (..), evalStateT, runStateT)
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) =>
  -- | A cell with a state effect
  Cell (StateT stateT m) a b ->
  -- | The initial state
  stateT ->
  -- | The cell, returning its current state
  Cell m a (b, stateT)
runStateC :: 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 = 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 {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 {stateInternal}. stateInternal -> State stateT stateInternal
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) <- 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
      forall (m :: * -> *) a. Monad m => a -> m a
return ((a
b, stateT
stateT), State {stateT
stateInternal
stateT :: stateT
stateInternal :: stateInternal
stateInternal :: stateInternal
stateT :: stateT
..})
    init :: stateInternal -> State stateT stateInternal
init stateInternal
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) =>
  -- | A cell with a state effect
  Cell (StateT stateT m) a b ->
  -- | The initial state
  stateT ->
  Cell m a b
runStateC_ :: forall stateT (m :: * -> *) a b.
(Data stateT, Monad m) =>
Cell (StateT stateT m) a b -> stateT -> Cell m a b
runStateC_ Cell (StateT stateT m) a b
cell stateT
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 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr 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
  { forall stateT stateInternal. State stateT stateInternal -> stateT
stateT :: stateT
  , forall stateT stateInternal.
State stateT stateInternal -> stateInternal
stateInternal :: stateInternal
  }
  deriving (State stateT stateInternal -> DataType
State stateT stateInternal -> Constr
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 {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 (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 e. (Data d, Data e) => c (t d e))
-> Maybe (c (State stateT stateInternal))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
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 u.
(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 :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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)
Data, State stateT stateInternal -> State stateT stateInternal -> Bool
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
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 :: forall r (m :: * -> *) a b.
r -> Cell (ReaderT r m) a b -> Cell m a b
runReaderC r
r = forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip 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' :: forall (m :: * -> *) r a b.
Monad m =>
Cell (ReaderT r m) a b -> Cell m (r, a) b
runReaderC' = 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 a b. (a -> b) -> a -> b
$ \a -> ReaderT r m (b, s)
action (r
r, a
a) -> 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 :: forall w (m :: * -> *) a b.
(Monoid w, Monad m) =>
Cell (WriterT w m) a b -> Cell m a (w, b)
runWriterC = 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 a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {b} {b} {a}. ((b, b), a) -> ((a, b), b)
reorder forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)