<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)