{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

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

-- essence-of-live-coding

import Control.Arrow (Arrow (arr), (>>>))
import Data.Data (Data)
import LiveCoding.Cell

-- | 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 (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. m1 (b1, s) -> m2 (b2, s)
morph = 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. m1 (b1, s) -> m2 (b2, s)
morph 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 (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. (a1 -> m1 (b1, s)) -> a2 -> m2 (b2, s)
morph = 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 (forall s. (a1 -> m1 (b1, s)) -> a2 -> m2 (b2, s)
morph 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 (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 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
    { runArrM :: a2 -> m2 b2
runArrM = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> a -> b
$ ()) forall a b. (a -> b) -> a -> b
$ forall s. (s -> a1 -> m1 (b1, s)) -> s -> a2 -> m2 (b2, s)
morph forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ a1 -> m1 b1
runArrM forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> 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
    { cellStep :: s -> a2 -> m2 (b2, s)
cellStep = 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 (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 {s
s -> a1 -> m1 (b1, s)
cellStep :: s -> a1 -> m1 (b1, s)
cellState :: s
cellStep :: ()
cellState :: ()
..} =
  Cell
    { cellStep :: t s -> a2 -> m2 (b2, t s)
cellStep = 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 = 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 (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 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. Functor m => Cell m a b -> Cell m a b
toCell Cell m1 a1 b1
cell