public
Last active

Bowling kata in Ocaml

  • Download Gist
Makefile
Makefile
1 2 3 4 5 6 7 8 9 10 11 12
all: spec
 
spec: game.cmo spec.ml
ospecl spec.ml
 
game.cmo:
ocamlc -c game.ml
 
clean:
rm *.cm*
 
.PHONY: all spec
game.ml
OCaml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
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
spec.ml
OCaml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
(**
* 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
]

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.