Archive

Monthly Archives: August 2016

Intro

I have been trying to sustain my learning of the F# programming language.
It’s been both stressful and a thrill.

I recently attempted the following kata:

  Item   Unit      Special
         Price     Price
  --------------------------
    A     50       3 for 130
    B     30       2 for 45
    C     20
    D     15

Code

I learned some things as I performed this exercise. For example, I have learned that I could have a function with a descriptive name serve as an alias for another function. I also learned the value of attaching functions to record types.

The following code was generated when I attempted to practice this Kata in F#:

module Checkout

(*Types*)
type Type = A | B | C | D
type Total = { UnitPrice:int ; Qty:int }
             member x.Price() = x.UnitPrice * x.Qty
type Item =
    { Type:Type ; Total:Total

    } member x.SpecialPrice qty qtyPrice =
          if x.Total.Qty / qty > 0
          then (x.Total.Qty / qty) * qtyPrice + (x.Total.Qty % qty) * x.Total.UnitPrice
          else x.Total.Price()

      member x.Price() =
        match x.Type with
        | A -> x.SpecialPrice 3 130
        | B -> x.SpecialPrice 2 45
        | _ -> x.Total.Price()

(*Functions*)
let private getTypeQty = List.sumBy(fun x -> x.Total.Qty)

let private consolidate consolidated (group:Item seq) =

    let qtyOf = List.ofSeq >> getTypeQty
    let first = group |> List.ofSeq |> List.head
    { Type    =  first.Type;
      Total   = { Qty= qtyOf group; UnitPrice= first.Total.UnitPrice }}
                :: consolidated
(*Tests*)
open FsUnit
open NUnit.Framework

[<Test>]
let ``buying (2) A units, (1) B unit, (1) A unit = $160`` () =

    // Setup
    let a2 = { Type=A; Total={UnitPrice=50; Qty=2} }
    let b =  { Type=B; Total={UnitPrice=30; Qty=1} }
    let a =  { Type=A; Total={UnitPrice=50; Qty=1} }

    seq [a2; b; a] |> Seq.groupBy (fun item -> item.Type)
                   |> List.ofSeq
                   |> List.map snd
                   |> List.fold consolidate []
                   |> List.sumBy (fun item -> item.Price())
                   |> should equal 160

Conclusion

This Kata resulted in me learning how to attach functions to records in F#. I think it’s better for a record to have an attached function to process its data than an external function. Hence, I think some things are better coupled.

Intro

As I learn F#, I am also learning an alternative technique for proving code. Specifically, I am learning how to abstract away example-based tests into property-based tests. On this journey, I was surprised to realize that despite the unit tests that I wrote to bulletproof my functions, my functions still had bugs in them based on various edge cases that I never considered. Thus, I learned that bullet-proofing my code with example-based cases just wasn’t enough. I needed to bombproof my code!

Bombproof a Function

I relate a suite of unit tests qualifying a function to the metaphor of bulletproofing a vehicle. However, based on my current journey within functional programming, I now relate property-based tests with affiliated unit tests as a technique for bombproofing a function.

A bomb might be viewed as a single unit of force. However, the carnage that results from a bomb is really from the shrapnel that’s projected at high rates of speed in all directions. Thus, the shrapnel generated from the force of a blast behaves like a myriad of bullets without a direction. In other words, bullets are fired typically in one direction at an intended target. Whereas a bomb destroys indiscriminately. For more details, the science of a bomb blast can be found here. As stated earlier, the common result of a bomb blast is collateral damage. Which is essentially damage inflicted on unintended targets. Hmmm… That sounds a lot like buggy code that has cascading effects on a complex system. Even though this analogy is a bit warped, my goal is to provide the software community with an analogy that helped me appreciate the value of property-based testing. In other words, I value property-based testing as tool for protection against the unintended use of a function which could otherwise inflict severe damage to a system.

Defining Response Types

I recently wrote a checkers game in F# so that I can better understand functional concepts for not only building software but also testing it as I build.
Here’s the types that support the Checkers game I wrote:

(* Types *)
type Black = BlackKing | BlackSoldier
type Red =   RedKing   | RedSoldier
 
type Coordinate = int * int
 
type Piece =
    | Black of Black * Coordinat

 
type OptionsResponse =
    | DuplicatesNotAllowed of Space list
    | Succeeded            of Coordinate list
 
type MoveResponse =
    | DuplicatesNotAllowed of Space list * Status
    | MoveNotAllowed       of Space list * Status
    | DestinationNotFound  of Space list * Status
    | Succeeded            of Space list * Status

If you notice in the types defined above, I have defined two Response types. Specifically, I implemented an OptionsResponse and a MoveResponse. The OptionsResponse type is for conveying the move options that a checker has based on its position on the checker board. The MoveResponse type conveys the updated checker board after a move was performed. Note my incomplete description of these two discriminated union types. Hence, what I did not convey in the two types defined above are the values that represent the reasons why a valid result couldn’t be provided. Hence, both discriminated union types have a case value for duplicates being discovered that would ultimately prevent the function from returning a “Succeeded” case value. However, the MoveResponse also defines a MoveNotAllowed as well as a DestinationNotFound case value.

Identifying Case Values for a Response

In the previous section, I identified the response types that would be used as a function result for identifying move options for a checker and moving it. However, those response types did not stem from BUFD (aka: Big Upfront Design) or even TDD (Test-driven Development). No. Those types were flushed out as a result of running Property-based tests.

Property-based Tests

Property-based testing is a technique used to generate a multitude of test scenarios in an effort to prove that a function has certain properties about it. Thus, I view property-based testing as an indirect technique for generating edge cases for the testing of a given function.

Revisiting Checkers

I incorporated property-based testing into the Checkers Kata that I have been working on.
Here’s an example of a property-based test that I wrote:

[<Run100K>]
let ``options for soldier can never exceed 2`` () =
 
    // Setup
    let pieceGenerator =     Arb.generate<Piece> |> Gen.filter (isKing >> not)
    let positionsGenerator = Arb.generate<Space list>
 
    // Test
    (pieceGenerator , positionsGenerator) 
    ||> Gen.map2 (fun x y -> x , y |> Seq.distinct 
                                   |> Seq.toList)
     |> Arb.fromGen
     |> Prop.forAll 
     <| fun (piece , positions) ->
             positions |> optionsFor piece
                       |> fromOptions
                       |> List.length <= 2

The test above targets the optionsFor function. This function under test has the responsibility of identifying the move options for a given checker. The property test for this function tests that a checker whose type is Soldier can never have more than 2 options for moving.
The optionsFor function is below:

let optionsFor piece positions =
 
    if duplicatesIn positions
    then OptionsResponse.DuplicatesNotAllowed positions
    else match piece |> isKing with
         | false -> let options = positions |> availablePositions 
                                            |> List.filter (optionsForSoldier piece)
                    OptionsResponse.Succeeded options
                    
         | true  -> let options = positions |> availablePositions 
                                            |> List.filter (optionsForKing piece)
                    OptionsResponse.Succeeded options

Notice the following line:

    if duplicatesIn positions
    then OptionsResponse.DuplicatesNotAllowed positions
 

This condition was added into the optionsFor function after my property test for it failed. The test failed because duplicate entries were found in the positions parameter of the function. As I observed this failure, I recognized that I still needed to return a result regardless of invalid arguments being provided. Thus, that’s when I realized that a discriminated union could be leveraged to identify the response types mentioned earlier.

Here are the property tests that I wrote for the checkers game:

open FsCheck
open FsCheck.Xunit
 
type Run100KAttribute() =
    inherit PropertyAttribute(
        MaxTest = 100000,
        QuietOnSuccess = true)
 
[<Run100K>]
let ``options for soldier can never exceed 2`` () =
 
    // Setup
    let pieceGenerator =     Arb.generate<Piece> |> Gen.filter (isKing >> not)
    let positionsGenerator = Arb.generate<Space list>
 
    // Test
    (pieceGenerator , positionsGenerator) 
    ||> Gen.map2 (fun x y -> x , y |> Seq.distinct 
                                   |> Seq.toList)
     |> Arb.fromGen
     |> Prop.forAll 
     <| fun (piece , positions) ->
             positions |> optionsFor piece
                       |> fromOptions
                       |> List.length <= 2
     
[<Run100K>]
let ``options for king can never exceed 4`` () =
 
    // Setup
    let pieceGenerator =     Arb.generate<Piece> |> Gen.filter isKing
    let positionsGenerator = Arb.generate<Space list>
 
    // Test
    (pieceGenerator , positionsGenerator) 
    ||> Gen.map2 (fun x y -> x , Seq.distinct y 
                                 |> Seq.toList)
                 |> Arb.fromGen
                 |> Prop.forAll 
                 <| fun (piece , positions) ->
                         positions |> optionsFor piece
                                   |> fromOptions
                                   |> List.length <= 4
 
[<Run100K>]
let ``moving checker retains distinct element count`` () =
 
    // Setup
    gen { let! piece =          Arb.generate<Piece> 
          let! destination =    Arb.generate<Space>
          let! otherPositions = Arb.generate<Space list> // Used to ensure inclusion of piece & destination
          let! positions =      Occupied piece::destination::otherPositions |> Gen.shuffle
          let! status =         Arb.generate<Status>
          
          return piece , destination , positions
                                       |> Seq.distinct
                                       |> Seq.toList , status 
        } |> Arb.fromGen
 
    // Test
    |> Prop.forAll 
    <| fun (piece , destination , positions , status) -> 
           (positions , status) |> move piece destination
                                |> fromMove
                                |> List.length = positions.Length
 
[<Run100K>]
let ``attempted checker jump results in zero or one distinct checkers removed`` () =
 
    // Setup
    gen { let! source =          Arb.generate<Piece>
          let! target =          Arb.generate<Piece>
          let! otherPositions =  Arb.generate<Space list>
          let! positions =       Occupied source :: Occupied target
                                                 :: otherPositions 
                                                 |> Gen.shuffle
 
          let tryAddDistinct (map:Map<Coordinate,Space>) s = 
              match tryGetCoordinate s with
              | Some xy -> match map.TryFind xy with
                           | Some pos -> map
                           | None     -> map.Add(xy,s)
              | None    -> map
 
          let distinct = (Map [], positions |> List.ofArray) 
                                            ||> List.fold tryAddDistinct
                                            |> Map.toList
                                            |> List.map snd
          return source , target , distinct 
        } |> Arb.fromGen
 
    // Test
    |> Prop.forAll 
    <| fun (source , target, positions) ->
 
           let gameStatus = positions , statusOf source
 
           (gameStatus , source) ||> jump target
                                  |> fromMove
                                  |> (fun l -> l.Length = positions.Length  ||
                                               l.Length = positions.Length - 1)

The workflow of a Property-based Test

1. Setup
a. Create a generator:

let pieceGenerator =     Arb.generate<Piece> |> Gen.filter (isKing >> not)
let positionsGenerator = Arb.generate<Space list>

b. Generate a value:

(pieceGenerator , positionsGenerator) 
||> Gen.map2 (fun x y -> x , y |> Seq.distinct // Create a tuple via Gen.map to host our argument types
        |> Seq.toList)

2. Test
a. Use the value to test the function:

|> Arb.fromGen
|> Prop.forAll 
<| fun (piece , positions) ->
        positions |> optionsFor piece

3. Verify
a. Verify the result of the function maintains the expected property:

|> fromOptions
|> List.length <= 2

Here’s the complete test:

open FsCheck
open FsCheck.Xunit
 
type Run100KAttribute() =
    inherit PropertyAttribute(
        MaxTest = 100000,
        QuietOnSuccess = true)
 
[<Run100K>]
let ``options for soldier can never exceed 2`` () =
 
    // Setup
    let pieceGenerator =     Arb.generate<Piece> |> Gen.filter (isKing >> not)
    let positionsGenerator = Arb.generate<Space list>
 
    // Test
    (pieceGenerator , positionsGenerator) 
    ||> Gen.map2 (fun x y -> x , y |> Seq.distinct // Create a tuple via Gen.map to host are argument types
                                   |> Seq.toList)
     |> Arb.fromGen
     |> Prop.forAll 
     <| fun (piece , positions) ->
             positions |> optionsFor piece
                       |> fromOptions
                       |> List.length <= 2

Creating Unit Tests from Property-based Tests

As I ran my property-based tests and observed failures, I realized that I needed to investigate why these properties were not being upheld for certain inputs. This resulted in me taking the inputs identified from the failed scenario and writing a new unit test to better understand the failure. Thankfully, FsCheck shrinks the data used in a failed test scenario to a more manageable size so that it can be used to diagnose the anomaly. The unit tests that are written as a result of failed property tests can then be incorporated into the regression suite of tests for continuous integration.

Conclusion

In conclusion, as I learn F#, I am also learning an alternative technique for proving code. Specifically, I am learning how to abstract away example-based tests into property-based tests. On this journey, I was surprised to realize that despite the unit tests that I wrote to bulletproof my functions, my functions still had bugs in them based on various edge cases that I never considered. Thus, I learned that bullet-proofing my code with example-based cases just wasn’t enough. I needed to bombproof my code with property-based tests. Thus, when I incorporated property-based tests into my arsenal of craftsmanship tools, I soon realized that property-based tests actually identify edge cases that can be added to a unit test suite for regression tests.

Appendix

The following sections reflect the actual code that was written as I performed this kata.

Domain

(* Types *)
type Black = BlackKing | BlackSoldier
type Red =   RedKing   | RedSoldier
 
type Coordinate = int * int
 
type Piece =
    | Black of Black * Coordinate
    | Red   of Red   * Coordinate
 
type Space =
    | Occupied  of Piece
    | Available of Coordinate
 
type Status =
    | BlacksTurn | RedsTurn
    | BlackWins  | RedWins
 
type OptionsResponse =
    | NoDuplicatesAllowed of Space list
    | Succeeded            of Coordinate list
 
type MoveResponse =
    | DuplicatesNotAllowed of Space list * Status
    | MoveNotAllowed       of Space list * Status
    | DestinationNotFound  of Space list * Status
    | Succeeded            of Space list * Status
 
(* Private *)
let private black coordinate = Occupied (Black (BlackSoldier , coordinate))
let private red   coordinate = Occupied (Red   (RedSoldier   , coordinate))
 
let private yDirection = function
    | Black _ -> -1
    | Red   _ ->  1
 
let private toAvailable = function
    | Available pos -> true
    | _             -> false
 
let private available positions = positions |> List.filter toAvailable
 
let private availableSelection = function
    | Available pos -> Some pos
    | Occupied _   -> None
 
let private availablePositions positions = 
    positions |> List.filter toAvailable
              |> List.choose availableSelection
 
let private tryGetCoordinate = function
    | Available xy -> Some xy
    | _            -> None
 
let private coordinateOf = function
    | Black (checker , pos) -> pos
    | Red   (checker , pos) -> pos
 
let private optionsForSoldier piece = 
 
    let (sourceX , sourceY) = coordinateOf piece
 
    (fun pos -> pos = ((sourceX - 1) , (sourceY + (piece |> yDirection) )) ||
                pos = ((sourceX + 1) , (sourceY + (piece |> yDirection) )))
 
let private optionsForKing piece = 
 
    let (sourceX , sourceY) = coordinateOf piece
 
    (fun pos -> pos = ((sourceX - 1) , (sourceY + 1 )) ||
                pos = ((sourceX + 1) , (sourceY + 1 )) ||
                pos = ((sourceX - 1) , (sourceY - 1 )) ||
                pos = ((sourceX + 1) , (sourceY - 1 )))
 
let private jumpOptions (sourceX , sourceY) space =
    match space with
    | Occupied p -> match p with
                     | Red   (ch,xy) -> xy = (sourceX + 1, sourceY - 1) ||
                                        xy = (sourceX - 1, sourceY - 1)
    
                     | Black (ch,xy) -> xy = (sourceX + 1, sourceY + 1) ||
                                        xy = (sourceX - 1, sourceY + 1)
    | _ -> false
 
let private jumpsForSoldier piece positions =
    match piece with
    | Black (ch,pos) -> positions |> List.filter (jumpOptions (coordinateOf piece))
    | Red   (ch,pos) -> positions |> List.filter (jumpOptions (coordinateOf piece))
 
let private isKing piece = 
    match piece with
    | Black (checker , _) -> match checker with
                             | BlackSoldier -> false
                             | BlackKing    -> true
 
    | Red   (checker , _) -> match checker with
                             | RedSoldier   -> false
                             | RedKing      -> true
 
let private filterOut a b positions =
    positions |> List.filter(fun x -> x <> a && x <> b)
 
let private movePiece destination positions piece =
 
    let destinationXY = 
        match destination with
        | Available xy -> xy
        | Occupied p  -> coordinateOf p
 
    let yValueMin , yValueMax = 0 , 7
 
    let canCrown =
        let yValue = snd destinationXY
        (yValue = yValueMin || 
         yValue = yValueMax) && 
         not (isKing piece)
 
    match positions |> List.find (fun space -> space = Occupied piece) with
    | Occupied (Black (ch, xy)) -> 
        let checkerType = if canCrown && not (isKing piece) then BlackKing else ch
        Available(xy) :: (Occupied(Black(checkerType, destinationXY)))
                      :: (positions |> filterOut (Occupied (Black(ch, xy))) destination)     
        
    | Occupied (Red   (ch, xy)) -> 
        let checkerType = if canCrown && not (isKing piece) then RedKing else ch
        Available(xy) :: (Occupied(Red(checkerType, destinationXY)))
                      :: (positions |> filterOut (Occupied (Red(ch, xy))) destination) 
    | _ -> positions
 
let private update = function
    | BlacksTurn -> RedsTurn
    | RedsTurn   -> BlacksTurn
    | BlackWins  -> BlackWins
    | RedWins    -> RedWins
 
let private statusOf = function
    | Black _ -> BlacksTurn
    | Red   _ -> RedsTurn
 
let private duplicatesIn positions = 
    positions |> Seq.countBy id
              |> Seq.map snd
              |> Seq.exists (fun count -> count > 1)
 
let private getTurn (positions , status) = status
 
(* Public *)
let startGame () =
    [ red (0,0);  red (2,0);  red (4,0);  red (6,0)
      red (1,1);  red (3,1);  red (5,1);  red (7,1)
      red (0,2);  red (2,2);  red (4,2);  red (6,2)
      
      Available (1,3); Available (3,3); Available (5,3); Available (7,3)
      Available (0,4); Available (2,4); Available (4,4); Available (6,4)
      
      black (1,5);  black (3,5);  black (5,5);  black (7,5)
      black (0,6);  black (2,6);  black (4,6);  black (6,6)
      black (1,7);  black (3,7);  black (5,7);  black (7,7) ] , BlacksTurn
 
let fromMove = function
    | Succeeded            (positions, status)
    | DuplicatesNotAllowed (positions, status)  
    | MoveNotAllowed       (positions, status) 
    | DestinationNotFound  (positions, status) -> positions
 
let fromOptions = function
    | OptionsResponse.Succeeded            coordinates -> coordinates
    | OptionsResponse.NoDuplicatesAllowed positions   -> 
        positions |> List.map (fun pos -> match pos with
                                          | Available xy -> xy
                                          | Occupied p   -> coordinateOf p)
 
let optionsFor piece positions =
 
    if duplicatesIn positions
    then OptionsResponse.NoDuplicatesAllowed positions
    else match piece |> isKing with
         | false -> let options = positions |> availablePositions 
                                            |> List.filter (optionsForSoldier piece)
                    OptionsResponse.Succeeded options
                    
         | true  -> let options = positions |> availablePositions 
                                            |> List.filter (optionsForKing piece)
                    OptionsResponse.Succeeded options
 
let move piece destination (positions,status) =
 
    if duplicatesIn positions
    then DuplicatesNotAllowed (positions,status)
    else let canProceed =  match piece with
                           | Red   _ -> update status = RedsTurn  
                           | Black _ -> update status = BlacksTurn
 
         if not canProceed 
         then MoveNotAllowed (positions , update status)
 
         else match optionsFor piece positions with
              | OptionsResponse.NoDuplicatesAllowed spaces -> DuplicatesNotAllowed (spaces,status)
              | OptionsResponse.Succeeded coordinates       -> 
                 let canMoveTo = (fun target -> coordinates |> List.exists (fun xy -> xy = target))
                 
                 match tryGetCoordinate destination with
                 | Some target -> if canMoveTo target then
                                     let updatedBoard = ((positions , piece) ||> movePiece destination)
                                     Succeeded (updatedBoard , update status)
              
                                  else MoveNotAllowed (positions , update status)
         
                 | None -> DestinationNotFound (positions , update status)
 
let jump target (positions,status) source =
 
    let jumpsExist = 
        positions |> jumpsForSoldier source
                  |> List.exists (fun s -> 
                    match s with
                    | Occupied target -> true
                    | _               -> false)
 
    let (|NorthEast|NorthWest|SouthEast|SouthWest|Origin|) (origin , barrier) =
        
        let (sourceX  , sourceY) =  origin
        let (barrierX , barrierY) = barrier
 
        if   barrierY = sourceY + 1 &&
             barrierX = sourceX - 1
        then SouthWest
 
        elif barrierY = sourceY + 1 &&
             barrierX = sourceX + 1 
        then SouthEast
 
        elif barrierY = sourceY - 1 &&
             barrierX = sourceX - 1
        then NorthWest
 
        elif barrierY = sourceY - 1 &&
             barrierX = sourceX + 1
        then NorthEast
 
        else Origin
 
    let jumpToPostion origin barrier =
 
        let (sourceX  , sourceY) =  origin
        let (barrierX , barrierY) = barrier
 
        match (origin , barrier) with
        | SouthWest -> (barrierX + 1, barrierY - 1)
        | SouthEast -> (barrierX + 1, barrierY + 1)
        | NorthWest -> (barrierX - 1, barrierY - 1)
        | NorthEast -> (barrierX - 1, barrierY + 1)
        | Origin    -> origin
 
    let isSameCoordinate source target = 
        coordinateOf source = coordinateOf target
 
    if jumpsExist && not (isSameCoordinate source target) then
             let destination = Available (jumpToPostion (coordinateOf source) (coordinateOf target))
             let result = (positions, source) ||> movePiece destination
                                               |> List.filter (fun s -> s <> Occupied target)
 
             Succeeded (Available (coordinateOf target)::result , update status)
 
    else MoveNotAllowed (positions,status)

Unit Tests

(* Tests *)
open NUnit.Framework
open FsUnit
 
let exists expected = fromMove >> List.exists (fun s -> s = expected)
 
[<Test>]
let ``black goes first`` () =
    startGame () |> getTurn
                 |> should equal BlacksTurn
[<Test>]
let ``get available positions`` () =
    startGame () |> fst
                 |> available
                 |> List.length 
                 |> should equal 8
[<Test>]
let ``get available positions for black soldier`` () =
    // Setup
    let piece = Black ( BlackSoldier , (1,5) )
 
    // Test
    let available = startGame () |> fst |> optionsFor piece
    // Verify
    match available with
    | OptionsResponse.Succeeded coordinates ->
        let northWestAvailable = coordinates |> List.exists (fun pos -> pos = (0,4))
        let northEastAvailable = coordinates |> List.exists (fun pos -> pos = (2,4))
 
        (northWestAvailable && northEastAvailable) |> should equal true
 
    | _ -> failwith "Failed to get options"
[<Test>]
let ``get available positions for red soldier`` () =
    // Setup
    let piece = Red ( RedSoldier , (0,2) )
 
    // Test
    startGame () |> fst
                 |> optionsFor piece
                 |> fromOptions
                 |> List.exists (fun pos -> pos = (1,3))
                 |> should equal true
[<Test>]
let ``get available positions for red king`` () =
    // Setup
    let piece = Red ( RedKing , (2,4) )
    let positions = [Available (0,2);  Available (2,2);  Available (4,2);  Available (6,2)
      
                     Available (1,3);  Available (3,3);  Available (5,3);  Available (7,3)
                     Available (0,4);  Occupied piece;  Available (4,4);  Available (6,4)
      
                     Available (1,5);  Available (3,5);  Available (5,5);  Available (7,5)]
 
    // Test
    positions |> optionsFor piece
              |> fromOptions
              |> List.length
              |> should equal 4
[<Test>]
let ``move red soldier`` () =
 
    let piece = Red ( RedSoldier , (0,2) )
    let destination = Available (1,3)
 
    // Test
    startGame () |> move piece destination
                 |> exists (Occupied (Red (RedSoldier , (1,3) )))
                 |> should equal true
[<Test>]
let ``moving red soldier leaves space available`` () =
 
    let piece = Red ( RedSoldier , (0,2) )
    let destination = Available (1,3)
 
    // Test
    startGame () |> move piece destination
                 |> exists (Available (0,2))
                 |> should equal true
[<Test>]
let ``moving red soldier maintains piece count`` () =
 
    let piece = Red ( RedSoldier , (0,2) )
    let destination = Available (1,3)
 
    // Test
    startGame () |> move piece destination
                 |> fromMove
                 |> List.length
                 |> should equal 32
[<Test>]
let ``get jump options for red soldier`` () =
 
    let redPiece =   Red   ( RedSoldier , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let positions = [Occupied redPiece; Occupied blackPiece]
 
    // Test
    positions |> jumpsForSoldier redPiece
              |> should equal [Occupied blackPiece]
[<Test>]
let ``red soldier gets new destination when it jumps black soldier`` () =
 
    let redPiece =   Red   ( RedSoldier , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let expected = Occupied (Red (RedSoldier , (2,4)))
    let positions = [Occupied redPiece; Occupied blackPiece; Available (2,4)]
    let gameState = positions , RedsTurn
 
    // Test
    (gameState,redPiece) ||> jump blackPiece
                          |> exists expected
                          |> should equal true
[<Test>]
let ``black soldier gets new destination when it jumps red soldier`` () =
 
    let redPiece =   Red   ( RedSoldier   , (2,2) )
    let blackPiece = Black ( BlackSoldier , (3,3) )
    let expected =   Occupied (Black ( BlackSoldier , (1,1) ))
    let positions =  [Occupied redPiece; Occupied blackPiece; Available (1,1)]
    let gameState = (positions,BlacksTurn)
 
    // Test
    (gameState, blackPiece) ||> jump redPiece
                             |> exists expected
                             |> should equal true
[<Test>]
let ``black soldier removed after being jumped by red soldier`` () =
 
    let redPiece =   Red   ( RedSoldier , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let expected =   Available (1,3)
    let positions =  [Occupied redPiece; Occupied blackPiece]
    let gameState = (positions,RedsTurn)
 
    // Test
    (gameState , redPiece) ||> jump blackPiece
                           |> exists expected
                           |> should equal true
[<Test>]
let ``red soldier removed after being jumped by black soldier`` () =
 
    let redPiece =   Red   ( RedSoldier   , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let expected =   Available (0,2)
    let positions =  [Occupied redPiece; Occupied blackPiece; expected]
    let gameState = positions , BlacksTurn
 
    // Test
    (gameState, blackPiece) ||> jump redPiece
                             |> exists expected
                             |> should equal true
[<Test>]
let ``movng black soldier to endzone makes king`` () =
    
    let piece = Black ( BlackSoldier , (1,1) )
    let destinationCoordinate = (0,0)
    let destination = Available destinationCoordinate
    let positions = [destination; Occupied piece]
    let expected = Occupied (Black (BlackKing , destinationCoordinate))
 
    // Test
    (positions, RedsTurn) |> move piece destination
                          |> exists expected
                          |> should equal true          
[<Test>]
let ``movng red soldier to endzone makes king`` () =
 
    let piece = Red ( RedSoldier , (6,6) )
    let destinationCoordinate = (7,7)
    let destination = Available destinationCoordinate
    let positions = [destination; Occupied piece]
    let expected = Occupied (Red (RedKing , destinationCoordinate))
 
    // Test
    (positions, BlacksTurn) |> move piece destination
                            |> exists expected
                            |> should equal true
[<Test>]
let ``can't move red twice in a row`` () =
    let piece = Red(RedSoldier , (0,2))
    let destination = Available (1,3)
 
    // Test
    let set1 = startGame() |> move piece destination
    let set2 = ((fromMove set1) , BlacksTurn) |> move piece destination
                    
    set2 |> fromMove
         |> should equal (set1 |> fromMove)

Property Tests

open FsCheck
open FsCheck.Xunit
 
type Run100KAttribute() =
    inherit PropertyAttribute(
        MaxTest = 100,
        QuietOnSuccess = true)
 
[<Run100K>]
let ``options for soldier can never exceed 2`` () =
 
    // Setup
    let pieceGenerator =     Arb.generate<Piece> |> Gen.filter (isKing >> not)
    let positionsGenerator = Arb.generate<Space list>
 
    // Test
    (pieceGenerator , positionsGenerator) 
    ||> Gen.map2 (fun x y -> x , y |> Seq.distinct 
                                   |> Seq.toList)
     |> Arb.fromGen
     |> Prop.forAll 
     <| fun (piece , positions) ->
             positions |> optionsFor piece
                       |> fromOptions
                       |> List.length <= 2
     
[<Run100K>]
let ``options for king can never exceed 4`` () =
 
    // Setup
    let pieceGenerator =     Arb.generate<Piece> |> Gen.filter isKing
    let positionsGenerator = Arb.generate<Space list>
 
    // Test
    (pieceGenerator , positionsGenerator) 
    ||> Gen.map2 (fun x y -> x , Seq.distinct y 
                                 |> Seq.toList)
                 |> Arb.fromGen
                 |> Prop.forAll 
                 <| fun (piece , positions) ->
                         positions |> optionsFor piece
                                   |> fromOptions
                                   |> List.length <= 4
 
[<Run100K>]
let ``moving checker retains distinct element count`` () =
 
    // Setup
    gen { let! piece =          Arb.generate<Piece> 
          let! destination =    Arb.generate<Space>
          let! otherPositions = Arb.generate<Space list> // Used to ensure inclusion of piece & destination
          let! positions =      Occupied piece::destination::otherPositions |> Gen.shuffle
          let! status =         Arb.generate<Status>
          
          return piece , destination , positions
                                       |> Seq.distinct
                                       |> Seq.toList , status 
        } |> Arb.fromGen
 
    // Test
    |> Prop.forAll 
    <| fun (piece , destination , positions , status) -> 
           (positions , status) |> move piece destination
                                |> fromMove
                                |> List.length = positions.Length
 
[<Run100K>]
let ``attempted checker jump results in zero or one distinct checkers removed`` () =
 
    // Setup
    gen { let! source =          Arb.generate<Piece>
          let! target =          Arb.generate<Piece>
          let! otherPositions =  Arb.generate<Space list>
          let! positions =       Occupied source :: Occupied target
                                                 :: otherPositions 
                                                 |> Gen.shuffle
 
          let tryAddDistinct (map:Map<Coordinate,Space>) s = 
              match tryGetCoordinate s with
              | Some xy -> match map.TryFind xy with
                           | Some pos -> map
                           | None     -> map.Add(xy,s)
              | None    -> map
 
          let distinct = (Map [], positions |> List.ofArray) 
                                            ||> List.fold tryAddDistinct
                                            |> Map.toList
                                            |> List.map snd
          return source , target , distinct 
        } |> Arb.fromGen
 
    // Test
    |> Prop.forAll 
    <| fun (source , target, positions) ->
 
           let gameStatus = positions , statusOf source
 
           (gameStatus , source) ||> jump target
                                  |> fromMove
                                  |> (fun l -> l.Length = positions.Length  ||
                                               l.Length = positions.Length - 1)

Intro

I have been going full throttle in my journey to learn F#. My latest focus was to implement a checkers game.

My Initial Attempt

My first attempt failed miserably. I was trying very hard to “make illegal states unrepresentable” by attempting to leverage the type system. However, I found myself duplicating code almost everywhere just to satisfy that goal. Ultimately, I scrapped my initial approach and started over.

Here were the types I used to model the domain:

(* Types *)
type BlackOption = NorthEast | NorthWest
type RedOption =   SouthEast | SouthWest

type KingOption = 
    | NorthEast 
    | NorthWest
    | SouthEast 
    | SouthWest

type Position =     { X:int; Y:int }

type BlackChecker = Position
type RedChecker =   Position
type BlackKing =    Position
type RedKing =      Position

type King = 
    | BlackKing of BlackKing
    | RedKing   of RedKing

type RedPiece = 
    | RedChecker of RedChecker 
    | RedKing    of RedKing

type BlackPiece = 
    | BlackChecker of BlackChecker 
    | BlackKing    of BlackKing

One mistake that I identified above was my overuse of types. In my case, I was trying to use types to model directions which made my code way more complicated than it needed to be. I think moving forward, I will just create types to model first-class entities of a domain.

Here’s the business logic that I flushed out using TDD

(* Private *)
let private remove item list = list |> List.filter (fun x -> x <> item)

let private setRowPosition y1 y2 y3 index =
    match index with 
    | x when x < 4 -> { X=x; Y=y1 }
    | x when x < 8 -> { X=x-4; Y=y2 }
    | _            -> { X=index-8; Y=y3 }

let private set (x, y) positions (position:Position) =
    match not (positions |> List.exists (fun pos -> pos = { X=x; Y=y })) with
    | true -> { X=x; Y=y }
    | false -> position

let private attemptJump target yDirection source =
    let updateX value = { X=target.X + value
                          Y=target.Y + yDirection }
    match source with
    | position when position.Y + yDirection = target.Y &&
                    position.X + 1 = target.X -> updateX 1

    | position when position.Y + yDirection = target.Y &&
                    position.X - 1 = target.X -> updateX -1
    | _ -> source

let private initializeBlack () =
    let setPosition index =
        index |> setRowPosition 7 6 5

    let blackCheckers = List.init 12 setPosition |> List.map (fun pos -> { X=pos.X; Y=pos.Y })
    blackCheckers

let private initializeRed () =
    let setPosition index =
        index |> setRowPosition 0 1 2

    let redCheckers =   List.init 12 setPosition |> List.map (fun pos -> { X=pos.X; Y=pos.Y })
    redCheckers

(* Exposed *)
let moveBlack direction positions (checker:BlackChecker) =
    let position = checker

    match direction with
    | BlackOption.NorthEast -> (positions, position) ||> set ((position.X + 1), (position.Y + 1 ))
    | BlackOption.NorthWest -> (positions, position) ||> set ((position.X - 1), (position.Y + 1 ))

let moveRed direction positions (checker:RedChecker) =
    let position = checker

    match direction with
    | RedOption.SouthEast -> (positions, position) ||> set ((position.X + 1), (position.Y - 1 ))
    | RedOption.SouthWest -> (positions, position) ||> set ((position.X - 1), (position.Y - 1 ))

let moveKing direction positions (king:King) =

    let position = match king with
                   | King.BlackKing k
                   | King.RedKing   k -> k

    let result = match direction with
                 | NorthEast -> (positions, position) ||> set ((position.X + 1), (position.Y + 1 ))
                 | NorthWest -> (positions, position) ||> set ((position.X - 1), (position.Y + 1 ))
                 | SouthEast -> (positions, position) ||> set ((position.X + 1), (position.Y - 1 ))
                 | SouthWest -> (positions, position) ||> set ((position.X - 1), (position.Y - 1 ))

    match king with
    | King.BlackKing _ -> King.BlackKing result
    | King.RedKing   _ -> King.RedKing   result
    
let jumpRed ((redChecker:RedChecker) , (redCheckers:RedChecker list)) (blackPiece:BlackPiece) =

    let yIncrementValue = 1
    let maxY = 7

    let set position piece =
       match position with
       | pos when pos = piece -> position , redCheckers
       | _                    -> position , redCheckers |> remove redChecker

    match blackPiece with
    | BlackChecker piece
    | BlackKing    piece -> let location = (piece |> attemptJump redChecker yIncrementValue)
                            piece |> set location

let jumpBlack ((blackChecker:BlackChecker) , (blackCheckers:BlackChecker list))  (redPiece:RedPiece) =

    let yIncrementValue = -1
    let minY = 0

    let set position piece =
       match position with
       | pos when pos = piece -> position , blackCheckers
       | _                    -> position , blackCheckers |> remove blackChecker

    match redPiece with
    | RedChecker piece
    | RedKing    piece -> let location = (piece |> attemptJump blackChecker yIncrementValue)
                          piece |> set location

My initial implementation above was devastatingly complicated. Hence, I found myself writing the same function with a different signature just to satisfy “making illegal states unrepresentable”. Unfortunately, the path that I chose was not sustainable.

Testing

I can’t deny it, I have a fetish for test automation. However, where I often operate off of muscle memory when writing automated tests for viewmodel commands within a MVVM architecture, I often hesitate when attempting to write automated tests using functional code.

My tests for that implementation was the following:

(* Tests *)
open NUnit.Framework
open FsUnit

[<Test>]
let ``move black checker northeast``() =
    ([], { X=1; Y=1 } ) ||> moveBlack BlackOption.NorthEast 
                         |> should equal { X=2; Y=2 }
[<Test>]
let ``move black checker northwest``() =
    ([], { X=1; Y=1 }) ||> moveBlack BlackOption.NorthWest 
                       |> should equal { X=0; Y=2 }
[<Test>]
let ``move red checker southeast``() =
    ([], { X=1; Y=1 }) ||> moveRed RedOption.SouthEast
                        |> should equal { X=2; Y=0 }
[<Test>]
let ``move red checker southwest``() =
    ([], { X=1; Y=1 }) ||> moveRed RedOption.SouthWest 
                        |> should equal { X=0; Y=0 }
[<Test>]
let ``black checker jumps red checker northeast``() =
    let redChecker = { X=1 ; Y=1 }
    let target = (redChecker, [redChecker])

    BlackChecker { X=0 ; Y=0 } |> jumpRed target
                               |> fst
                               |> should equal { X=2 ; Y=2 }
[<Test>]
let ``black checker jumps red checker northwest``() =
    let redChecker = { X=1 ; Y=1 }
    let target = (redChecker, [redChecker])

    BlackChecker { X=2 ; Y=0 } |> jumpRed target
                               |> fst
                               |> should equal { X=0 ; Y=2 }
[<Test>]
let ``red checker removed after being jumped``() =
    let redChecker = { X=1 ; Y=1 }
    let target = (redChecker, [redChecker])

    BlackChecker { X=2 ; Y=0 } |> jumpRed target
                               |> snd
                               |> should equal []
[<Test>]
let ``black checker removed after being jumped``() =
    let target = { X=1 ; Y=1 }, []
    RedChecker { X=2 ; Y=2 } |> jumpBlack target
                             |> snd
                             |> should equal []
[<Test>]
let ``red checker jumps black checker southeast``() =
    let blackChecker = { X=3 ; Y=2 }
    let target = blackChecker, [blackChecker]

    RedChecker { X=2 ; Y=3 } |> jumpBlack target
                             |> fst
                             |> should equal { X=4 ; Y=1 }
[<Test>]
let ``red checker jumps black checker southwest``() =
    let blackChecker = { X=1 ; Y=2 }
    let target = blackChecker, [blackChecker]
    RedChecker { X=2 ; Y=3 } |> jumpBlack target
                             |> fst
                             |> should equal { X=0 ; Y=1 }
[<Test>]
let ``cannot move black checker in a position already allocated``() =
    let redChecker = { X=2; Y=2 }
    let blackChecker = { X=1; Y=1 }
    let positions = [redChecker]

    (positions, blackChecker) ||> moveBlack BlackOption.NorthEast 
                               |> should equal { X=1; Y=1 }
[<Test>]
let ``cannot move red checker in a position already allocated``() =
    let redChecker = { X=1; Y=1 }
    let blackChecker = { X=2; Y=0 }
    let positions = [blackChecker]

    (positions, redChecker) ||> moveRed RedOption.SouthEast 
                             |> should equal { X=1; Y=1 }
[<Test>]
let ``first set count equals 12`` () =
    initializeBlack () |> List.length
                       |> should equal 12
[<Test>]
let ``second set count equals 12`` () =
    initializeRed () |> List.length
                     |> should equal 12
[<Test>]
let ``red checkers starts at (0,0)`` () =
    let checkers = initializeRed ()
    let firstChecker = checkers.Head
    let position = firstChecker
    position |> should equal { X=0; Y=0 }

[<Test>]
let ``black checkers starts at (0,7)`` () =
    let checkers = initializeBlack ()
    let firstChecker = checkers.Item 0
    let position = firstChecker
    position |> should equal { X=0; Y=7 }

[<Test>]
let ``black checker jumps to king``() =
    let redChecker = { X=1 ; Y=6 }
    let target = (redChecker, [redChecker])

    BlackChecker { X=0 ; Y=5 } |> jumpRed target
                               |> fst
                               |> should equal { X=2 ; Y=7 }
[<Test>]
let ``black checker jumps to king reduces red count``() =
    let redChecker = { X=1 ; Y=6 }
    let target = (redChecker, [redChecker])

    BlackChecker { X=0 ; Y=5 } |> jumpRed target
                               |> snd
                               |> should equal []
[<Test>]
let ``red checker jumps to king``() =
    let blackChecker = { X=1 ; Y=1 }
    let target = (blackChecker, [blackChecker])

    RedChecker { X=0 ; Y=2 } |> jumpBlack target
                             |> fst
                             |> should equal { X=2 ; Y=0 }
[<Test>]
let ``red checker jumps to king reduces black count``() =
    let blackChecker = { X=1 ; Y=1 }
    let target = (blackChecker, [blackChecker])

    RedChecker { X=0 ; Y=2 } |> jumpBlack target
                             |> snd
                             |> should equal []
[<Test>]
let ``Red king moves backwards`` ()=
    ([], King.RedKing { X=1; Y=0 }) ||> moveKing NorthWest
                                     |> should equal (King.RedKing { X=0; Y=1 })
[<Test>]
let ``Black king moves backwards`` ()=
    ([], King.BlackKing { X=1; Y=7 }) ||> moveKing SouthWest
                                       |> should equal (King.BlackKing { X=0; Y=6 })
[<Test>]
let ``red king jumps checker``() =
    let blackChecker = { X=1 ; Y=1 }
    let target = (blackChecker, [blackChecker])

    RedKing { X=0 ; Y=2 } |> jumpBlack target
                          |> fst
                          |> should equal { X=2 ; Y=0 }

In the code above, I made heavy use of the “||>” operator. This operator lets a developer pipe a tuple of values into a function only if the last two parameters of the function match each tuples type respectively.

Issues identified with my original TDD approach

There were some issues with my approach that I just couldn’t bare to look at.

Specifically, I hated the way I initialized my game:

let private initializeBlack () =
    let setPosition index =
        index |> setRowPosition 7 6 5

    let blackCheckers = List.init 12 setPosition |> List.map (fun pos -> { X=pos.X; Y=pos.Y })
    blackCheckers

let private initializeRed () =
    let setPosition index =
        index |> setRowPosition 0 1 2

    let redCheckers =   List.init 12 setPosition |> List.map (fun pos -> { X=pos.X; Y=pos.Y })
    redCheckers

I knew when I first implemented these functions that a better model could be contrived. Hence, the implementation above has no constraints or visualization. What would be better is if I could design functions that were constrained for successful usage.

Starting Over

As I mentioned earlier in this article, I was struggling to progress with my implementation of a checkers game. Hence, I was trying to leverage the compiler to make “illegal states unrepresentable”. As a result of my failure, I decided to scrap my implementation and start over.

Updated Types

With some advice from the F# community, I flushed out the following types:

(* Types *)
type Black = BlackKing | BlackSoldier
type Red =   RedKing   | RedSoldier

type Coordinate = int * int

type Piece =
    | Black of Black * Coordinate
    | Red   of Red   * Coordinate

type Space =
    | Occupied  of Piece
    | Available of Coordinate

type Status =
    | BlacksTurn | RedsTurn
    | BlackWins  | RedWins

In retrospect though, I would not have created the Piece type:

type Piece =
    | Black of Black * Coordinate
    | Red   of Red   * Coordinate

The type above caused me some unnecessary pain by complicating my functions.

If I could do it over, I would just have this:

type Piece = 
    | BlackKing    of Black * Coordinate
    | BlackSoldier of Black * Coordinate
    | RedKing      of Black * Coordinate
    | RedSoldier   of Black * Coordinate

Updated Functions

I decided to rethink my model’s operations by constraining the options available for both placements and movements.

For example, in the previous version of my implementation, I initialized the game with the following functions:

let private initializeBlack () =
    let setPosition index =
        index |> setRowPosition 7 6 5

    let blackCheckers = List.init 12 setPosition |> List.map (fun pos -> { X=pos.X; Y=pos.Y })
    blackCheckers

let private initializeRed () =
    let setPosition index =
        index |> setRowPosition 0 1 2

    let redCheckers =   List.init 12 setPosition |> List.map (fun pos -> { X=pos.X; Y=pos.Y })
    redCheckers

As I stated earlier, I was not proud of the implementation above. I felt like the two functions above were not designed with rigorous constraints and could not be visualized, which would ultimately lead to better maintainability.

As a result, I implemented the bootstrapping process for the checker board with the following functions:

let private black coordinate = Occupied (Black (BlackSoldier , coordinate))
let private red   coordinate = Occupied (Red   (RedSoldier   , coordinate))

let startGame () =
    [ red (0,0);  red (2,0);  red (4,0);  red (6,0)
      red (1,1);  red (3,1);  red (5,1);  red (7,1)
      red (0,2);  red (2,2);  red (4,2);  red (6,2)
      
      Available (1,3); Available (3,3); Available (5,3); Available (7,3)
      Available (0,4); Available (2,4); Available (4,4); Available (6,4)
      
      black (1,5);  black (3,5);  black (5,5);  black (7,5)
      black (0,6);  black (2,6);  black (4,6);  black (6,6)
      black (1,7);  black (3,7);  black (5,7);  black (7,7) ] , BlacksTurn

The startGame function noted above is more visual than my previous bootstrapping implementation. Hence, the function above screams the placement of red and black checkers. Thus, I was proud of this bootstrap implementation.

The following functions reflect the latest version of the checkers game:

(* Private *)
let private black coordinate = Occupied (Black (BlackSoldier , coordinate))
let private red   coordinate = Occupied (Red   (RedSoldier   , coordinate))

let getPositions (positions:Space list, status:Status) = positions

let private yDirection = function
    | Black _ -> -1
    | Red   _ ->  1

let private toAvailable = function
    | Available pos -> true
    | _             -> false

let available positions = positions |> List.filter toAvailable

let private availableSelection = function
    | Available pos -> Some pos
    | Occupied _   -> None

let private availablePositions positions = 
    positions |> List.filter toAvailable
              |> List.choose availableSelection

let private getCoordinate = function
    | Available xy -> Some xy
    | _            -> None

let coordinateOf = function
    | Black (checker , pos) -> pos
    | Red   (checker , pos) -> pos

let optionsForSoldier piece = 

    let (sourceX , sourceY) = coordinateOf piece

    (fun pos -> pos = ((sourceX - 1) , (sourceY + (piece |> yDirection) )) ||
                pos = ((sourceX + 1) , (sourceY + (piece |> yDirection) )))

let optionsForKing piece = 

    let (sourceX , sourceY) = coordinateOf piece

    (fun pos -> pos = ((sourceX - 1) , (sourceY + 1 )) ||
                pos = ((sourceX + 1) , (sourceY + 1 )) ||
                pos = ((sourceX - 1) , (sourceY - 1 )) ||
                pos = ((sourceX + 1) , (sourceY - 1 )))

let jumpOptions (sourceX , sourceY) space =
    match space with
    | Occupied p -> match p with
                     | Red   (ch,xy) -> xy = (sourceX + 1, sourceY - 1) ||
                                        xy = (sourceX - 1, sourceY - 1)
    
                     | Black (ch,xy) -> xy = (sourceX + 1, sourceY + 1) ||
                                        xy = (sourceX - 1, sourceY + 1)
    | _ -> false

let jumpsForSoldier piece positions =
    match piece with
    | Black (ch,pos) -> positions |> List.filter (jumpOptions (coordinateOf piece))
    | Red   (ch,pos) -> positions |> List.filter (jumpOptions (coordinateOf piece))

let private isKing piece = 
    match piece with
    | Black (checker , _) -> match checker with
                             | BlackSoldier -> false
                             | BlackKing    -> true

    | Red   (checker , _) -> match checker with
                             | RedSoldier   -> false
                             | RedKing      -> true

let filterOut a b positions =
    positions |> List.filter(fun x -> x <> a && x <> b)

(* Public *)
let startGame () =
    [ red (0,0);  red (2,0);  red (4,0);  red (6,0)
      red (1,1);  red (3,1);  red (5,1);  red (7,1)
      red (0,2);  red (2,2);  red (4,2);  red (6,2)
      
      Available (1,3); Available (3,3); Available (5,3); Available (7,3)
      Available (0,4); Available (2,4); Available (4,4); Available (6,4)
      
      black (1,5);  black (3,5);  black (5,5);  black (7,5)
      black (0,6);  black (2,6);  black (4,6);  black (6,6)
      black (1,7);  black (3,7);  black (5,7);  black (7,7) ] , BlacksTurn

let optionsFor piece positions =

    let sourceX , sourceY = coordinateOf piece

    match piece |> isKing with
    | false -> positions |> availablePositions 
                         |> List.filter (optionsForSoldier piece)

    | true ->  positions |> availablePositions 
                         |> List.filter (optionsForKing piece)

let movePiece destination positions piece =

    let destinationXY = 
        match destination with
        | Available xy -> xy
        | Occupied p  -> coordinateOf p

    let yValueMin , yValueMax = 0 , 7

    let canCrown =
        let yValue = snd destinationXY
        (yValue = yValueMin || 
         yValue = yValueMax) && 
         not (isKing piece)

    match positions |> List.find (fun space -> space = Occupied piece) with
    | Occupied (Black (ch, xy)) -> 
        let checkerType = if canCrown then BlackKing else BlackSoldier
        Available(xy) :: (Occupied(Black(checkerType, destinationXY)))
                      :: (positions |> filterOut (Occupied (Black(ch, xy))) destination)     
        
    | Occupied (Red   (ch, xy)) -> 
        let checkerType = if canCrown then RedKing else RedSoldier
        Available(xy) :: (Occupied(Red(checkerType, destinationXY)))
                      :: (positions |> filterOut (Occupied (Red(ch, xy))) destination) 
    | _ -> positions

let move piece destination (positions,status) =

    let expectedMove = match status with
                       | BlacksTurn -> RedsTurn
                       | RedsTurn   -> BlacksTurn
                       | BlackWins  -> BlackWins
                       | RedWins    -> RedWins

    let canProceed = 
        match piece with
        | Red   _ -> expectedMove = RedsTurn  
        | Black _ -> expectedMove = BlacksTurn

    if not canProceed then (positions , expectedMove)
    else let options   = optionsFor piece positions
         let canMoveTo = (fun target -> options |> List.exists (fun xy -> xy = target))
         
         match getCoordinate destination with
         | Some target -> if canMoveTo target then
                             let updatedBoard = ((positions , piece) ||> movePiece destination)
                             (updatedBoard , expectedMove)
         
                          else (positions , expectedMove)
         | None -> (positions , expectedMove)

let jump target positions source =

    let canJump = 
        positions |> jumpsForSoldier source
                  |> List.exists (fun s -> match s with
                                           | Occupied target -> true
                                           | _                -> false)

    let (|NorthEast|NorthWest|SouthEast|SouthWest|Origin|) (origin , barrier) =
        
        let (sourceX  , sourceY) =  origin
        let (barrierX , barrierY) = barrier

        if   barrierY = sourceY + 1 &&
             barrierX = sourceX - 1
        then SouthWest

        elif barrierY = sourceY + 1 &&
             barrierX = sourceX + 1 
        then SouthEast

        elif barrierY = sourceY - 1 &&
             barrierX = sourceX - 1
        then NorthWest

        elif barrierY = sourceY - 1 &&
             barrierX = sourceX + 1
        then NorthEast

        else Origin

    let jumpToPostion origin barrier =

        let (sourceX  , sourceY) =  origin
        let (barrierX , barrierY) = barrier

        match (origin , barrier) with
        | SouthWest -> (barrierX + 1, barrierY - 1)
        | SouthEast -> (barrierX + 1, barrierY + 1)
        | NorthWest -> (barrierX - 1, barrierY - 1)
        | NorthEast -> (barrierX - 1, barrierY + 1)
        | Origin    -> origin
    
    if canJump then
        let destination = Available (jumpToPostion (coordinateOf source) (coordinateOf target))
        let result = (positions, source) ||> movePiece destination
                                          |> List.filter (fun s -> s <> Occupied target)
        Available (coordinateOf target)::result
    else positions

Tests

The following tests were written:

(* Tests *)
open NUnit.Framework
open FsUnit

[<Test>]
let ``black goes first`` () =
    startGame () |> snd
                 |> should equal BlacksTurn
[<Test>]
let ``get avaialable positions`` () =
    startGame () |> fst
                 |> available
                 |> List.length 
                 |> should equal 8
[<Test>]
let ``get avaialable positions for black soldier`` () =
    // Setup
    let piece = Black ( BlackSoldier , (1,5) )

    // Test
    let available = startGame () |> fst
                                 |> available
                                 |> optionsFor piece
    // Verify
    let northWestAvailable = available |> List.exists (fun pos -> pos = (0,4))
    let northEastAvailable = available |> List.exists (fun pos -> pos = (2,4))

    (northWestAvailable && northEastAvailable) |> should equal true
[<Test>]
let ``get avaialable positions for red soldier`` () =
    // Setup
    let piece = Red ( RedSoldier , (0,2) )

    // Test
    startGame () |> fst
                 |> available
                 |> optionsFor piece
                 |> List.exists (fun pos -> pos = (1,3))
                 |> should equal true
[<Test>]
let ``get avaialable positions for red king`` () =
    // Setup
    let piece = Red ( RedKing , (2,4) )
    let positions = [Available (0,2);  Available (2,2);  Available (4,2);  Available (6,2)
      
                     Available (1,3);  Available (3,3);  Available (5,3);  Available (7,3)
                     Available (0,4);  Occupied piece;  Available (4,4);  Available (6,4)
      
                     Available (1,5);  Available (3,5);  Available (5,5);  Available (7,5)]

    // Test
    positions |> optionsFor piece
              |> List.length
              |> should equal 4
[<Test>]
let ``move red soldier`` () =

    let piece = Red ( RedSoldier , (0,2) )
    let destination = Available (1,3)

    // Test
    startGame () |> move piece destination
                 |> getPositions
                 |> List.exists (fun pos -> pos = Occupied (Red (RedSoldier , (1,3) )))
                 |> should equal true
[<Test>]
let ``moving red soldier leaves space available`` () =

    let piece = Red ( RedSoldier , (0,2) )
    let destination = Available (1,3)

    // Test
    startGame () |> move piece destination
                 |> getPositions
                 |> List.exists (fun pos -> pos = Available (0,2))
                 |> should equal true
[<Test>]
let ``moving red soldier maintains piece count`` () =

    let piece = Red ( RedSoldier , (0,2) )
    let destination = Available (1,3)

    // Test
    startGame () |> move piece destination
                 |> getPositions
                 |> List.length
                 |> should equal 32
[<Test>]
let ``get jump options for red soldier`` () =

    let redPiece =   Red   ( RedSoldier , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let positions = [Occupied redPiece; Occupied blackPiece]

    // Test
    positions |> jumpsForSoldier redPiece
              |> should equal [Occupied blackPiece]
[<Test>]
let ``red soldier gets new destination when it jumps black soldier`` () =

    let redPiece =   Red   ( RedSoldier , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let expected = Occupied (Red (RedSoldier , (2,4)))
    let positions = [Occupied redPiece; Occupied blackPiece; Available (2,4)]

    // Test
    (positions,redPiece) ||> jump blackPiece
                          |> List.exists (fun s -> s = expected)
                          |> should equal true

let ``black soldier gets new destination when it jumps red soldier`` () =

    let redPiece =   Red   ( RedSoldier   , (2,2) )
    let blackPiece = Black ( BlackSoldier , (3,3) )
    let expected =   Occupied (Black ( BlackSoldier , (1,1) ))
    let positions =  [Occupied redPiece; Occupied blackPiece; Available (1,1)]

    // Test
    (positions, blackPiece) ||> jump redPiece
                             |> List.exists (fun s -> s = expected)
                             |> should equal true
[<Test>]
let ``black soldier removed after being jumped by red soldier`` () =

    let redPiece =   Red   ( RedSoldier , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let expected =   Available (1,3)
    let positions =  [Occupied redPiece; Occupied blackPiece]

    // Test
    (positions,redPiece) ||> jump blackPiece
                          |> List.exists (fun s -> s = expected)
                          |> should equal true
[<Test>]
let ``red soldier removed after being jumped by black soldier`` () =

    let redPiece =   Red   ( RedSoldier   , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let expected =   Available (0,2)
    let positions =  [Occupied redPiece; Occupied blackPiece; expected]

    // Test
    (positions, blackPiece) ||> jump redPiece
                             |> List.exists (fun s -> s = expected)
                             |> should equal true
[<Test>]
let ``movng black soldier to endzone makes king`` () =
    
    let piece = Black ( BlackSoldier , (1,1) )
    let destinationCoordinate = (0,0)
    let destination = Available destinationCoordinate
    let positions = [destination; Occupied piece]
    let expected = Occupied (Black (BlackKing , destinationCoordinate))

    // Test
    (positions, RedsTurn) |> move piece destination
                          |> getPositions
                          |> List.exists (fun pos -> pos = expected)
                          |> should equal true          
[<Test>]
let ``movng red soldier to endzone makes king`` () =

    let piece = Red ( RedSoldier , (6,6) )
    let destinationCoordinate = (7,7)
    let destination = Available destinationCoordinate
    let positions = [destination; Occupied piece]
    let expected = Occupied (Red (RedKing , destinationCoordinate))

    // Test
    (positions, BlacksTurn) |> move piece destination
                            |> getPositions
                            |> List.exists (fun pos -> pos = expected)
                            |> should equal true
[<Test>]
let ``can't move red twice in a row`` () =
    let piece = Red(RedSoldier , (0,2))
    let destination = Available (1,3)

    // Test
    let set1 = startGame() |> move piece destination
    let set2 = set1 |> move piece destination
                    
    set2 |> getPositions
         |> should equal (set1 |> getPositions)

Conclusion

In conclusion, I have been going full throttle in my journey to learn F#. My latest focus was to implement a checkers game. I showed two versions of how the game was implemented. Note that these implementations do not account for multiple jumps for a checker. I have realized that “making illegal states unrepresentable” is a significant challenge in regards to maintainability.