Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
464 lines (378 sloc) 15.7 KB
(* ======================================
11-FRP.fsx
Part of "Thirteen ways of looking at a turtle"
Related blog post: http://fsharpforfunandprofit.com/posts/13-ways-of-looking-at-a-turtle/
======================================
Way #11: Functional Retroactive Programming -- Business logic is based on reacting to earlier events
In this design, the "write-side" follows the same pattern as the event-sourcing example.
A client sends a Command to a CommandHandler, which converts that to a list of events and stores them in an EventStore.
However in this design, the CommandHandler only updates state and does NOT do any complex business logic.
The domain logic is done on the "read-side", by listening to events emitted from the event store.
====================================== *)
#load "Common.fsx"
#load "FPTurtleLib.fsx"
open System
open Common
open FPTurtleLib
// ======================================
// EventStore
// ======================================
// Same code as event sourcing example
type EventStore() =
// private mutable data
let eventDict = System.Collections.Generic.Dictionary<System.Guid,obj list>()
let saveEvent = new Event<System.Guid * obj>()
/// Triggered when something is saved
member this.SaveEvent =
saveEvent.Publish
/// save an event to storage
member this.Save(eventId,event) =
match eventDict.TryGetValue eventId with
| true,eventList ->
let newList = event :: eventList // store newest in front
eventDict.[eventId] <- newList
| false, _ ->
let newList = [event]
eventDict.[eventId] <- newList
saveEvent.Trigger(eventId,event)
/// get all events associated with the specified eventId
member this.Get<'a>(eventId) =
match eventDict.TryGetValue eventId with
| true,eventList ->
eventList
|> Seq.cast<'a> |> Seq.toList // convert to typed list
|> List.rev // reverse so that oldest events are first
| false, _ ->
[]
/// clear all events associated with the specified eventId
member this.Clear(eventId) =
eventDict.[eventId] <- []
// ====================================
// Common types for event sourcing
// (same code as event sourcing example)
// ====================================
type TurtleId = System.Guid
/// A desired action on a turtlr
type TurtleCommandAction =
| Move of Distance
| Turn of Angle
| PenUp
| PenDown
| SetColor of PenColor
/// A command representing a desired action addressed to a specific turtle
type TurtleCommand = {
turtleId : TurtleId
action : TurtleCommandAction
}
/// An event representing a state change that happened
type StateChangedEvent =
| Moved of Distance
| Turned of Angle
| PenWentUp
| PenWentDown
| ColorChanged of PenColor
/// An event representing a move that happened
/// This can be easily translated into a line-drawing activity on a canvas
type MovedEvent = {
startPos : Position
endPos : Position
penColor : PenColor option
}
/// A union of all possible events
type TurtleEvent =
| StateChangedEvent of StateChangedEvent
| MovedEvent of MovedEvent
// ====================================
// CommandHandler
// (same code as event sourcing example)
// ====================================
module CommandHandler =
/// Handle a command and return the new state of the turtle
let applyEvent log oldState event =
match event with
| Moved distance ->
Turtle.move log distance oldState
| Turned angle ->
Turtle.turn log angle oldState
| PenWentUp ->
Turtle.penUp log oldState
| PenWentDown ->
Turtle.penDown log oldState
| ColorChanged color ->
Turtle.setColor log color oldState
/// The type representing a function that gets the StateChangedEvents for a turtle id
/// The oldest events are first
type GetStateChangedEventsForId =
TurtleId -> StateChangedEvent list
/// The type representing a function that saves a TurtleEvent
type SaveTurtleEvent =
TurtleId -> TurtleEvent -> unit
let eventsFromCommand log command stateBeforeCommand =
// --------------------------
// create the StateChangedEvent
let stateChangedEvent =
match command.action with
| Move dist -> Moved dist
| Turn angle -> Turned angle
| PenUp -> PenWentUp
| PenDown -> PenWentDown
| SetColor color -> ColorChanged color
// --------------------------
// calculate the current state from the new event
let stateAfterCommand =
applyEvent log stateBeforeCommand stateChangedEvent
// --------------------------
// create the MovedEvent
let startPos = stateBeforeCommand.position
let endPos = stateAfterCommand.position
let penColor =
if stateBeforeCommand.penState=Down then
Some stateBeforeCommand.color
else
None
let movedEvent = {
startPos = startPos
endPos = endPos
penColor = penColor
}
// --------------------------
// return the list of events
if startPos <> endPos then
// if the turtle has moved, return both the stateChangedEvent and the movedEvent
// lifted into the common TurtleEvent type
[ StateChangedEvent stateChangedEvent; MovedEvent movedEvent]
else
// if the turtle has not moved, return just the stateChangedEvent
[ StateChangedEvent stateChangedEvent]
/// process a command
let commandHandler
(log:string -> unit)
(getEvents:GetStateChangedEventsForId)
(saveTurtleEvent:SaveTurtleEvent)
(command:TurtleCommand) =
/// First load all the events
let eventHistory =
getEvents command.turtleId
/// Then, recreate the state before the command
let stateBeforeCommand =
let historyLogger = ignore // no logging
eventHistory |> List.fold (applyEvent historyLogger) Turtle.initialTurtleState
/// Get the newest events from the command and the stateBeforeCommand
/// use the supplied logger for this bit
let events = eventsFromCommand log command stateBeforeCommand
// store the events
events |> List.iter (saveTurtleEvent command.turtleId)
// ====================================
// EventProcessors
// ====================================
module EventProcessors =
// filter to choose only TurtleEvents
let turtleFilter ev =
match box ev with
| :? TurtleEvent as tev -> Some tev
| _ -> None
// filter to choose only MovedEvents from TurtleEvents
let moveFilter = function
| MovedEvent ev -> Some ev
| _ -> None
// filter to choose only StateChangedEvent from TurtleEvents
let stateChangedEventFilter = function
| StateChangedEvent ev -> Some ev
| _ -> None
/// Physically move the turtle
let physicalTurtleProcessor (eventStream:IObservable<Guid*obj>) =
// the function that handles the input from the observable
let subscriberFn (ev:MovedEvent) =
let colorText =
match ev.penColor with
| Some color -> sprintf "line of color %A" color
| None -> "no line"
printfn "[turtle ]: Moved from (%0.2f,%0.2f) to (%0.2f,%0.2f) with %s"
ev.startPos.x ev.startPos.y ev.endPos.x ev.endPos.y colorText
// start with all events
eventStream
// filter the stream on just TurtleEvents
|> Observable.choose (function (id,ev) -> turtleFilter ev)
// filter on just MovedEvents
|> Observable.choose moveFilter
// handle these
|> Observable.subscribe subscriberFn
/// Draw lines on a graphics device
let graphicsProcessor (eventStream:IObservable<Guid*obj>) =
// the function that handles the input from the observable
let subscriberFn (ev:MovedEvent) =
match ev.penColor with
| Some color ->
printfn "[graphics]: Draw line from (%0.2f,%0.2f) to (%0.2f,%0.2f) with color %A"
ev.startPos.x ev.startPos.y ev.endPos.x ev.endPos.y color
| None ->
() // do nothing
// start with all events
eventStream
// filter the stream on just TurtleEvents
|> Observable.choose (function (id,ev) -> turtleFilter ev)
// filter on just MovedEvents
|> Observable.choose moveFilter
// handle these
|> Observable.subscribe subscriberFn
/// Listen for "moved" events and aggregate them to keep
/// track of the total ink used
let inkUsedProcessor (eventStream:IObservable<Guid*obj>) =
// Accumulate the total distance moved so far when a new event happens
let accumulate distanceSoFar (ev:StateChangedEvent) =
match ev with
| Moved dist ->
distanceSoFar + dist
| _ ->
distanceSoFar
// the function that handles the input from the observable
let subscriberFn distanceSoFar =
printfn "[ink used]: %0.2f" distanceSoFar
// start with all events
eventStream
// filter the stream on just TurtleEvents
|> Observable.choose (function (id,ev) -> turtleFilter ev)
// filter on just StateChangedEvent
|> Observable.choose stateChangedEventFilter
// accumulate total distance
|> Observable.scan accumulate 0.0
// handle these
|> Observable.subscribe subscriberFn
/// Listen for "moved" events and aggregate them to keep
/// track of the total distance moved
/// NEW! No duplicate events!
let inkUsedProcessorNoDups (eventStream:IObservable<Guid*obj>) =
// Accumulate the total distance moved so far when a new event happens
let accumulate (prevDist,currDist) (ev:StateChangedEvent) =
let newDist =
match ev with
| Moved dist ->
currDist + dist
| _ ->
currDist
(currDist, newDist)
// convert unchanged events to None so they can be filtered out with "choose"
let changedDistanceOnly (currDist, newDist) =
if currDist <> newDist then
Some newDist
else
None
// the function that handles the input from the observable
let subscriberFn distanceSoFar =
printfn "[ink used]: %0.2f" distanceSoFar
// start with all events
eventStream
// filter the stream on just TurtleEvents
|> Observable.choose (function (id,ev) -> turtleFilter ev)
// filter on just StateChangedEvent
|> Observable.choose stateChangedEventFilter
// NEW! accumulate total distance as pairs
|> Observable.scan accumulate (0.0,0.0)
// NEW! filter out when distance has not changed
|> Observable.choose changedDistanceOnly
// handle these
|> Observable.subscribe subscriberFn
// ====================================
// CommandHandlerClient
// ====================================
module CommandHandlerClient =
open CommandHandler
let eventStore = EventStore()
/// create a command handler
let makeCommandHandler =
let logger = ignore // no logging on write side now, only on read side
let getEvents id =
eventStore.Get<TurtleEvent>(id)
let getStateChangedEvents id =
getEvents id
|> List.choose (function StateChangedEvent ev -> Some ev | _ -> None)
let saveEvent id ev =
eventStore.Save(id,ev)
commandHandler logger getStateChangedEvents saveEvent
// Command versions of standard actions
let turtleId = System.Guid.NewGuid()
let move dist = {turtleId=turtleId; action=Move dist}
let turn angle = {turtleId=turtleId; action=Turn angle}
let penDown = {turtleId=turtleId; action=PenDown}
let penUp = {turtleId=turtleId; action=PenUp}
let setColor color = {turtleId=turtleId; action=SetColor color}
let drawTriangle() =
// clear older events
eventStore.Clear turtleId
// create an event stream from an IEvent
let eventStream = eventStore.SaveEvent :> IObservable<Guid*obj>
// register the processors
use physicalTurtleProcessor = EventProcessors.physicalTurtleProcessor eventStream
use graphicsProcessor = EventProcessors.graphicsProcessor eventStream
//use inkUsedProcessor= EventProcessors.inkUsedProcessor eventStream
use inkUsedProcessor = EventProcessors.inkUsedProcessorNoDups eventStream
let handler = makeCommandHandler
handler (move 100.0)
handler (turn 120.0<Degrees>)
handler (move 100.0)
handler (turn 120.0<Degrees>)
handler (move 100.0)
handler (turn 120.0<Degrees>)
let drawThreeLines() =
// clear older events
eventStore.Clear turtleId
// create an event stream from an IEvent
let eventStream = eventStore.SaveEvent :> IObservable<Guid*obj>
// register the processors
use physicalTurtleProcessor = EventProcessors.physicalTurtleProcessor eventStream
use graphicsProcessor = EventProcessors.graphicsProcessor eventStream
//use inkUsedProcessor= EventProcessors.inkUsedProcessor eventStream
use inkUsedProcessor = EventProcessors.inkUsedProcessorNoDups eventStream
let handler = makeCommandHandler
// draw black line
handler penDown
handler (setColor Black)
handler (move 100.0)
// move without drawing
handler (penUp)
handler (turn 90.0<Degrees>)
handler (move 100.0)
handler (turn 90.0<Degrees>)
// draw red line
handler penDown
handler (setColor Red)
handler (move 100.0)
// move without drawing
handler penUp
handler (turn 90.0<Degrees>)
handler (move 100.0)
handler (turn 90.0<Degrees>)
// back home at (0,0) with angle 0
// draw diagonal blue line
handler penDown
handler (setColor Blue)
handler (turn 45.0<Degrees>)
handler (move 100.0)
let drawPolygon n =
// clear older events
eventStore.Clear turtleId
// create an event stream from an IEvent
let eventStream = eventStore.SaveEvent :> IObservable<Guid*obj>
// register the processors
use physicalTurtleProcessor = EventProcessors.physicalTurtleProcessor eventStream
use graphicsProcessor = EventProcessors.graphicsProcessor eventStream
//use inkUsedProcessor= EventProcessors.inkUsedProcessor eventStream
use inkUsedProcessor = EventProcessors.inkUsedProcessorNoDups eventStream
let angle = 180.0 - (360.0/float n)
let angleDegrees = angle * 1.0<Degrees>
let handler = makeCommandHandler
// define a function that draws one side
let drawOneSide sideNumber =
handler (move 100.0)
handler (turn angleDegrees)
// repeat for all sides
for i in [1..n] do
drawOneSide i
// ======================================
// Tests
// ======================================
(*
CommandHandlerClient.drawTriangle()
CommandHandlerClient.drawThreeLines() // Doesn't go back home
CommandHandlerClient.drawPolygon 4
*)