Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
141 lines (110 sloc) 4.09 KB
(*
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()