Created
February 12, 2015 18:15
-
-
Save CarstenKoenig/e692890f48b06d24c8d7 to your computer and use it in GitHub Desktop.
playing back events with FUN
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
namespace Events | |
type Projection<'ev, 'state, 'out> = | |
{ foldState : 'ev -> 'state -> 'state | |
; projection : 'state -> 'out | |
; emptyState : 'state | |
} | |
module Projections = | |
let private proj foldS proj empty = | |
{ foldState = foldS; projection = proj; emptyState = empty } | |
let map (f : 'outA -> 'outB) (p : Projection<'ev, _, 'outA>) : Projection<'ev, _, 'outB> = | |
proj p.foldState (p.projection >> f) p.emptyState | |
let aggregate (init : 'state) (ag : 'ev -> 'state -> 'state) : Projection<'ev, _, 'state> = | |
proj ag id init | |
let (<%>) = map | |
let (<|>) (a : 'a option) (b : 'a option) = | |
match (a,b) with | |
| (None, _) -> b | |
| (Some _, _) -> a | |
let latest (f : 'ev -> 'a option) : Projection<'ev,_,'a option> = | |
aggregate None (fun ev lt -> (f ev <|> lt)) | |
type IPlayback<'ev> = | |
abstract Playback : Projection<'ev, 'state, 'out> -> 'out | |
module PlaybackDevices = | |
let private foldBack (f : 'ev -> 'state -> 'state) (empty : 'state) (evs : 'ev seq) = | |
let enum = evs.GetEnumerator() | |
let rec fold cont = | |
if not (enum.MoveNext()) | |
then cont empty | |
else | |
let cur = enum.Current | |
fold (fun state -> f cur state |> cont) | |
fold id | |
let fromEventSeq (evs : 'ev seq) : IPlayback<'ev> = | |
{ new IPlayback<'ev> with | |
member __.Playback p = | |
evs | |
|> foldBack p.foldState p.emptyState | |
|> p.projection | |
} | |
namespace Events.ShipTrackingExample | |
open Events | |
open Events.Projections | |
module ShipTracking = | |
type Country = | |
| US | |
| CANADA | |
type Cargo = Cargo of string | |
type Port = Port of string * Country | |
type Ship = Ship of string | |
let countryOfPort (Port (_, c)) = c | |
type Event = | |
| Arrived of Ship * Port | |
| Departed of Ship | |
| Loaded of Ship * Cargo | |
| Unloaded of Ship * Cargo | |
module Projections = | |
type Location = | |
| AtPort of Port | |
| AtSea | |
| Unknown | |
let locationOf (ship : Ship) = | |
(function None -> Unknown | Some l -> l) <%> | |
latest (function | |
| Arrived (s,p) when s = ship -> Some (AtPort p) | |
| Departed s when s = ship -> Some AtSea | |
| _ -> None) | |
let portHistory (cargo : Cargo) = | |
fst <%> aggregate | |
([], None) | |
(fun ev (vs, onShip) -> | |
match ev with | |
| Arrived (ship, port) | |
when Some ship = onShip -> | |
(port::vs, onShip) | |
| Loaded (ship, c) | |
when c = cargo -> | |
(vs, Some ship) | |
| Unloaded (_, c) | |
when c = cargo -> | |
(vs, None) | |
| _ -> (vs, onShip)) | |
let containerHasBeenIn (cargo : Cargo) (country : Country) = | |
List.exists (fun port -> countryOfPort port = country) | |
<%> portHistory cargo | |
let locationOfCargo (cargo : Cargo) = | |
List.head | |
<%> portHistory cargo | |
module Tests = | |
open Xunit | |
open Projections | |
let refact = Cargo "Refactoring" | |
let kr = Ship "King Roy" | |
let sfo = Port ("San Fransisco", US) | |
let la = Port ("Los Angeles", US); | |
let yyv = Port ("Vancouver", CANADA) | |
let theShip ship = | |
(ship, []) | |
let getPlayback (_, evs) = | |
let device = PlaybackDevices.fromEventSeq evs | |
device.Playback | |
let arrivedIn port (ship, evs) = | |
(ship, Arrived (ship, port) :: evs) | |
let departed (ship, evs) = | |
(ship, Departed ship :: evs) | |
let loaded cargo (ship, evs) = | |
(ship, Loaded (ship, cargo) :: evs) | |
let unloaded cargo (ship, evs) = | |
(ship, Unloaded (ship, cargo) :: evs) | |
[<Fact>] | |
let ``Arriaval sets Ships location``() = | |
let playback = | |
theShip kr | |
|> arrivedIn sfo | |
|> getPlayback | |
let location = playback <| locationOf kr | |
Assert.Equal(AtPort sfo, location) | |
[<Fact>] | |
let ``Departure puts Ship out to Sea``() = | |
let playback = | |
theShip kr | |
|> arrivedIn la | |
|> arrivedIn sfo | |
|> departed | |
|> getPlayback | |
let location = playback <| locationOf kr | |
Assert.Equal(AtSea, location) | |
[<Fact>] | |
let ``Visiting Canada marks Cargo``() = | |
let playback = | |
theShip kr | |
|> loaded refact | |
|> arrivedIn yyv | |
|> departed | |
|> arrivedIn sfo | |
|> unloaded refact | |
|> getPlayback | |
let refactWasInCanada = | |
containerHasBeenIn refact CANADA | |
|> playback | |
Assert.True refactWasInCanada | |
[<Fact>] | |
let ``Arrival with cargo marks the cargos location``() = | |
let playback = | |
theShip kr | |
|> loaded refact | |
|> arrivedIn yyv | |
|> getPlayback | |
let location = | |
locationOfCargo refact | |
|> playback | |
Assert.Equal (yyv, location) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment