Trans.hs

{-# 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' = do
  stateInternal <- cast stateInternal'
  return State {..}

{- | 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 = migrationTo2 maybeMigrateToState

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

-- | Try to extract a state from the current joint state of a program wrapped with 'runStateL' or 'runStateC'.
migrationFromState :: Migration
migrationFromState = constMigrationFrom2 maybeMigrateFromState

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