{-# LANGUAGE DataKinds #-}
module Crem.Decider where
import Crem.BaseMachine (ActionResult (..), BaseMachine, BaseMachineT (..), InitialState (..))
import Crem.Topology (AllowedTransition, Topology)
import Data.Foldable (foldl')
import "base" Data.Kind (Type)
data
Decider
(topology :: Topology vertex)
input
output = forall state.
Decider
{ ()
deciderInitialState :: InitialState state
, ()
decide :: forall vertex'. input -> state vertex' -> output
, ()
evolve
:: forall initialVertex
. state initialVertex
-> output
-> EvolutionResult topology state initialVertex output
}
data
EvolutionResult
(topology :: Topology vertex)
(state :: vertex -> Type)
(initialVertex :: vertex)
output
where
EvolutionResult
:: AllowedTransition topology initialVertex finalVertex
=> state finalVertex
-> EvolutionResult topology state initialVertex output
deciderMachine
:: Decider topology input output
-> BaseMachine topology input output
deciderMachine :: forall {vertex} (topology :: Topology vertex) input output.
Decider topology input output -> BaseMachine topology input output
deciderMachine (Decider InitialState state
deciderInitialState' forall (vertex' :: vertex). input -> state vertex' -> output
decide' forall (initialVertex :: vertex).
state initialVertex
-> output -> EvolutionResult topology state initialVertex output
evolve') =
BaseMachineT
{ initialState :: InitialState state
initialState = InitialState state
deciderInitialState'
, action :: forall (initialVertex :: vertex).
state initialVertex
-> input -> ActionResult m topology state initialVertex output
action = \state initialVertex
state input
input ->
let
output :: output
output = input -> state initialVertex -> output
forall (vertex' :: vertex). input -> state vertex' -> output
decide' input
input state initialVertex
state
in
case state initialVertex
-> output -> EvolutionResult topology state initialVertex output
forall (initialVertex :: vertex).
state initialVertex
-> output -> EvolutionResult topology state initialVertex output
evolve' state initialVertex
state output
output of
EvolutionResult state finalVertex
finalState ->
m (output, state finalVertex)
-> ActionResult m topology state initialVertex output
forall {vertex} (topology :: Topology vertex)
(initialVertex :: vertex) (finalVertex :: vertex) (m :: * -> *)
output (state :: vertex -> *).
AllowedTransition topology initialVertex finalVertex =>
m (output, state finalVertex)
-> ActionResult m topology state initialVertex output
ActionResult (m (output, state finalVertex)
-> ActionResult m topology state initialVertex output)
-> m (output, state finalVertex)
-> ActionResult m topology state initialVertex output
forall a b. (a -> b) -> a -> b
$ (output, state finalVertex) -> m (output, state finalVertex)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output
output, state finalVertex
finalState)
}
rebuildDecider
:: [output]
-> Decider topology input output
-> Decider topology input output
rebuildDecider :: forall {vertex} output (topology :: Topology vertex) input.
[output]
-> Decider topology input output -> Decider topology input output
rebuildDecider [output]
outputs Decider topology input output
decider =
(Decider topology input output
-> output -> Decider topology input output)
-> Decider topology input output
-> [output]
-> Decider topology input output
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Decider topology input output
-> output -> Decider topology input output
forall {vertex} (topology :: Topology vertex) input output.
Decider topology input output
-> output -> Decider topology input output
rebuildDeciderStep Decider topology input output
decider [output]
outputs
where
rebuildDeciderStep
:: Decider topology input output
-> output
-> Decider topology input output
rebuildDeciderStep :: forall {vertex} (topology :: Topology vertex) input output.
Decider topology input output
-> output -> Decider topology input output
rebuildDeciderStep (Decider (InitialState state vertex1
initialState') forall (vertex' :: vertex). input -> state vertex' -> output
decide' forall (initialVertex :: vertex).
state initialVertex
-> output -> EvolutionResult topology state initialVertex output
evolve') output
output =
let
evolveResult :: EvolutionResult topology state vertex1 output
evolveResult = state vertex1
-> output -> EvolutionResult topology state vertex1 output
forall (initialVertex :: vertex).
state initialVertex
-> output -> EvolutionResult topology state initialVertex output
evolve' state vertex1
initialState' output
output
in
case EvolutionResult topology state vertex1 output
evolveResult of
EvolutionResult state finalVertex
evolvedState ->
Decider
{ deciderInitialState :: InitialState state
deciderInitialState = state finalVertex -> InitialState state
forall {vertex} (state :: vertex -> *) (vertex1 :: vertex).
state vertex1 -> InitialState state
InitialState state finalVertex
evolvedState
, decide :: forall (vertex' :: vertex). input -> state vertex' -> output
decide = input -> state vertex' -> output
forall (vertex' :: vertex). input -> state vertex' -> output
decide'
, evolve :: forall (initialVertex :: vertex).
state initialVertex
-> output -> EvolutionResult topology state initialVertex output
evolve = state initialVertex
-> output -> EvolutionResult topology state initialVertex output
forall (initialVertex :: vertex).
state initialVertex
-> output -> EvolutionResult topology state initialVertex output
evolve'
}