Skip to content

Instantly share code, notes, and snippets.

@tomphp
Created October 26, 2019 11:51
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save tomphp/3e8f3e7683f3f419cf10cb70c524c1bf to your computer and use it in GitHub Desktop.
Haskell Bowling
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
module BowlingSpec where
import Test.Hspec
import Control.Applicative ((<|>))
newtype Frame = Frame Int deriving (Num, Enum)
newtype Score = Score Int deriving (Eq, Num, Show)
newtype Pins = Pins Int deriving (Eq, Num)
type Rolls = [Pins]
data FrameScore = Strike Score | Spare Score | Default Score
framesInGame :: Num a => a
framesInGame = 10
score :: Rolls -> Maybe Score
score rolls =
fst <$> foldl scoreFrame (Just (0, rolls)) [1..framesInGame]
scoreFrame :: Maybe (Score, Rolls) -> Frame -> Maybe (Score, Rolls)
scoreFrame (Just state@(_, remainingRolls)) _ =
updateScoreAndRemainingRolls state <$> getFrameScore remainingRolls
getFrameScore :: Rolls -> Maybe FrameScore
getFrameScore rolls = scoreStrike rolls <|> scoreSpare rolls <|> scoreDefault rolls
updateScoreAndRemainingRolls :: (Score, Rolls) -> FrameScore -> (Score, Rolls)
updateScoreAndRemainingRolls (currentScore, remainingRolls) frameScore =
(newScore, newRemainingRolls)
where newScore = currentScore + toScore frameScore
newRemainingRolls = nextFrame frameScore remainingRolls
nextFrame :: FrameScore -> Rolls -> Rolls
nextFrame = drop . rollsInFrame
rollsInFrame :: FrameScore -> Int
rollsInFrame (Strike _) = 1
rollsInFrame _ = 2
scoreStrike :: Rolls -> Maybe FrameScore
scoreStrike (10 : bonus1 : bonus2 : _) = Just $ Strike (toScore $ 10 + bonus1 + bonus2)
scoreStrike _ = Nothing
scoreSpare :: Rolls -> Maybe FrameScore
scoreSpare (roll1 : roll2 : bonus : _)
| roll1 + roll2 == 10 = Just $ Spare (toScore $ 10 + bonus)
| otherwise = Nothing
scoreSpare _ = Nothing
scoreDefault :: Rolls -> Maybe FrameScore
scoreDefault (roll1 : roll2 : _) = Just $ Default (toScore $ roll1 + roll2)
scoreDefault _ = Nothing
class Scoreable a where
toScore :: a -> Score
instance Scoreable Pins where
toScore (Pins count) = Score count
instance Scoreable FrameScore where
toScore (Strike score) = score
toScore (Spare score) = score
toScore (Default score) = score
spec :: Spec
spec = describe "Scoring a bowling game" $ do
it "scores 0 for a gutter game" $ do
let rolls = replicate 20 0
score rolls `shouldBe` Just 0
it "scores 1 for a single pin" $ do
let rolls = 1 : replicate 19 0
score rolls `shouldBe` Just 1
it "scores 20 for 1 pin in each frame" $ do
let rolls = replicate 20 1
score rolls `shouldBe` Just 20
it "scores 1 extra roll for spare" $ do
let rolls = 3 : 7 : 1 : replicate 17 0
score rolls `shouldBe` Just 12
it "scores 2 extra rolls for strike" $ do
let rolls = 10 : 1 : 2 : replicate 17 0
score rolls `shouldBe` Just 16
it "scores 300 for perfect game" $ do
let rolls = replicate 12 10
score rolls `shouldBe` Just 300
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment