using parsec to score a bowling game

bowl.lhs

Using Parsec to score a bowling game.
===

In this gist we'll see how to use Parsec to solve the problem of
scoring a bowling game. This was inspired by a
Reddit Daily Programmer problem:

https://www.reddit.com/r/dailyprogrammer/comments/3ntsni/20151007_challenge_235_intermediate_scoring_a/

Here are the problems we want to solve:

1. Parse a list of pins knocked down on each roll into a list of frame results (i.e. strike, spare, open frame)
2. From a list of frame results compute the final score of a game.
3. Parse a textual representation of a game into a list of frame results.

First our imports:

> {-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}
>
> import Control.Monad
> import Text.Parsec
> import Text.Parsec.Char
> import Data.List
> import Data.Char

(We need these `LANGUAGE` pragmas  only because I don't want to write
any type signatures. In fact, the only functions which
requires us to use these pragmas occur in the textual parsing
section.)

Here is the data type we will use to represent the result of a frame:

> data Frame = Strike | Spare Int | Open Int Int
>   deriving (Show)

Parsing [Int]
===

We will first parse a list of Ints (representing the pins knocked down
on each roll) into a list of frame results. For instance, the rolls:

    [10, 0, 10, 3, 5, 6, 4]

would be translated to the frame results:

    [Strike, Spare 0, Open 3 5, Spare 6 ]

Here is the code to parse a regular frame:

> frame = do
>   a <- anyToken
>   if a == 10
>     then return Strike
>     else do b <- anyToken
>             return $ if a + b == 10 then Spare a else Open a b
>
> test1 = parseTest (many frame) [10, 0, 10, 3, 5, 6, 4]

Special logic is needed to handle the tenth frame.
The code here is complex only because we want to
accurately desscribe the frame results in traditional
bowling terms.

> tenth = do
>   f <- frame
>   case f of
>     Strike  -> do a <- anyToken; b <- anyToken
>                   return $ [ f ] ++ go2 a b
>     Spare _ -> do a <- anyToken; return [ f, go1 a ]
>     _       -> return [ f ]
>   where go1 10 = Strike
>         go1 a  = Open a 0
>         go2 10 10 = [Strike, Strike]
>         go2 10 a  = [Strike, Open a 0]
>         go2 a  b  | a + b == 10 = [ Spare a ]
>                   | otherwise   = [ Open a b ]

Alternatively, if we only care about scoring
we can use this simpler version:

> tenth' = do
>   f <- frame
>   case f of
>     Strike  -> do a <- anyToken; b <- anyToken; return [f, Open a b]
>     Spare _ -> do a <- anyToken; return [ f, Open a 0 ]
>     _       -> return [f]

A complete game is nine regular frames plus a tenth frame:

> game = do f9 <- replicateM 9 frame -- first 9 frames
>           f10 <- tenth             -- or tenth'
>           return (f9 ++ f10)

And here are some tests:

> test2a = parseTest (game <* eof) [10,9,1,5,5,7,2,10,10,10,9,0,8,2,9,1,10]
>
> -- not enough input:
> test2b = parseTest (game <* eof) [10,9,1,5,5,7,2,10,10,10,9,0,8,2,9,1]

Note how the `game` parser consumes exactly the number of rolls needed
to describe a complete game.

Scoring
===

We now address the problem of computing the score of a game
given a list of frame results.
The function `scoreGame` will even work on incomplete games.
The result will be the score of the game assuming the remaining
rolls are gutter balls.

> next1 :: [Frame] -> Int
> next1 (Strike :_)    = 10
> next1 (Spare a : _)  = a
> next1 (Open a _ : _) = a
> next1 _ = 0
> 
> next2 :: [Frame] -> Int
> next2 (Strike : fs)  = 10 + next1 fs
> next2 (Spare _ : _ ) = 10
> next2 (Open a b : _) = a + b
> next2 _              = 0
> 
> scoreFrame (Strike   : fs) = 10 + next2 fs
> scoreFrame (Spare _  : fs) = 10 + next1 fs
> scoreFrame (Open a b : fs) = a + b
> scoreFrame _               = 0
> 
> scoreGame :: [Frame] -> Int
> scoreGame frames = sum [ scoreFrame fs | fs <- take 10 (tails frames) ]

The `"foo"` parameter in the following tests is simply a "source name" used for error messages.
Typically a file name would be used here to identity where the input came from.

> -- Right 300
> test3a = fmap scoreGame (parse game "foo" (replicate 12 10))
> 
> -- Right 187
> test3b = fmap scoreGame (parse game "foo" [10,9,1,5,5,7,2,10,10,10,9,0,8,2,9,1,10])
>
> -- Left "foo" (line 1, column 1): unexpected end of input
> test3c = fmap scoreGame (parse (game <* eof) "foo" [1, 0, 1, 0, 2])

Parsing a String
===

To help us skip white space we'll make use of the following
`lexical` combinator.  After running a parser _p_ it skips
all the following white space and then returns whatever _p_ returned.

> lexical p = p <* skipMany space

Using `lexical` will ensure that all of our tokens begin on non-whitespace characters.
The caveat is that we have make sure to skip any whitespace at the beginning of
our input before running our main parser.

Here is one way to parse a frame:

> frameT' = do
>   a <- lexical anyChar
>   if a == 'X'
>     then return Strike
>     else do b <- lexical anyChar
>             return $ if b == '/' then Spare (digitToInt a) else Open (digitToInt a) (digitToInt b)

It's a little unsatifying since we could end of calling `digitToInt`
with a non-digit character. A safer implementation is:

> lexchar ch = lexical (char ch)
>
> roll = do a <- lexical $ oneOf "-123456789"
>           return $ if a == '-' then 0 else digitToInt a
>
> twoRolls = do a <- roll
>               (lexchar '/' >> return (Spare a)) <|> (do b <- roll; return (Open a b))
>
> frameT = twoRolls <|> (lexchar 'X' >> return Strike)

Note that we don't have to use `try` with `<|>`. That's because `lexchar ch` will not
consume any input if it fails.

Some tests:

> -- [ Spare 0, Open 6 3, Strike, Spare 2]
> test4a = parseTest (many frameT) "-/ 63 X 2/"
>
> test4b = parseTest frameT "6X" -- syntax error

One advantage of using Parsec is that we get error messages for free.
However, in the case of `test4b` the diagnostic is a little unsatisfying.
Later we might explore how to improve Parsec's error messages.

Now that we have `frameT` we can write the textual version of
`tenth`. Here is the simplified version:

> -- parse one roll also allowing 'X'
> rollX = (lexchar 'X' >> return 10) <|> roll
>
> tenthT' = do
>   f <- frameT
>   case f of
>     Strike  -> do a <- rollX
>                   b <- rollX <|> (lexchar '/' >> return (10-a))
>                   return $ [f, Open a b ]
>     Spare _ -> do a <- rollX; return [ f, Open a 0 ]
>     _       -> return [f]
>
> gameT = do f9  <- replicateM 9 frameT
>            f10 <- tenthT'
>            return $ f9 ++ f10
>
> test5a = parseTest (gameT <* eof) "X -/ X 5- 8/ 9- X 81 1- 4/X"
> test5b = parseTest (gameT <* eof) "62 71  X 9- 8/  X  X 35 72 5/8    "
> test5c = parseTest (gameT <* eof) "    X X X X X X X X X X X X "
> test5d = parseTest (gameT <* eof) "X X X X X X X X X X X X "

Note that test5c fails because we didn't consume the leadng
white space before parsing the first frame.

Here's putting the textual parsing functions together with `scoreGame`:

> test6a = fmap scoreGame (parse (spaces *> gameT <* eof) "bar" "X -/ X   5- 8/   9- X 81 1- 4/X")
> test6b = fmap scoreGame (parse (spaces *> gameT <* eof) "bar" "   62 71  X 9-   8/  X  X 35 72 5/8    ")