changed 2 years ago  
Linked with GitHub

Crem

Composable Representable Executable Machines

Image Not Showing Possible Reasons
  • The image file may be corrupted
  • The server hosting the image is unavailable
  • The image path is incorrect
  • The image format is not supported
Learn More →

Image Not Showing Possible Reasons
  • The image file may be corrupted
  • The server hosting the image is unavailable
  • The image path is incorrect
  • The image format is not supported
Learn More →

Domain events

Image Not Showing Possible Reasons
  • The image file may be corrupted
  • The server hosting the image is unavailable
  • The image path is incorrect
  • The image format is not supported
Learn More →

Events relevant for domain experts

Commands

Image Not Showing Possible Reasons
  • The image file may be corrupted
  • The server hosting the image is unavailable
  • The image path is incorrect
  • The image format is not supported
Learn More →

User intentions/actions/decisions

Read models

Image Not Showing Possible Reasons
  • The image file may be corrupted
  • The server hosting the image is unavailable
  • The image path is incorrect
  • The image format is not supported
Learn More →

Data needed in order to make decisions

Aggregates

Image Not Showing Possible Reasons
  • The image file may be corrupted
  • The server hosting the image is unavailable
  • The image path is incorrect
  • The image format is not supported
Learn More →

Decide what happens on commands

Policies

policy

Reactive logic that takes place after an event

Projections

projection

Aggregate data from events

Aggregates, projections and policies could be implemented as state machines

Aggregates

aggregate-command-event

From commands to events

Projections

projection-event-read-model

From events to read models

Policies

policy-event-command

From events to commands

How should we encode a state machine?

Mealy machines

data Mealy state input output = Mealy
  { initialState :: state
  , action :: state -> input -> (state, output)
  }

Mealy machines

newtype Mealy input output = Mealy
  { runMealy
      :: input
      -> (output, Mealy input output)
  }

Machines are composable

sequential
  :: Mealy a b  
  -> Mealy b c
  -> Mealy a c

%%{init: {'theme':'dark'}}%%
stateDiagram-v2
direction LR
a --> b
b --> c

parallel
  :: Mealy a b
  -> Mealy c d
  -> Mealy (a, c) (b, d)

%%{init: {'theme':'dark'}}%%
stateDiagram-v2
direction LR
state fork <<fork>>
(a,c) --> fork
fork --> a
fork --> c
a --> b
c --> d
state join <<join>>
b --> join
d --> join
join --> (b,d)

alternative
  :: Mealy a b
  -> Mealy c d
  -> Mealy (Either a c) (Either c d)

%%{init: {'theme':'dark'}}%%
stateDiagram-v2
direction LR
eitherac: Either a c
state fork <<choice>>
eitherac --> fork
fork --> a
fork --> c
a --> b
c --> d
state join <<choice>>
b --> join
d --> join
join --> eitherbd
eitherbd: Either b d

feedback
  :: Mealy a [b]
  -> Mealy b [a]
  -> Mealy a [b]

%%{init: {'theme':'dark'}}%%
stateDiagram-v2
direction LR
a --> b: []
b --> a: []

This encoding can only be run

note: Once we defined a machine, the only way to extract information about it, is to run it, giving it inputs and observing its outputs

What about documentation?

What about invariant enforcement?

Strengthening the type

data Machine
  (topology :: Topology vertex)
  input
  output

{-# LANGUAGE DataKinds #-}

newtype Topology vertex = Topology
  { edges :: [(vertex, [vertex])] }

Topology

%%{init: {'theme':'dark'}}%%
stateDiagram-v2

NoData --> CollectedUserData
CollectedUserData --> CollectedLoanDetailsFirst
CollectedUserData --> ReceivedCreditBureauDataFirst
CollectedLoanDetailsFirst --> CollectedAllData
ReceivedCreditBureauDataFirst --> CollectedAllData

Adding the Topology in the type

Allows us to enforce execution of allowed transitions

data Machine topology a b =
  forall state. Machine
    { initialState :: InitialState state
    , action
      :: forall initialVertex
       . state initialVertex
      -> a
      -> ActionResult topology state initialVertex b
    }

data ActionResult topology state initial b where
  ActionResult
    :: AllowedTransition topology initial final
    => (b, state final)
    -> ActionResult topology state initial b

Allows us to retrieve information about our state machine without running it

topology
  :: forall vertex topology a b
   . ( Demote vertex ~ vertex
     , SingKind vertex
     , SingI topology
     )
  => Machine (topology :: Topology vertex) a b
  -> Topology vertex
baseMachineTopology _ = demote @topology

But…

Composition becomes harder

sequential
  :: Machine t1 a b  
  -> Machine t2 b c
  -> Machine ??? a c

Requires computation at the type level

Breaks usage of standard typeclasses like Arrow or Category

Can we get the best of both worlds?

data StateMachine input output where

data StateMachine input output where
  Basic
    :: Machine topology input output
    -> StateMachine input output

foo :: StateMachine input output -> a
foo stateMachine = case stateMachine of
  Basic machine -> _

data StateMachine input output where
  ...
  Sequential
    :: StateMachine a b
    -> StateMachine b c
    -> StateMachine a c

data StateMachine input output where
  ...
  Parallel
    :: StateMachine a b
    -> StateMachine c d
    -> StateMachine (a, c) (b, d)

data StateMachine input output where
  ...
  Alternative
    :: StateMachine a b
    -> StateMachine c d
    -> StateMachine (Either a c) (Either b d)

data StateMachine input output where
  ...
  Feedback
    :: StateMachine a [b]
    -> StateMachine b [a]
    -> StateMachine a [b]

%%{init: {'theme':'dark'}}%%
graph TD

A[Alternative] --> B[Parallel]
A --> C[Sequential]
B --> D[Machine 1]
B --> E[Machine 2]
C --> F[Machine 3]
C --> G[Machine 4]

Composable

instance Category StateMachine where
  id = Basic identity

  (.) = flip Sequential

instance Strong StateMachine where
  second' = Parallel id

instance Choice StateMachine where
  right' = Alternative id

Executable

run
  :: StateMachine a b
  -> a
  -> (b, StateMachine a b)

run (Basic machine) input =
  _ -- use the `action`
    -- with `initialState` and `input`

run (Sequential machine1 machine2) input =
  let
    (output1, machine1')
      = run machine1 input
    (output2, machine2')
      = run machine2 output1
  in
    ( output2
    , Sequential machine1' machine2'
    )

run (Parallel machine1 machine2) input =
  let
    (output1, machine1')
      = run machine1 (fst input)
    (output2, machine2')
      = run machine2 (snd input)
  in
    ( (output1, output2)
    , Parallel machine1' machine2'
    )

Representable

newtype Mermaid = Mermaid
  {getText :: Text}

render :: StateMachine a b -> Mermaid

render (Basic machine)
  = renderTopology (topology machine)

render (Sequential machine1 machine2) =
  let
    mermaid1 = render machine1
    mermaid2 = render machine2
  in
       mermaid1
    <> Mermaid " --> "
    <> mermaid2

We can draw our machines

Image Not Showing Possible Reasons
  • The image file may be corrupted
  • The server hosting the image is unavailable
  • The image path is incorrect
  • The image format is not supported
Learn More →

Demo time

the hobbit

The Hobbit code

The Hobbit map

note:
cabal run hobbit-game
cabal run hobbit-map

That's all!

Questions and feedback

Image Not Showing Possible Reasons
  • The image file may be corrupted
  • The server hosting the image is unavailable
  • The image path is incorrect
  • The image format is not supported
Learn More →
marcosh.github.io

Image Not Showing Possible Reasons
  • The image file may be corrupted
  • The server hosting the image is unavailable
  • The image path is incorrect
  • The image format is not supported
Learn More →
@marcoshuttle

Image Not Showing Possible Reasons
  • The image file may be corrupted
  • The server hosting the image is unavailable
  • The image path is incorrect
  • The image format is not supported
Learn More →
@marcosh@functional.cafe

Select a repo