{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module LiveCoding.Migrate.Monad.Trans where

-- base
import Data.Data

-- essence-of-live-coding
import LiveCoding.Cell.Monad.Trans
import LiveCoding.Migrate.Migration

maybeMigrateToState
  :: (Typeable stateInternal', Typeable stateInternal)
  => State stateT stateInternal
  -> stateInternal'
  -> Maybe (State stateT stateInternal)
maybeMigrateToState :: State stateT stateInternal
-> stateInternal' -> Maybe (State stateT stateInternal)
maybeMigrateToState State { stateT
stateT :: forall stateT stateInternal. State stateT stateInternal -> stateT
stateT :: stateT
stateT } stateInternal'
stateInternal' = do
  stateInternal
stateInternal <- stateInternal' -> Maybe stateInternal
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast stateInternal'
stateInternal'
  State stateT stateInternal -> Maybe (State stateT stateInternal)
forall (m :: * -> *) a. Monad m => a -> m a
return State :: forall stateT stateInternal.
stateT -> stateInternal -> State stateT stateInternal
State { stateInternal
stateT
stateInternal :: stateInternal
stateInternal :: stateInternal
stateT :: stateT
stateT :: stateT
.. }

-- | Tries to cast the current state into the joint state of a program
--   where a state effect has been absorbed into the internal state with 'runStateL' or 'runStateC'.
migrationToState :: Migration
migrationToState :: Migration
migrationToState = (forall a b c.
 (Typeable a, Typeable b, Typeable c) =>
 State b c -> a -> Maybe (State b c))
-> Migration
forall (t :: * -> * -> *).
Typeable t =>
(forall a b c.
 (Typeable a, Typeable b, Typeable c) =>
 t b c -> a -> Maybe (t b c))
-> Migration
migrationTo2 forall a b c.
(Typeable a, Typeable b, Typeable c) =>
State b c -> a -> Maybe (State b c)
forall stateInternal' stateInternal stateT.
(Typeable stateInternal', Typeable stateInternal) =>
State stateT stateInternal
-> stateInternal' -> Maybe (State stateT stateInternal)
maybeMigrateToState

maybeMigrateFromState
  :: (Typeable stateInternal', Typeable stateInternal)
  => State stateT stateInternal
  -> Maybe              stateInternal'
maybeMigrateFromState :: State stateT stateInternal -> Maybe stateInternal'
maybeMigrateFromState State { stateInternal
stateInternal :: stateInternal
stateInternal :: forall stateT stateInternal.
State stateT stateInternal -> stateInternal
stateInternal } = stateInternal -> Maybe stateInternal'
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast stateInternal
stateInternal

-- | Try to extract a state from the current joint state of a program wrapped with 'runStateL' or 'runStateC'.
migrationFromState :: Migration
migrationFromState :: Migration
migrationFromState = (forall a b c.
 (Typeable a, Typeable b, Typeable c) =>
 State b c -> Maybe a)
-> Migration
forall (t :: * -> * -> *).
Typeable t =>
(forall a b c.
 (Typeable a, Typeable b, Typeable c) =>
 t b c -> Maybe a)
-> Migration
constMigrationFrom2 forall a b c.
(Typeable a, Typeable b, Typeable c) =>
State b c -> Maybe a
forall stateInternal' stateInternal stateT.
(Typeable stateInternal', Typeable stateInternal) =>
State stateT stateInternal -> Maybe stateInternal'
maybeMigrateFromState

-- | Combines 'migrationToState' and 'migrationFromState'.
migrationState :: Migration
migrationState :: Migration
migrationState = Migration
migrationToState Migration -> Migration -> Migration
forall a. Semigroup a => a -> a -> a
<> Migration
migrationFromState