Playing around with functional calisthenics and property-based testing on the Mars Rover kata

rover.fsx

type Direction = North | East |South | West
type Location = { x : int; y : int}
type Rover = { Location : Location; Direction : Direction}

let createRover location direction = {Location = location; Direction = direction}

type Command =
    | Forward
    | Backward
    | TurnLeft
    | TurnRight
type Instructions = Command seq

let moveForward rover =
    let newLocation = 
        match rover.Direction with
        | North -> { x = rover.Location.x; y = rover.Location.y + 1 }
        | East -> { x = rover.Location.x + 1; y = rover.Location.y }
        | South ->{ x = rover.Location.x; y = rover.Location.y - 1}
        | West -> { x = rover.Location.x - 1; y = rover.Location.y}
    { rover with Location = newLocation}

let moveBackward rover =
    let newLocation = 
        match rover.Direction with
        | North -> { x = rover.Location.x; y = rover.Location.y - 1 }
        | East -> { x = rover.Location.x - 1; y = rover.Location.y }
        | South ->{ x = rover.Location.x; y = rover.Location.y + 1}
        | West -> { x = rover.Location.x + 1; y = rover.Location.y}
    { rover with Location = newLocation}

let turnLeft rover =
    let newDirection = 
        match rover.Direction with
        | North -> West
        | East -> North
        | South -> East
        | West -> South
    {rover with Direction = newDirection}

let turnRight rover =
    let newDirection = 
        match rover.Direction with
        | North -> East
        | East -> South
        | South -> West
        | West -> North
    {rover with Direction = newDirection}

let move rover = 
    let moveRover command =
        match command with
        | Forward -> moveForward rover
        | Backward -> moveBackward rover
        | TurnLeft -> turnLeft rover
        | TurnRight -> turnRight rover
    moveRover

let executeInstructions rover =
    let execute instructions = 
        instructions
        |> Seq.fold move rover
    execute

let northFacingRover = createRover {x = 0; y = 0} North
(move northFacingRover Forward).Location = {x = 0; y = 1}
(move northFacingRover Backward).Location = {x = 0; y = -1}
(move northFacingRover TurnLeft).Direction = West
(move northFacingRover TurnRight).Direction = East

let startingRoverEast = createRover {x = 0; y = 0} East
(move startingRoverEast Forward).Location = {x = 1; y = 0}

executeInstructions northFacingRover [] = northFacingRover
executeInstructions northFacingRover [Forward; Backward] = northFacingRover
(executeInstructions northFacingRover [Forward;TurnRight;Backward]).Location = {x = -1; y = 1}
(executeInstructions northFacingRover [Forward;TurnRight;Backward]).Direction = East

#r @"..\packages\FsCheck.2.4.0\lib\net45\FsCheck.dll"
open FsCheck

let aCommandAlwaysChangesTheRover command rover = 
    executeInstructions rover [command] <> rover
Check.Quick aCommandAlwaysChangesTheRover

//Only need a subset/specific case of a union type? 
//Make a new type + custom arbitrary that only returns elements of the more narrow scope
type Turn = Command
type MyArbitraries =
    static member Turn() = 
        Arb.fromGen <| Gen.elements [TurnLeft; TurnRight]
Arb.register<MyArbitraries>()

//Arb.generate<Turn> |> Gen.sample -1 10

let aTurnDoesNotChangeTheRoverPosition rover (t : Turn) =
    (executeInstructions rover [t]).Location = rover.Location
Check.Quick aTurnDoesNotChangeTheRoverPosition

let fourIdenticalTurnsPutARoverInTheStartingOrientation rover (t : Turn) =
    let instructions = [t;t;t;t]
    (executeInstructions rover instructions).Direction = rover.Direction
Check.Quick fourIdenticalTurnsPutARoverInTheStartingOrientation

let theRoverCanHandleArbitraryPrograms rover (instructions : Command list) =
    executeInstructions rover instructions |> ignore
    true
Check.Quick theRoverCanHandleArbitraryPrograms