Connect 4

connect4.fs

type Color =
  | Red
  | Yellow

type Spot =
  | Empty
  | Color of Color

type Column =
  | A
  | B
  | C
  | D
  | E
  | F
  | G

type Board =
  {
    ColumnA : Spot list
    ColumnB : Spot list
    ColumnC : Spot list
    ColumnD : Spot list
    ColumnE : Spot list
    ColumnF : Spot list
    ColumnG : Spot list
  }

let emptyBoard =
  {
    ColumnA = [Empty; Empty; Empty; Empty; Empty; Empty;]
    ColumnB = [Empty; Empty; Empty; Empty; Empty; Empty;]
    ColumnC = [Empty; Empty; Empty; Empty; Empty; Empty;]
    ColumnD = [Empty; Empty; Empty; Empty; Empty; Empty;]
    ColumnE = [Empty; Empty; Empty; Empty; Empty; Empty;]
    ColumnF = [Empty; Empty; Empty; Empty; Empty; Empty;]
    ColumnG = [Empty; Empty; Empty; Empty; Empty; Empty;]
  }

let add column color =
  match column with
  | [Empty; y2; y3; y4; y5; y6 ] -> [Color color; y2; y3; y4; y5; y6 ]
  | [y1; Empty; y3; y4; y5; y6 ] -> [y1; Color color; y3; y4; y5; y6 ]
  | [y1; y2; Empty; y4; y5; y6 ] -> [y1; y2; Color color; y4; y5; y6 ]
  | [y1; y2; y3; Empty; y5; y6 ] -> [y1; y2; y3; Color color; y5; y6 ]
  | [y1; y2; y3; y4; Empty; y6 ] -> [y1; y2; y3; y4; Color color; y6 ]
  | [y1; y2; y3; y4; y5; Empty ] -> [y1; y2; y3; y4; y5; Color color ]
  | [_;   _;  _;  _;  _; _     ] -> failwith "That column is full"
  | bad                          -> failwith <| sprintf "%A is a bad column" bad

let place color column board =
  match column with
  | A -> { board with ColumnA = add board.ColumnA color }
  | B -> { board with ColumnB = add board.ColumnB color }
  | C -> { board with ColumnC = add board.ColumnC color }
  | D -> { board with ColumnD = add board.ColumnD color }
  | E -> { board with ColumnE = add board.ColumnE color }
  | F -> { board with ColumnF = add board.ColumnF color }
  | G -> { board with ColumnG = add board.ColumnG color }

let checkColumn column =
  match column with
  | [Color Red; Color Red; Color Red; Color Red; _; _ ]             -> true
  | [Color Yellow; Color Yellow; Color Yellow; Color Yellow; _; _ ] -> true
  | [_; Color Red; Color Red; Color Red; Color Red; _ ]             -> true
  | [_; Color Yellow; Color Yellow; Color Yellow; Color Yellow; _ ] -> true
  | [_; _; Color Red; Color Red; Color Red; Color Red ]             -> true
  | [_; _; Color Yellow; Color Yellow; Color Yellow; Color Yellow ] -> true
  | _ -> false

let verticalWinner board =
  checkColumn board.ColumnA
  || checkColumn board.ColumnB
  || checkColumn board.ColumnC
  || checkColumn board.ColumnD
  || checkColumn board.ColumnE
  || checkColumn board.ColumnF
  || checkColumn board.ColumnG


let winner board =
  verticalWinner board


//demo
context "Test Context"

"When you dont put any token in B, the board is still empty" &&& fun _ ->
  let board = emptyBoard
  board == emptyBoard

"When you add red to empty board, column A, there is one item in the bottom left" &&& fun _ ->
  let board = emptyBoard
  let newBoard = place Red A board

  newBoard == { emptyBoard with ColumnA = [Color Red; Empty; Empty; Empty; Empty; Empty;] }

"When you add red/yellow/red to empty board, column A, there 3 items in the bottom left" &&& fun _ ->
  let newBoard =
    emptyBoard
    |> place Red A
    |> place Yellow A
    |> place Red A

  newBoard == { emptyBoard with ColumnA = [Color Red; Color Yellow; Color Red; Empty; Empty; Empty;] }

"When you add red/yellow/red to empty board, column F, there 3 items in the bottom left" &&& fun _ ->
  let newBoard =
    emptyBoard
    |> place Red F
    |> place Yellow F
    |> place Red F

  newBoard == { emptyBoard with ColumnF = [Color Red; Color Yellow; Color Red; Empty; Empty; Empty;] }

"When you add red in all columns, there 1 item in the bottom slot" &&& fun _ ->
  let newBoard =
    emptyBoard
    |> place Red A
    |> place Red B
    |> place Red C
    |> place Red D
    |> place Red E
    |> place Red F
    |> place Red G

  newBoard ==
      {
        emptyBoard with
          ColumnA = [Color Red; Empty; Empty; Empty; Empty; Empty;]
          ColumnB = [Color Red; Empty; Empty; Empty; Empty; Empty;]
          ColumnC = [Color Red; Empty; Empty; Empty; Empty; Empty;]
          ColumnD = [Color Red; Empty; Empty; Empty; Empty; Empty;]
          ColumnE = [Color Red; Empty; Empty; Empty; Empty; Empty;]
          ColumnF = [Color Red; Empty; Empty; Empty; Empty; Empty;]
          ColumnG = [Color Red; Empty; Empty; Empty; Empty; Empty;]
      }

"When place 3 red in a row, it is NOT a winner" &&& fun _ ->
  let newBoard =
    emptyBoard
    |> place Red F
    |> place Red F
    |> place Red F

  false == winner newBoard

"When place 3 red and one yellow in a row, it is NOT a winner" &&& fun _ ->
  let newBoard =
    emptyBoard
    |> place Red A
    |> place Red A
    |> place Red A
    |> place Yellow A

  false == winner newBoard

"When place 4 red in a row, its a winner" &&& fun _ ->
  let newBoard =
    emptyBoard
    |> place Red A
    |> place Red A
    |> place Red A
    |> place Red A

  true == winner newBoard

"When place 1 yellow then 4 red in a row, its a winner" &&& fun _ ->
  let newBoard =
    emptyBoard
    |> place Yellow A
    |> place Red A
    |> place Red A
    |> place Red A
    |> place Red A

  true == winner newBoard

"When place 2 yellow then 4 red in a row, its a winner" &&& fun _ ->
  let newBoard =
    emptyBoard
    |> place Yellow A
    |> place Yellow A
    |> place Red A
    |> place Red A
    |> place Red A
    |> place Red A

  true == winner newBoard


"When place 4 red in a row, its a winner" &&& fun _ ->
  let newBoard =
    emptyBoard
    |> place Red F
    |> place Red F
    |> place Red F
    |> place Red F

  true == winner newBoard