{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RankNTypes #-}
{- |
Handling monad morphisms.
-}
module LiveCoding.Cell.Monad where

-- essence-of-live-coding
import LiveCoding.Cell
import Control.Arrow ((>>>), Arrow(arr))
import Data.Data (Data)

-- | Apply a monad morphism that also transforms the output to a cell.
hoistCellOutput
  :: (Monad m1, Monad m2)
  => (forall s . m1 (b1, s) -> m2 (b2, s))
  -> Cell m1 a b1
  -> Cell m2 a b2
hoistCellOutput :: (forall s. m1 (b1, s) -> m2 (b2, s))
-> Cell m1 a b1 -> Cell m2 a b2
hoistCellOutput forall s. m1 (b1, s) -> m2 (b2, s)
morph = (forall s. (a -> m1 (b1, s)) -> a -> m2 (b2, s))
-> Cell m1 a b1 -> Cell m2 a b2
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_ (m1 (b1, s) -> m2 (b2, s)
forall s. m1 (b1, s) -> m2 (b2, s)
morph (m1 (b1, s) -> m2 (b2, s)) -> (a -> m1 (b1, s)) -> a -> m2 (b2, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

-- | Apply a transformation of Kleisli morphisms to a cell.
hoistCellKleisli_
  :: (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. (a1 -> m1 (b1, s)) -> a2 -> m2 (b2, s))
-> Cell m1 a1 b1 -> Cell m2 a2 b2
hoistCellKleisli_ forall s. (a1 -> m1 (b1, s)) -> a2 -> m2 (b2, s)
morph = (forall s. (s -> a1 -> m1 (b1, s)) -> s -> a2 -> m2 (b2, s))
-> Cell m1 a1 b1 -> Cell m2 a2 b2
forall (m1 :: * -> *) (m2 :: * -> *) a1 b1 a2 b2.
(Monad m1, Monad m2) =>
(forall s. (s -> a1 -> m1 (b1, s)) -> s -> a2 -> m2 (b2, s))
-> Cell m1 a1 b1 -> Cell m2 a2 b2
hoistCellKleisli ((a1 -> m1 (b1, s)) -> a2 -> m2 (b2, s)
forall s. (a1 -> m1 (b1, s)) -> a2 -> m2 (b2, s)
morph ((a1 -> m1 (b1, s)) -> a2 -> m2 (b2, s))
-> (s -> a1 -> m1 (b1, s)) -> s -> a2 -> m2 (b2, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

-- | Apply a transformation of stateful Kleisli morphisms to a cell.
hoistCellKleisli
  :: (Monad m1, Monad m2)
  => (forall s . (s -> a1 -> m1 (b1, s)) -> (s -> a2 -> m2 (b2, s)))
  -> Cell m1 a1 b1
  -> Cell m2 a2 b2
hoistCellKleisli :: (forall s. (s -> a1 -> m1 (b1, s)) -> s -> a2 -> m2 (b2, s))
-> Cell m1 a1 b1 -> Cell m2 a2 b2
hoistCellKleisli forall s. (s -> a1 -> m1 (b1, s)) -> s -> a2 -> m2 (b2, s)
morph ArrM { a1 -> m1 b1
runArrM :: forall (m :: * -> *) a b. Cell m a b -> a -> m b
runArrM :: a1 -> m1 b1
.. } = ArrM :: forall (m :: * -> *) a b. (a -> m b) -> Cell m a b
ArrM
  { runArrM :: a2 -> m2 b2
runArrM = (((b2, ()) -> b2) -> m2 (b2, ()) -> m2 b2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b2, ()) -> b2
forall a b. (a, b) -> a
fst (m2 (b2, ()) -> m2 b2) -> (a2 -> m2 (b2, ())) -> a2 -> m2 b2
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a2 -> m2 (b2, ())) -> a2 -> m2 b2)
-> (a2 -> m2 (b2, ())) -> a2 -> m2 b2
forall a b. (a -> b) -> a -> b
$ ((() -> a2 -> m2 (b2, ())) -> () -> a2 -> m2 (b2, ())
forall a b. (a -> b) -> a -> b
$ ()) ((() -> a2 -> m2 (b2, ())) -> a2 -> m2 (b2, ()))
-> (() -> a2 -> m2 (b2, ())) -> a2 -> m2 (b2, ())
forall a b. (a -> b) -> a -> b
$ (() -> a1 -> m1 (b1, ())) -> () -> a2 -> m2 (b2, ())
forall s. (s -> a1 -> m1 (b1, s)) -> s -> a2 -> m2 (b2, s)
morph ((() -> a1 -> m1 (b1, ())) -> () -> a2 -> m2 (b2, ()))
-> (() -> a1 -> m1 (b1, ())) -> () -> a2 -> m2 (b2, ())
forall a b. (a -> b) -> a -> b
$ (a1 -> m1 (b1, ())) -> () -> a1 -> m1 (b1, ())
forall a b. a -> b -> a
const ((a1 -> m1 (b1, ())) -> () -> a1 -> m1 (b1, ()))
-> (a1 -> m1 (b1, ())) -> () -> a1 -> m1 (b1, ())
forall a b. (a -> b) -> a -> b
$ a1 -> m1 b1
runArrM (a1 -> m1 b1) -> (m1 b1 -> m1 (b1, ())) -> a1 -> m1 (b1, ())
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (b1 -> (b1, ())) -> m1 b1 -> m1 (b1, ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( , ())
  }
hoistCellKleisli forall s. (s -> a1 -> m1 (b1, s)) -> s -> a2 -> m2 (b2, s)
morph Cell { s
s -> a1 -> m1 (b1, s)
cellStep :: ()
cellState :: ()
cellStep :: s -> a1 -> m1 (b1, s)
cellState :: s
.. } = Cell :: forall (m :: * -> *) a b s.
Data s =>
s -> (s -> a -> m (b, s)) -> Cell m a b
Cell
  { cellStep :: s -> a2 -> m2 (b2, s)
cellStep = (s -> a1 -> m1 (b1, s)) -> s -> a2 -> m2 (b2, s)
forall s. (s -> a1 -> m1 (b1, s)) -> s -> a2 -> m2 (b2, s)
morph s -> a1 -> m1 (b1, s)
cellStep
  , s
cellState :: s
cellState :: s
..
  }

-- | Apply a transformation of stateful Kleisli morphisms to a cell,
--   changing the state type.
hoistCellKleisliStateChange
  :: (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 -> 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 -> a1 -> m1 (b1, s)) -> t s -> a2 -> m2 (b2, t s)
morph forall s. s -> t s
init Cell { s
s -> a1 -> m1 (b1, s)
cellStep :: s -> a1 -> m1 (b1, s)
cellState :: s
cellStep :: ()
cellState :: ()
.. } = Cell :: forall (m :: * -> *) a b s.
Data s =>
s -> (s -> a -> m (b, s)) -> Cell m a b
Cell
  { cellStep :: t s -> a2 -> m2 (b2, t s)
cellStep  = (s -> a1 -> m1 (b1, s)) -> t s -> a2 -> m2 (b2, t s)
forall s. (s -> a1 -> m1 (b1, s)) -> t s -> a2 -> m2 (b2, t s)
morph s -> a1 -> m1 (b1, s)
cellStep
  , cellState :: t s
cellState = s -> t s
forall s. s -> t s
init s
cellState
  }
hoistCellKleisliStateChange forall s. (s -> a1 -> m1 (b1, s)) -> t s -> a2 -> m2 (b2, t s)
morph forall s. s -> t s
init Cell m1 a1 b1
cell = (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
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 -> a1 -> m1 (b1, s)) -> t s -> a2 -> m2 (b2, t s)
morph forall s. s -> t s
init (Cell m1 a1 b1 -> Cell m2 a2 b2) -> Cell m1 a1 b1 -> Cell m2 a2 b2
forall a b. (a -> b) -> a -> b
$ Cell m1 a1 b1 -> Cell m1 a1 b1
forall (m :: * -> *) a b. Functor m => Cell m a b -> Cell m a b
toCell Cell m1 a1 b1
cell