# F#: Checkers Kata Retrospective

# 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.

Pingback: F# Weekly #33, 2016 – Sergey Tihon's Blog