Skip to content

Instantly share code, notes, and snippets.

@nightroman
Last active July 14, 2017 17:50
Show Gist options
  • Save nightroman/fc0b67fd88be3caed6a423bac8fa6479 to your computer and use it in GitHub Desktop.
Save nightroman/fc0b67fd88be3caed6a423bac8fa6479 to your computer and use it in GitHub Desktop.
Turtle 16: Batch processing using command objects with responses

16: Batch processing using command objects with responses

The description is the same as the case 9 with the last disadvantage resolved. Namely

  • Only suitable when control flow is not based on the response from a previous command.
    • Case 16 solves this issue, commands have responses.

Below is the case 9 notes:

9: Batch processing using command objects

In this design, the client creates a list of Commands that will be intepreted later. These commands are then run in sequence using the Turtle library functions.

This approach means that there is no state that needs to be persisted between calls by the client.

Advantages

  • Simpler to construct and use than workflows or monads.
  • Only one function is coupled to a particular implementation. The rest of the client is decoupled.

Disadvantages

  • Batch oriented only.
  • Only suitable when control flow is not based on the response from a previous command.
    • Case 16 solves this issue, commands have responses.
(* ======================================
16-CommandsWithResponses.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 #16: Sequence processing using commands with responses
This design extends #9, the client generates commands that will be interpreted later.
These commands are then run in sequence using the Turtle library functions.
The difference from #9 is that command sequences depend on responses.
This approach means that there is no state that needs to be persisted between calls by the client.
Instead, commands request data for processing and branching the command sequence.
====================================== *)
#load "Common.fsx"
#load "FPTurtleLib2.fsx"
open Common
open FPTurtleLib2
// ======================================
// TurtleCommandHandler
// ======================================
module TurtleCommandHandler =
/// Function to log a message
let log message =
printfn "%s" message
// logged versions
let move = Turtle.move log
let turn = Turtle.turn log
let penDown = Turtle.penDown log
let penUp = Turtle.penUp log
let setColor = Turtle.setColor log
type TurtleCommand =
| Move of Distance * Turtle.MoveResponse ref
| Turn of Angle
| PenUp
| PenDown
| SetColor of PenColor * Turtle.SetColorResponse ref
// --------------------------------------
// The Command Handler
// --------------------------------------
/// Apply a command to the turtle state and return the new state
let applyCommand state command =
match command with
| Move (distance, r) ->
let res, state = move distance state
r := res
state
| Turn angle ->
turn angle state
| PenUp ->
penUp state
| PenDown ->
penDown state
| SetColor (color, r) ->
let res, state = setColor color state
r := res
state
/// Run sequence of commands
let run aSeqOfCommands =
aSeqOfCommands
|> Seq.fold applyCommand Turtle.initialTurtleState
// ======================================
// TurtleCommandClient
// ======================================
module TurtleCommandClient =
open TurtleCommandHandler
// create the fixed array of commands
let drawShape1() =
let r = ref Turtle.MoveOk
[|
Move (60.0, r)
Move (60.0, r)
Move (60.0, r)
|]
// create commands to move and handle the response
let moveWithResponse distance = seq {
let r = ref Turtle.MoveOk
yield Move (distance, r)
match !r with
| Turtle.MoveOk ->
()
| Turtle.HitABarrier ->
printfn "Oops -- hit a barrier -- turning"
yield Turn 90.0<Degrees>
}
// create commands to set a color and handle the response
let setColorWithResponse color = seq {
let r = ref Turtle.ColorOk
yield SetColor (color, r)
match !r with
| Turtle.ColorOk ->
()
| Turtle.OutOfInk ->
printfn "Oops -- out of ink -- using black"
yield SetColor (Black, r)
}
// compose the sequence of moves with responses
let drawShape2() = seq {
yield! moveWithResponse 60.0
yield! moveWithResponse 60.0
yield! moveWithResponse 60.0
}
// combine shapes with different colors
let drawShape3() = seq {
yield! setColorWithResponse Blue
yield! drawShape2()
yield! setColorWithResponse Red
yield! drawShape1()
}
// ======================================
// TurtleCommandClient Tests
// ======================================
// run program 1
TurtleCommandClient.drawShape1()
|> TurtleCommandHandler.run
// run program 2
TurtleCommandClient.drawShape2()
|> TurtleCommandHandler.run
// run combined program
TurtleCommandClient.drawShape3()
|> TurtleCommandHandler.run
(*
Common.fsx
Part of "Thirteen ways of looking at a turtle"
Related blog post: http://fsharpforfunandprofit.com/posts/13-ways-of-looking-at-a-turtle/
*)
open System
// ======================================
// Common types and helper functions
// ======================================
/// An alias for a float
type Distance = float
/// Use a unit of measure to make it clear that the angle is in degrees, not radians
type [<Measure>] Degrees
/// An alias for a float of Degrees
type Angle = float<Degrees>
/// Enumeration of available pen states
type PenState = Up | Down
/// Enumeration of available pen colors
type PenColor = Black | Red | Blue
/// A structure to store the (x,y) coordinates
type Position = {x:float; y:float}
// ======================================
// Common helper functions
// ======================================
// round a float to two places to make it easier to read
let round2 (flt:float) = Math.Round(flt,2)
/// calculate a new position from the current position given an angle and a distance
let calcNewPosition (distance:Distance) (angle:Angle) currentPos =
// Convert degrees to radians with 180.0 degrees = 1 pi radian
let angleInRads = angle * (Math.PI/180.0) * 1.0<1/Degrees>
// current pos
let x0 = currentPos.x
let y0 = currentPos.y
// new pos
let x1 = x0 + (distance * cos angleInRads)
let y1 = y0 + (distance * sin angleInRads)
// return a new Position
{x=round2 x1; y=round2 y1}
/// Default initial state
let initialPosition,initialColor,initialPenState =
{x=0.0; y=0.0}, Black, Down
/// Emulating a real implementation for drawing a line
let dummyDrawLine log oldPos newPos color =
// for now just log it
log (sprintf "...Draw line from (%0.1f,%0.1f) to (%0.1f,%0.1f) using %A" oldPos.x oldPos.y newPos.x newPos.y color)
/// trim a string
let trimString (str:string) = str.Trim()
// ======================================
// Result type and companion module
// ======================================
type Result<'a,'error> =
| Success of 'a
| Failure of 'error
module Result =
let returnR x =
Success x
let bindR f xR =
match xR with
| Success x -> f x
| Failure err -> Failure err
// infix version of bind
let ( >>= ) xR f =
bindR f xR
let mapR f =
bindR (f >> returnR)
// infix version of map
let ( <!> ) = mapR
let applyR fR xR =
fR >>= (fun f ->
xR >>= (fun x ->
returnR (f x) ))
// infix version of apply
let ( <*> ) = applyR
// lift a one-parameter function to result world (same as mapR)
let lift1R f x = f <!> x
// lift a two-parameter function to result world
let lift2R f x y = f <!> x <*> y
/// Computation Expression
type ResultBuilder() =
member this.Bind(m:Result<'a,'error>,f:'a -> Result<'b,'error>) =
bindR f m
member this.Return(x) :Result<'a,'error> =
returnR x
member this.ReturnFrom(m) :Result<'a,'error> =
m
member this.Zero() :Result<unit,'error> =
this.Return ()
member this.Combine(m1, f) =
this.Bind(m1, f)
member this.Delay(f) =
f
member this.Run(m) =
m()
member this.TryWith(m:Result<'a,'error>, h: exn -> Result<'a,'error>) =
try this.ReturnFrom(m)
with e -> h e
member this.TryFinally(m:Result<'a,'error>, compensation) =
try this.ReturnFrom(m)
finally compensation()
member this.Using(res:#IDisposable, body) : Result<'b,'error> =
this.TryFinally(body res, (fun () -> match res with null -> () | disp -> disp.Dispose()))
member this.While(cond, m) =
if not (cond()) then
this.Zero()
else
this.Bind(m(), fun _ -> this.While(cond, m))
member this.For(sequence:seq<_>, body) =
this.Using(sequence.GetEnumerator(),
(fun enum -> this.While(enum.MoveNext, fun _ -> body enum.Current)))
let result = ResultBuilder()
(* ======================================
FPTurtleLib2.fsx
Part of "Thirteen ways of looking at a turtle"
Related blog post: http://fsharpforfunandprofit.com/posts/13-ways-of-looking-at-a-turtle/
======================================
Common code for FP-style immutable turtle functions.
Unlike FPTurtleLib.fsx, the Move and SetColor functions return a response.
====================================== *)
// requires Common.fsx to be loaded by parent file
// Uncomment to use this file standalone
//#load "Common.fsx"
open System
open Common
// ======================================
// Turtle module
// ======================================
module Turtle =
type TurtleState = {
position : Position
angle : float<Degrees>
color : PenColor
penState : PenState
}
type MoveResponse =
| MoveOk
| HitABarrier
type SetColorResponse =
| ColorOk
| OutOfInk
let initialTurtleState = {
position = initialPosition
angle = 0.0<Degrees>
color = initialColor
penState = initialPenState
}
// if the position is outside the square (0,0,100,100)
// then constrain the position and return HitABarrier
let checkPosition position =
let isOutOfBounds p =
p > 100.0 || p < 0.0
let bringInsideBounds p =
max (min p 100.0) 0.0
if isOutOfBounds position.x || isOutOfBounds position.y then
let newPos = {
x = bringInsideBounds position.x
y = bringInsideBounds position.y }
HitABarrier,newPos
else
MoveOk,position
// note that state is LAST param in all these functions
let move log distance state =
log (sprintf "Move %0.1f" distance)
// calculate new position
let newPosition = calcNewPosition distance state.angle state.position
// adjust the new position if out of bounds
let moveResult, newPosition = checkPosition newPosition
// draw line if needed
if state.penState = Down then
dummyDrawLine log state.position newPosition state.color
// return the new state and the Move result
let newState = {state with position = newPosition}
(moveResult,newState)
let turn log angle state =
log (sprintf "Turn %0.1f" angle)
// calculate new angle
let newAngle = (state.angle + angle) % 360.0<Degrees>
// update the state
{state with angle = newAngle}
let penUp log state =
log "Pen up"
{state with penState = Up}
let penDown log state =
log "Pen down"
{state with penState = Down}
let setColor log color state =
let colorResult =
if color = Red then OutOfInk else ColorOk
log (sprintf "SetColor %A" color)
// return the new state and the SetColor result
let newState = {state with color = color}
(colorResult,newState)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment