{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module LiveCoding.Migrate.Cell where
import Data.Data
import Data.Generics.Aliases
import Control.Applicative (Alternative ((<|>)))
import LiveCoding.Cell
import LiveCoding.Cell.Feedback
import LiveCoding.Exceptions
import LiveCoding.Migrate.Migration
maybeMigrateToPair ::
(Typeable a, Typeable b, Typeable c) =>
(t a b -> a) ->
(t a b -> b) ->
(a -> b -> t a b) ->
t a b ->
c ->
Maybe (t a b)
maybeMigrateToPair :: forall a b c (t :: * -> * -> *).
(Typeable a, Typeable b, Typeable c) =>
(t a b -> a)
-> (t a b -> b) -> (a -> b -> t a b) -> t a b -> c -> Maybe (t a b)
maybeMigrateToPair t a b -> a
fst t a b -> b
snd a -> b -> t a b
cons t a b
pair c
c = do
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> t a b
cons (t a b -> b
snd t a b
pair) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast c
c forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> b -> t a b
cons (t a b -> a
fst t a b
pair) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast c
c
maybeMigrateFromPair ::
(Typeable a, Typeable b, Typeable c) =>
(t a b -> a) ->
(t a b -> b) ->
t a b ->
Maybe c
maybeMigrateFromPair :: forall a b c (t :: * -> * -> *).
(Typeable a, Typeable b, Typeable c) =>
(t a b -> a) -> (t a b -> b) -> t a b -> Maybe c
maybeMigrateFromPair t a b -> a
fst t a b -> b
snd t a b
pair = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast (t a b -> a
fst t a b
pair) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast (t a b -> b
snd t a b
pair)
migrationToComposition :: Migration
migrationToComposition :: Migration
migrationToComposition = 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. (a -> b) -> a -> b
$ forall a b c (t :: * -> * -> *).
(Typeable a, Typeable b, Typeable c) =>
(t a b -> a)
-> (t a b -> b) -> (a -> b -> t a b) -> t a b -> c -> Maybe (t a b)
maybeMigrateToPair forall state1 state2. Composition state1 state2 -> state1
state1 forall state1 state2. Composition state1 state2 -> state2
state2 forall state1 state2. state1 -> state2 -> Composition state1 state2
Composition
migrationFromComposition :: Migration
migrationFromComposition :: Migration
migrationFromComposition = forall (t :: * -> * -> *).
Typeable t =>
(forall a b c.
(Typeable a, Typeable b, Typeable c) =>
t b c -> Maybe a)
-> Migration
constMigrationFrom2 forall a b. (a -> b) -> a -> b
$ forall a b c (t :: * -> * -> *).
(Typeable a, Typeable b, Typeable c) =>
(t a b -> a) -> (t a b -> b) -> t a b -> Maybe c
maybeMigrateFromPair forall state1 state2. Composition state1 state2 -> state1
state1 forall state1 state2. Composition state1 state2 -> state2
state2
migrationComposition :: Migration
migrationComposition :: Migration
migrationComposition =
Migration
migrationToComposition
forall a. Semigroup a => a -> a -> a
<> Migration
migrationFromComposition
migrationToParallel :: Migration
migrationToParallel :: Migration
migrationToParallel = 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. (a -> b) -> a -> b
$ forall a b c (t :: * -> * -> *).
(Typeable a, Typeable b, Typeable c) =>
(t a b -> a)
-> (t a b -> b) -> (a -> b -> t a b) -> t a b -> c -> Maybe (t a b)
maybeMigrateToPair forall stateP1 stateP2. Parallel stateP1 stateP2 -> stateP1
stateP1 forall stateP1 stateP2. Parallel stateP1 stateP2 -> stateP2
stateP2 forall stateP1 stateP2.
stateP1 -> stateP2 -> Parallel stateP1 stateP2
Parallel
migrationFromParallel :: Migration
migrationFromParallel :: Migration
migrationFromParallel = forall (t :: * -> * -> *).
Typeable t =>
(forall a b c.
(Typeable a, Typeable b, Typeable c) =>
t b c -> Maybe a)
-> Migration
constMigrationFrom2 forall a b. (a -> b) -> a -> b
$ forall a b c (t :: * -> * -> *).
(Typeable a, Typeable b, Typeable c) =>
(t a b -> a) -> (t a b -> b) -> t a b -> Maybe c
maybeMigrateFromPair forall stateP1 stateP2. Parallel stateP1 stateP2 -> stateP1
stateP1 forall stateP1 stateP2. Parallel stateP1 stateP2 -> stateP2
stateP2
migrationParallel :: Migration
migrationParallel :: Migration
migrationParallel =
Migration
migrationToParallel
forall a. Semigroup a => a -> a -> a
<> Migration
migrationFromParallel
migrationToChoice :: Migration
migrationToChoice :: Migration
migrationToChoice = 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. (a -> b) -> a -> b
$ forall a b c (t :: * -> * -> *).
(Typeable a, Typeable b, Typeable c) =>
(t a b -> a)
-> (t a b -> b) -> (a -> b -> t a b) -> t a b -> c -> Maybe (t a b)
maybeMigrateToPair forall stateL stateR. Choice stateL stateR -> stateL
choiceLeft forall stateL stateR. Choice stateL stateR -> stateR
choiceRight forall stateL stateR. stateL -> stateR -> Choice stateL stateR
Choice
migrationFromChoice :: Migration
migrationFromChoice :: Migration
migrationFromChoice = forall (t :: * -> * -> *).
Typeable t =>
(forall a b c.
(Typeable a, Typeable b, Typeable c) =>
t b c -> Maybe a)
-> Migration
constMigrationFrom2 forall a b. (a -> b) -> a -> b
$ forall a b c (t :: * -> * -> *).
(Typeable a, Typeable b, Typeable c) =>
(t a b -> a) -> (t a b -> b) -> t a b -> Maybe c
maybeMigrateFromPair forall stateL stateR. Choice stateL stateR -> stateL
choiceLeft forall stateL stateR. Choice stateL stateR -> stateR
choiceRight
migrationChoice :: Migration
migrationChoice :: Migration
migrationChoice =
Migration
migrationToChoice
forall a. Semigroup a => a -> a -> a
<> Migration
migrationFromChoice
migrationToFeedback :: Migration
migrationToFeedback :: Migration
migrationToFeedback = 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. (a -> b) -> a -> b
$ forall a b c (t :: * -> * -> *).
(Typeable a, Typeable b, Typeable c) =>
(t a b -> a)
-> (t a b -> b) -> (a -> b -> t a b) -> t a b -> c -> Maybe (t a b)
maybeMigrateToPair forall sPrevious sAdditional.
Feedback sPrevious sAdditional -> sPrevious
sPrevious forall sPrevious sAdditional.
Feedback sPrevious sAdditional -> sAdditional
sAdditional forall sPrevious sAdditional.
sPrevious -> sAdditional -> Feedback sPrevious sAdditional
Feedback
migrationFromFeedback :: Migration
migrationFromFeedback :: Migration
migrationFromFeedback = forall (t :: * -> * -> *).
Typeable t =>
(forall a b c.
(Typeable a, Typeable b, Typeable c) =>
t b c -> Maybe a)
-> Migration
constMigrationFrom2 forall a b. (a -> b) -> a -> b
$ forall a b c (t :: * -> * -> *).
(Typeable a, Typeable b, Typeable c) =>
(t a b -> a) -> (t a b -> b) -> t a b -> Maybe c
maybeMigrateFromPair forall sPrevious sAdditional.
Feedback sPrevious sAdditional -> sPrevious
sPrevious forall sPrevious sAdditional.
Feedback sPrevious sAdditional -> sAdditional
sAdditional
migrationFeedback :: Migration
migrationFeedback :: Migration
migrationFeedback = Migration
migrationToFeedback forall a. Semigroup a => a -> a -> a
<> Migration
migrationFromFeedback
maybeMigrateToExceptState ::
(Typeable state, Typeable state') =>
ExceptState state e ->
state' ->
Maybe (ExceptState state e)
maybeMigrateToExceptState :: forall state state' e.
(Typeable state, Typeable state') =>
ExceptState state e -> state' -> Maybe (ExceptState state e)
maybeMigrateToExceptState (NotThrown state
_) state'
state = forall state e. state -> ExceptState state e
NotThrown forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast state'
state
maybeMigrateToExceptState (Exception e
e) state'
_ = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall state e. e -> ExceptState state e
Exception e
e
migrationToExceptState :: Migration
migrationToExceptState :: Migration
migrationToExceptState = 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 state state' e.
(Typeable state, Typeable state') =>
ExceptState state e -> state' -> Maybe (ExceptState state e)
maybeMigrateToExceptState
maybeMigrateFromExceptState ::
(Typeable state, Typeable state') =>
ExceptState state e ->
Maybe state'
maybeMigrateFromExceptState :: forall state state' e.
(Typeable state, Typeable state') =>
ExceptState state e -> Maybe state'
maybeMigrateFromExceptState (NotThrown state
state) = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast state
state
maybeMigrateFromExceptState (Exception e
e) = forall a. Maybe a
Nothing
migrationFromExceptState :: Migration
migrationFromExceptState :: Migration
migrationFromExceptState = forall (t :: * -> * -> *).
Typeable t =>
(forall a b c.
(Typeable a, Typeable b, Typeable c) =>
t b c -> Maybe a)
-> Migration
constMigrationFrom2 forall state state' e.
(Typeable state, Typeable state') =>
ExceptState state e -> Maybe state'
maybeMigrateFromExceptState
migrationExceptState :: Migration
migrationExceptState :: Migration
migrationExceptState = Migration
migrationToExceptState forall a. Semigroup a => a -> a -> a
<> Migration
migrationFromExceptState
migrationCell :: Migration
migrationCell :: Migration
migrationCell =
Migration
migrationComposition
forall a. Semigroup a => a -> a -> a
<> Migration
migrationParallel
forall a. Semigroup a => a -> a -> a
<> Migration
migrationChoice
forall a. Semigroup a => a -> a -> a
<> Migration
migrationExceptState
forall a. Semigroup a => a -> a -> a
<> Migration
migrationFeedback