mirror of
https://github.com/marcosh/crem.git
synced 2024-09-11 12:36:19 +03:00
A StateMachine is a profunctor
This commit is contained in:
parent
75fd22d4c9
commit
ca55a14e6a
@ -44,6 +44,8 @@ dependencies:
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
dependencies:
|
||||
- profunctors
|
||||
|
||||
tests:
|
||||
crm-spec:
|
||||
|
@ -4,6 +4,7 @@ module CRM.BaseMachine where
|
||||
|
||||
import CRM.Topology
|
||||
import "base" Data.Kind (Type)
|
||||
import "profunctors" Data.Profunctor (Profunctor (..))
|
||||
|
||||
-- * Specifying state machines
|
||||
|
||||
@ -27,6 +28,21 @@ data
|
||||
-> ActionResult topology state initialVertex output
|
||||
}
|
||||
|
||||
instance Profunctor (BaseMachine topology) where
|
||||
lmap :: (a -> b) -> BaseMachine topology b c -> BaseMachine topology a c
|
||||
lmap f (BaseMachine initialState action) =
|
||||
BaseMachine
|
||||
{ initialState = initialState
|
||||
, action = (. f) . action
|
||||
}
|
||||
|
||||
rmap :: (b -> c) -> BaseMachine topology a b -> BaseMachine topology a c
|
||||
rmap f (BaseMachine initialState action) =
|
||||
BaseMachine
|
||||
{ initialState = initialState
|
||||
, action = ((f <$>) .) . action
|
||||
}
|
||||
|
||||
{- | A value of type `InitialState state` describes the initial state of a
|
||||
state machine, describing the initial `vertex` in the `topology` and the
|
||||
actual initial data of type `state vertex`
|
||||
@ -50,3 +66,11 @@ data
|
||||
=> state finalVertex
|
||||
-> output
|
||||
-> ActionResult topology state initialVertex output
|
||||
|
||||
instance Functor (ActionResult topology state initialVertex) where
|
||||
fmap
|
||||
:: (a -> b)
|
||||
-> ActionResult topology state initialVertex a
|
||||
-> ActionResult topology state initialVertex b
|
||||
fmap f (ActionResult state output) =
|
||||
ActionResult state (f output)
|
||||
|
@ -5,6 +5,7 @@ module CRM.StateMachine where
|
||||
|
||||
import CRM.BaseMachine
|
||||
import CRM.Topology
|
||||
import "profunctors" Data.Profunctor (Profunctor (..))
|
||||
import "singletons-base" Data.Singletons (Demote, SingI, SingKind)
|
||||
|
||||
-- import "base" Control.Category (Category (..))
|
||||
@ -36,6 +37,15 @@ infixr 1 <<<
|
||||
|
||||
-- * Profunctor
|
||||
|
||||
instance Profunctor StateMachine where
|
||||
lmap :: (a -> b) -> StateMachine b c -> StateMachine a c
|
||||
lmap f (Basic baseMachine) = Basic $ lmap f baseMachine
|
||||
lmap f (Compose machine1 machine2) = Compose (lmap f machine1) machine2
|
||||
|
||||
rmap :: (b -> c) -> StateMachine a b -> StateMachine a c
|
||||
rmap f (Basic baseMachine) = Basic $ rmap f baseMachine
|
||||
rmap f (Compose machine1 machine2) = Compose machine1 (rmap f machine2)
|
||||
|
||||
-- * Strong
|
||||
|
||||
-- * Choice
|
||||
|
Loading…
Reference in New Issue
Block a user