owned this note
owned this note
Published
Linked with GitHub
---
type: slide
title: crem
tags: talks
slideOptions:
progress: true
controls: false
slideNumber: false
---
<style>
.reveal .code-wrapper {width: fit-content; max-width: 200%; font-size: xxx-large;}
.reveal img {max-width: 200%;}
.reveal pre {max-height: 600px;}
.reveal pre code {max-height: 600px; padding: 10px !important;}
.reveal .hljs-ln-numbers {display: none;}
code {color: #c7254e;}
.machine {position: relative; left: -100px;}
.actionresult {position: relative; left: -70px;}
.topology {position: relative; left: -50px;}
.reveal table th, .reveal table td {border-right: 1px solid; border-color: white;}
.reveal table thead tr th:last-child, .reveal table tbody tr td:last-child {border-right: none;}
.reveal table tr td:first-child {font-weight: bold;}
.highlight {color: #d9480f}
.mermaid {text-align: center !important; background-color:#2d2d2d !important;}
</style>
# [`Crem`](https://github.com/tweag/crem)
## Composable Representable Executable Machines
<img src="https://raw.githubusercontent.com/tweag/crem/main/logo/crem-transparent.png" width="200">
---
---
### <span style="color: orange">Domain events</span>
Events relevant for domain experts
---
### <span style="color: dodgerblue">Commands</span>
User intentions/actions/decisions
---
### <span style="color: lightyellow">Read models</span>
Data needed in order to make decisions
---
### <span style="color: yellow">Aggregates</span>
Decide what happens on commands
---
### <span style="color: orchid">Policies</span>
Reactive logic that takes place after an event
---
### <span style="color: lightgreen">Projections</span>
Aggregate data from events
---
## <span style="color: yellow">Aggregates</span>, <span style="color: lightgreen">projections</span> and <span style="color: orchid">policies</span> could be implemented as state machines
---
### <span style="color: yellow">Aggregates</span>
From <span style="color: dodgerblue">commands</span> to <span style="color: orange">events</span>
---
### <span style="color: lightgreen">Projections</span>
From <span style="color: orange">events</span> to <span style="color: lightyellow">read models</span>
---
### <span style="color: orchid">Policies</span>
From <span style="color: orange">events</span> to <span style="color: dodgerblue">commands</span>
---
## How should we encode a state machine?
---
### Mealy machines
```haskell [1|2|3]
data Mealy state input output = Mealy
{ initialState :: state
, action :: state -> input -> (state, output)
}
```
---
### [Mealy machines](https://hackage.haskell.org/package/machines-0.7.3/docs/Data-Machine-Mealy.html#t:Mealy)
```haskell [1|2-4]
newtype Mealy input output = Mealy
{ runMealy
:: input
-> (output, Mealy input output)
}
```
---
## Machines are composable
---
```haskell
sequential
:: Mealy a b
-> Mealy b c
-> Mealy a c
```
```mermaid
%%{init: {'theme':'dark'}}%%
stateDiagram-v2
direction LR
a --> b
b --> c
```
---
```haskell
parallel
:: Mealy a b
-> Mealy c d
-> Mealy (a, c) (b, d)
```
```mermaid
%%{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)
```
---
```haskell
alternative
:: Mealy a b
-> Mealy c d
-> Mealy (Either a c) (Either c d)
```
```mermaid
%%{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
```
---
```haskell
feedback
:: Mealy a [b]
-> Mealy b [a]
-> Mealy a [b]
```
```mermaid
%%{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
```haskell
data Machine
(topology :: Topology vertex)
input
output
```
---
```haskell
{-# LANGUAGE DataKinds #-}
newtype Topology vertex = Topology
{ edges :: [(vertex, [vertex])] }
```
---
### Topology
```mermaid
%%{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
---
```haskell [1|2|3|4-8]
data Machine topology a b =
forall state. Machine
{ initialState :: InitialState state
, action
:: forall initialVertex
. state initialVertex
-> a
-> ActionResult topology state initialVertex b
}
```
<!-- .element: class="machine" -->
---
```haskell [1|2|4|3]
data ActionResult topology state initial b where
ActionResult
:: AllowedTransition topology initial final
=> (b, state final)
-> ActionResult topology state initial b
```
<!-- .element: class="actionresult" -->
---
Allows us to retrieve information about our state machine without running it
---
```haskell [1|7-8|9|3-5]
topology
:: forall vertex topology a b
. ( Demote vertex ~ vertex
, SingKind vertex
, SingI topology
)
=> Machine (topology :: Topology vertex) a b
-> Topology vertex
baseMachineTopology _ = demote @topology
```
<!-- .element: class="topology" -->
---
### But...
---
### Composition becomes harder
```haskell
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?
---
```haskell
data StateMachine input output where
```
---
```haskell [1|2-4]
data StateMachine input output where
Basic
:: Machine topology input output
-> StateMachine input output
```
---
```haskell [1|2-3]
foo :: StateMachine input output -> a
foo stateMachine = case stateMachine of
Basic machine -> _
```
---
```haskell [3-6]
data StateMachine input output where
...
Sequential
:: StateMachine a b
-> StateMachine b c
-> StateMachine a c
```
---
```haskell [3-6]
data StateMachine input output where
...
Parallel
:: StateMachine a b
-> StateMachine c d
-> StateMachine (a, c) (b, d)
```
---
```haskell [3-6]
data StateMachine input output where
...
Alternative
:: StateMachine a b
-> StateMachine c d
-> StateMachine (Either a c) (Either b d)
```
---
```haskell [3-6]
data StateMachine input output where
...
Feedback
:: StateMachine a [b]
-> StateMachine b [a]
-> StateMachine a [b]
```
---
```mermaid
%%{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
---
```haskell [1|2|4]
instance Category StateMachine where
id = Basic identity
(.) = flip Sequential
```
---
```haskell [1|2]
instance Strong StateMachine where
second' = Parallel id
```
---
```haskell [1|2]
instance Choice StateMachine where
right' = Alternative id
```
---
## Executable
---
```haskell
run
:: StateMachine a b
-> a
-> (b, StateMachine a b)
```
---
```haskell [1|2-3]
run (Basic machine) input =
_ -- use the `action`
-- with `initialState` and `input`
```
---
```haskell [1|3-4|5-6|8-9]
run (Sequential machine1 machine2) input =
let
(output1, machine1')
= run machine1 input
(output2, machine2')
= run machine2 output1
in
( output2
, Sequential machine1' machine2'
)
```
---
```haskell [1|3-4|5-6|8-9]
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
---
```haskell [1-2|4]
newtype Mermaid = Mermaid
{getText :: Text}
render :: StateMachine a b -> Mermaid
```
---
```haskell [1|2]
render (Basic machine)
= renderTopology (topology machine)
```
---
```haskell [1|3|4|6-8]
render (Sequential machine1 machine2) =
let
mermaid1 = render machine1
mermaid2 = render machine2
in
mermaid1
<> Mermaid " --> "
<> mermaid2
```
---
### We can draw our machines
---
<img alt="risk manager" src="https://mermaid.ink/svg/pako:eNqlVF1PwjAU_SvkPmkyCGCBbQ8mCvqkxkj0wSwhzXad1a4lXUdAsv9u9-HcCMgMfepOz73n3PbubsGXAYILsaYaZ4yGikbd1dATHbNysEPDUGGY7bYFnK0KXDzIGdX0BZXG9b7zqeQcfY3Bc4yqJfVOUjFDTRmPb5mK9eGQJ_SRrTCYKgyYvk4U0iQTORJWKV1x_renenmdbvfyxMqa1EMJ29ffLvGpt7TfzyH3R--0hZ1_5E7rzbqUnPmbeqcWyOLsvMH-bepMqOAUJ2WGhn5DQckPY4VJ0VCp0MWciZDjYwXs8bqjXlHrOpEvhU91XaSEdmupOcrSlSywIEIVURaY3ztP4oF-xwg9cM02oOrTA0-khpcsA6N4Y95CKnDfKI_RAppoOd8IH1ytEvwhlSOiYi2peJWy8Q3uFtbgkv6oN7ZtZ0xscjEZWbABdziY9IjjODaZkMFw0HdIasFXHt_vGQrmFu6LkZRPpvQbS36R_g" height="600">
---
## Demo time
[The Hobbit code](https://github.com/tweag/crem/blob/main/examples/Crem/Example/TheHobbit.hs)
[The Hobbit map](https://mermaid.live/edit#pako:eNp9ksFuwjAMhl-l8rlFUNrS5rDLNmkHkKZtpykXi3gQkTqoTdEY4t0Xyqhox3aKrf-L_Sf2AZZWEQioHTp60LiqsIx2sWTJbw0zmbne0BMaI3lufYqsai9V1pj63hBWmleSX_SOWNGJWuja7Re2YYeaL-QzunV3C3c0LB5E0V1wVb8LW-FPI2d14KWft8iVvRvqtcWOvFm6rw5e2ktvtz31-MfzUD5_VBf_MgshlFSVqJUf4EFyEEhwaypJgvChwmojQfLRc81W-fk-Ku1sBeIDTU0hYOPs656XIFzV0AX6WYKO2iK_W9vLQRzgE0RUTIpsNB4XsyzN4jSEPYikiEdpPomLPI_9kR5D-GpvF6NZkuTTdDpJsmk-G3ucWjuL8wK2e3j8Bgbo5M8)
note:
`cabal run hobbit-game`
`cabal run hobbit-map`
---
## That's all!
---
## Questions and feedback
:scroll: [marcosh.github.io](http://marcosh.github.io/)
:bird: [@marcoshuttle](https://twitter.com/marcoshuttle)
:elephant: [@marcosh@functional.cafe](https://functional.cafe/@marcosh)
Google Drive
Gist
Clipboard
Sign in with Wallet
