Bowling kata in Ocaml

game.ml

type frame = 
  | Strike 
  | Spare of int 
  | Open of int * int 
  | InPlay of int 
  | FinalInPlay of int
  | FinalInPlayStrike
  | FinalInPlayBonus of int * int
  | FinalBonus of int * int * int
  | FinalOpen of int * int

type t = frame list
let empty = []

let score game = 
  let rec sum_up curr_multiplier next_multiplier next_next_multiplier frames = match frames with
    | Strike :: tail ->
        (10 * curr_multiplier) + (sum_up (next_multiplier + 1) (next_next_multiplier + 1) 1 tail)
    | Spare first :: tail ->
        let second = 10 - first in
        (first * curr_multiplier) + (second * next_multiplier) + (sum_up (next_next_multiplier + 1) 1 1 tail)
    | Open (first, second) :: tail | FinalOpen (first, second) :: tail ->
        (first * curr_multiplier) + (second * next_multiplier) + (sum_up next_next_multiplier 1 1 tail)
    | InPlay first :: tail ->
        (first * curr_multiplier) + (sum_up 1 1 1 tail)
    | FinalInPlay first :: _ -> 
        (first * curr_multiplier)
    | FinalInPlayStrike :: _ ->
        (10 * curr_multiplier)
    | FinalInPlayBonus (first, second) :: _ ->
        (first * curr_multiplier) + (second * next_multiplier)
    | FinalBonus (first, second, third) :: _ ->
        (first * curr_multiplier) + (second * next_multiplier) + (third * next_next_multiplier)
    | [] -> 0
  in
  sum_up 1 1 1 (List.rev game)

let roll value game = match game with 
  | FinalBonus (_,_,_) :: _ | FinalOpen (_,_) :: _ ->
      failwith "Cannot roll more frames after a final frame"
  | [] | Strike :: _ | Spare _ :: _ | Open (_,_) :: _  ->
    let last_frame = List.length game = 9 in
    if value = 10 then
      (if last_frame then FinalInPlayStrike else Strike) :: game
    else
      (if last_frame then FinalInPlay value else InPlay value) :: game
  | InPlay first :: tail -> 
      if first + value = 10 then 
        Spare first :: tail
      else
        Open (first, value) :: tail
  | FinalInPlay first :: tail -> 
      if first + value = 10 then 
        FinalInPlayBonus (first, value) :: tail
      else
        FinalOpen (first, value) :: tail
  | FinalInPlayStrike :: tail ->
      FinalInPlayBonus (10, value) :: tail
  | FinalInPlayBonus (first, second) :: tail ->
      FinalBonus (first, second, value) :: tail

Makefile

all: spec

spec: game.cmo spec.ml
	ospecl spec.ml

game.cmo:
	ocamlc -c game.ml

clean:
	rm *.cm*

.PHONY: all spec

spec.ml

(**
 * Uses Ospecl library.
 *
 * Specs themselves largely based on
 * http://blog.objectmentor.com/articles/2009/10/01/bowling-game-kata-in-ruby
 *)

#load "game.cmo"

#use "topfind"
#require "unix"
#require "ospecl"

let specs = 
  let rec repeat count func value = 
    match count with
    | 0 -> value 
    | _ -> repeat (count - 1) func (func value)
  in

  let (|*) = repeat in

  let (|>) x f = f x in
  let (>>) f g x = g (f x) in

  let open Ospecl.Spec in
  let open Ospecl.Matchers in

  [
    describe "Game" begin 
      let open Game in

      let score_of expected_score =
        let module M = Ospecl.Matcher in
        let description = "score of " ^ string_of_int expected_score in
        let test game =
          let actual_score = score game in
          if actual_score = expected_score then
            M.Matched description
          else
            M.Mismatched ("score of " ^ string_of_int actual_score)
        in M.make description test
      in

      let scores value rolls =
        empty |> rolls =~ has (score_of value)
      in

      let spare = 2 |* (roll 5) in
      let strike = roll 10 in
      let gutter = roll 0 in

      [
        describe "before any rolls" [
          it "has score 0" begin
            empty =~ has (score_of 0)
          end;
        ];

        describe "for complete games" [
          it "should score 0 for an all gutter game" begin
            20 |* gutter |> scores 0
          end;

          it "should show 20 for an all 1 game" begin
            20 |* roll 1 |> scores 20
          end;

          it "should score game with single spare correctly" begin
            (3 |* roll 5) >> (17 |* gutter) |> scores 20
          end;

          it "should score game with single strike correctly" begin
            strike >> roll 5 >> roll 2 >> (16 |* gutter) |> scores 24
          end;

          it "should score a dutch-200, spare-strike, correctly" begin
            (5 |* (spare >> strike)) >> spare |> scores 200
          end;

          it "should score a dutch-200, strike-spare, correctly" begin
            (5 |* (strike >> spare)) >> strike |> scores 200
          end;

          it "should score all 5's game as 150" begin
            (21 |* roll 5) |> scores 150
          end;

          it "should score a perfect game correctly" begin
            (12 |* strike) |> scores 300
          end;

          it "should not count a 0, 10 roll as a strike" begin
            roll 0 >> roll 10 >> roll 1 >> roll 3 >> (16 |* gutter) |> scores 15
          end;
        ];

        describe "for open games" [
          it "should score just an open frame" begin
            roll 4 >> roll 3 |> scores 7
          end;

          it "should score just a spare" begin
            roll 5 >> roll 5 |> scores 10
          end;

          it "should score partial game with spare and following frame only" begin
            (3 |* roll 5) |> scores 20
          end;

          it "should score an opening turkey correctly" begin
            (3 |* strike) |> scores 60
          end;
        ];

        describe "for open games starting with a strike" [
          it "should score partial game with only strike" begin
            strike |> scores 10
          end;

          it "should score partial game with strike and half-open frame" begin
            strike >> roll 4 |> scores 18
          end;

          it "should score partial game with strike and open frame" begin
            strike >> roll 3 >> roll 6 |> scores 28
          end;

          it "should score partial game with strike and spare" begin
            strike >> roll 3 >> roll 7 |> scores 30
          end;
        ];

        describe "for open games starting with two strikes" [
          it "should have a score of 30" begin
            strike >> strike |> scores 30
          end;

          it "should score correctly with following non-mark" begin
            strike >> strike >> roll 4 |> scores 42
          end;

          it "should score correctly with third frame open" begin
            strike >> strike >> roll 4 >> roll 3 |> scores 48
          end;
        ];
      ] 
    end
  ]