mtlstats/test/TypesSpec.hs

1008 lines
28 KiB
Haskell

{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
module TypesSpec
( Comparable (..)
, spec
, makePlayer
, makeGoalie
, makePlayerStats
, makeGoalieStats
) where
import Control.Monad (replicateM)
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
import Data.Aeson.Types (Value (Object))
import qualified Data.HashMap.Strict as HM
import Data.Ratio ((%))
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
import System.Random (randomIO, randomRIO)
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Config
import Mtlstats.Types
import qualified Types.MenuSpec as Menu
class Comparable a where
compareTest :: a -> a -> Spec
spec :: Spec
spec = describe "Mtlstats.Types" $ do
playerSpec
goalieSpec
gameStatsSpec
databaseSpec
gameStateLSpec
createPlayerStateLSpec
createGoalieStateLSpec
editPlayerStateLSpec
editGoalieStateLSpec
editStandingsModeLSpec
esmSubModeLSpec
teamScoreSpec
otherScoreSpec
homeTeamSpec
awayTeamSpec
gameWonSpec
gameLostSpec
gameTiedSpec
unaccountedPointsSpec
gmsGamesSpec
gmsPointsSpec
addGameStatsSpec
playerSearchSpec
playerSearchExactSpec
modifyPlayerSpec
playerSummarySpec
playerIsActiveSpec
psPointsSpec
addPlayerStatsSpec
goalieSearchSpec
goalieSearchExactSpec
goalieSummarySpec
goalieIsActiveSpec
addGoalieStatsSpec
gsAverageSpec
Menu.spec
playerSpec :: Spec
playerSpec = describe "Player" $ jsonSpec player playerJSON
goalieSpec :: Spec
goalieSpec = describe "Goalie" $ jsonSpec goalie goalieJSON
gameStatsSpec :: Spec
gameStatsSpec = describe "GameStats" $
jsonSpec (gameStats 1) (gameStatsJSON 1)
databaseSpec :: Spec
databaseSpec = describe "Database" $ jsonSpec db dbJSON
gameStateLSpec :: Spec
gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
-- getters
[ ( "missing state", MainMenu, newGameState )
, ( "home game", NewGame $ gs HomeGame, gs HomeGame )
, ( "away game", NewGame $ gs AwayGame, gs AwayGame )
]
-- setters
[ ( "set home", MainMenu, gs HomeGame )
, ( "home to away", NewGame $ gs HomeGame, gs AwayGame )
, ( "away to home", NewGame $ gs AwayGame, gs HomeGame )
, ( "clear home", NewGame $ gs HomeGame, newGameState )
, ( "clear away", NewGame $ gs AwayGame, newGameState )
]
where gs t = newGameState & gameType ?~ t
createPlayerStateLSpec :: Spec
createPlayerStateLSpec = describe "createPlayerStateL" $
lensSpec createPlayerStateL
-- getters
[ ( "missing state", MainMenu, newCreatePlayerState )
, ( "with state", CreatePlayer cps1, cps1 )
]
-- setters
[ ( "missing state", MainMenu, cps1 )
, ( "change state", CreatePlayer cps1, cps2 )
, ( "clear state", CreatePlayer cps1, newCreatePlayerState )
]
where
cps1 = newCreatePlayerState
& cpsNumber ?~ 1
& cpsName .~ "Joe"
& cpsPosition .~ "centre"
cps2 = newCreatePlayerState
& cpsNumber ?~ 2
& cpsName .~ "Bob"
& cpsPosition .~ "defense"
createGoalieStateLSpec :: Spec
createGoalieStateLSpec = describe "createGoalieStateL" $
lensSpec createGoalieStateL
-- getters
[ ( "missing state", MainMenu, newCreateGoalieState )
, ( "with state", CreateGoalie cgs1, cgs1 )
]
-- setters
[ ( "set state", MainMenu, cgs1 )
, ( "change state", CreateGoalie cgs1, cgs2 )
, ( "clear state", CreateGoalie cgs1, newCreateGoalieState )
]
where
cgs1 = newCreateGoalieState
& cgsNumber ?~ 1
& cgsName .~ "Joe"
cgs2 = newCreateGoalieState
& cgsNumber ?~ 2
& cgsName .~ "Bob"
editPlayerStateLSpec :: Spec
editPlayerStateLSpec = describe "editPlayerStateL" $
lensSpec editPlayerStateL
-- getters
[ ( "missing state", MainMenu, newEditPlayerState )
, ( "withState", EditPlayer eps1, eps1 )
]
-- setters
[ ( "set state", MainMenu, eps1 )
, ( "change state", EditPlayer eps1, eps2 )
, ( "clear state", EditPlayer eps1, newEditPlayerState )
]
where
eps1 = newEditPlayerState
& epsSelectedPlayer ?~ 1
eps2 = newEditPlayerState
& epsSelectedPlayer ?~ 2
editGoalieStateLSpec :: Spec
editGoalieStateLSpec = describe "editGoalieStateL" $
lensSpec editGoalieStateL
-- getters
[ ( "missing state", MainMenu, newEditGoalieState )
, ( "with state", EditGoalie egs1, egs1 )
]
-- setters
[ ( "set state", MainMenu, egs1 )
, ( "change state", EditGoalie egs1, egs2 )
, ( "clear state", EditGoalie egs1, newEditGoalieState )
]
where
egs1 = newEditGoalieState
& egsSelectedGoalie ?~ 1
egs2 = newEditGoalieState
& egsSelectedGoalie ?~ 2
editStandingsModeLSpec :: Spec
editStandingsModeLSpec = describe "editStandingsModeL" $
lensSpec editStandingsModeL
-- getters
[ ( "missing mode", MainMenu, menu )
, ( "with mode", EditStandings home, home )
]
-- setters
[ ( "set mode", MainMenu, home )
, ( "change mode", EditStandings home, away )
]
where
menu = ESMMenu
home = ESMHome ESMSubMenu
away = ESMAway ESMSubMenu
esmSubModeLSpec :: Spec
esmSubModeLSpec = describe "esmSubModeL" $ do
context "getters" $ mapM_
(\(label, mode, expected) -> context label $
it ("should be " ++ show expected) $
mode^.esmSubModeL `shouldBe` expected)
-- label, mode, expected
[ ( "no state", ESMMenu, ESMSubMenu )
, ( "with state", ESMHome ESMEditWins, ESMEditWins )
]
context "setters" $ mapM_
(\(label, mode, expected) -> context label $
it ("should be " ++ show expected) $ let
mode' = mode & esmSubModeL .~ ESMEditWins
in mode' `shouldBe` expected)
-- label, mode, expected
[ ( "no state", ESMMenu, ESMMenu )
, ( "home mode", ESMHome ESMSubMenu, ESMHome ESMEditWins )
, ( "away mode", ESMAway ESMSubMenu, ESMAway ESMEditWins )
]
teamScoreSpec :: Spec
teamScoreSpec = describe "teamScore" $ do
let
s t = newGameState
& gameType ?~ t
& homeScore ?~ 1
& awayScore ?~ 2
context "unknown game type" $
it "should return Nothing" $
teamScore newGameState `shouldBe` Nothing
context "HomeGame" $
it "should return 1" $
teamScore (s HomeGame) `shouldBe` Just 1
context "AwayGame" $
it "should return 2" $
teamScore (s AwayGame) `shouldBe` Just 2
otherScoreSpec :: Spec
otherScoreSpec = describe "otherScore" $ do
let
s t = newGameState
& gameType ?~ t
& homeScore ?~ 1
& awayScore ?~ 2
context "unknown game type" $
it "should return Nothing" $
otherScore newGameState `shouldBe` Nothing
context "HomeGame" $
it "should return 2" $
otherScore (s HomeGame) `shouldBe` Just 2
context "AwayGame" $
it "should return 1" $
otherScore (s AwayGame) `shouldBe` Just 1
jsonSpec
:: (Eq a, Show a, FromJSON a, ToJSON a)
=> a
-> Value
-> Spec
jsonSpec x j = do
describe "decode" $
it "should decode" $
decode (encode j) `shouldBe` Just x
describe "toJSON" $
it "should encode" $
decode (encode $ toJSON x) `shouldBe` Just x
describe "toEncoding" $
it "should encode" $
decode (encode x) `shouldBe` Just x
lensSpec
:: Comparable a
=> Lens' s a
-> [(String, s, a)]
-> [(String, s, a)]
-> Spec
lensSpec lens getters setters = do
context "getters" $ mapM_
(\(label, s, x) -> context label $
compareTest (s^.lens) x)
getters
context "setters" $ mapM_
(\(label, s, x) -> context label $ let
s' = s & lens .~ x
in compareTest (s'^.lens) x)
setters
player :: Player
player = newPlayer 1 "Joe" "centre"
& pRookie .~ False
& pYtd .~ playerStats 1
& pLifetime .~ playerStats 2
playerJSON :: Value
playerJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String) )
, ( "position", toJSON ("centre" :: String) )
, ( "rookie", toJSON False )
, ( "active", toJSON True )
, ( "ytd", playerStatsJSON 1 )
, ( "lifetime", playerStatsJSON 2 )
]
playerStats :: Int -> PlayerStats
playerStats n = newPlayerStats
& psGoals .~ n
& psAssists .~ n + 1
& psPMin .~ n + 2
playerStatsJSON :: Int -> Value
playerStatsJSON n = Object $ HM.fromList
[ ( "goals", toJSON n )
, ( "assists", toJSON $ n + 1 )
, ( "penalty_mins", toJSON $ n + 2 )
]
goalie :: Goalie
goalie = newGoalie 1 "Joe"
& gRookie .~ False
& gYtd .~ goalieStats 1
& gLifetime .~ goalieStats 2
goalieJSON :: Value
goalieJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String ) )
, ( "rookie", toJSON False )
, ( "active", toJSON True )
, ( "ytd", goalieStatsJSON 1 )
, ( "lifetime", goalieStatsJSON 2 )
]
goalieStats :: Int -> GoalieStats
goalieStats n = newGoalieStats
& gsGames .~ n
& gsMinsPlayed .~ n + 1
& gsGoalsAllowed .~ n + 2
& gsShutouts .~ n + 3
& gsWins .~ n + 4
& gsLosses .~ n + 5
& gsTies .~ n + 6
goalieStatsJSON :: Int -> Value
goalieStatsJSON n = Object $ HM.fromList
[ ( "games", toJSON n )
, ( "mins_played", toJSON $ n + 1 )
, ( "goals_allowed", toJSON $ n + 2 )
, ( "shutouts", toJSON $ n + 3 )
, ( "wins", toJSON $ n + 4 )
, ( "losses", toJSON $ n + 5 )
, ( "ties", toJSON $ n + 6 )
]
gameStats :: Int -> GameStats
gameStats n = GameStats
{ _gmsWins = n
, _gmsLosses = n + 1
, _gmsOvertime = n + 2
, _gmsGoalsFor = n + 3
, _gmsGoalsAgainst = n + 4
}
gameStatsJSON :: Int -> Value
gameStatsJSON n = Object $ HM.fromList
[ ( "wins", toJSON n )
, ( "losses", toJSON $ n + 1 )
, ( "overtime", toJSON $ n + 2 )
, ( "goals_for", toJSON $ n + 3 )
, ( "goals_against", toJSON $ n + 4 )
]
db :: Database
db = newDatabase
& dbPlayers .~ [player]
& dbGoalies .~ [goalie]
& dbGames .~ 1
& dbHomeGameStats .~ gameStats 1
& dbAwayGameStats .~ gameStats 2
dbJSON :: Value
dbJSON = Object $ HM.fromList
[ ( "players", toJSON [playerJSON] )
, ( "goalies", toJSON [goalieJSON] )
, ( "games", toJSON (1 :: Int) )
, ( "home_game_stats", gameStatsJSON 1 )
, ( "away_game_stats", gameStatsJSON 2 )
]
homeTeamSpec :: Spec
homeTeamSpec = describe "homeTeam" $ do
let
gs gt = newGameState
& gameType .~ gt
& otherTeam .~ "foo"
context "unknown game type" $
it "should return an empty string" $
homeTeam (gs Nothing) `shouldBe` ""
context "home game" $
it ("should return " ++ show myTeam) $
homeTeam (gs $ Just HomeGame) `shouldBe` myTeam
context "away game" $
it "should return \"foo\"" $
homeTeam (gs $ Just AwayGame) `shouldBe` "foo"
awayTeamSpec :: Spec
awayTeamSpec = describe "awayTeam" $ do
let
gs gt = newGameState
& gameType .~ gt
& otherTeam .~ "foo"
context "unknown game type" $
it "should return an empty string" $
awayTeam (gs Nothing) `shouldBe` ""
context "home game" $
it "should return \"foo\"" $
awayTeam (gs $ Just HomeGame) `shouldBe` "foo"
context "away game" $
it ("should return " ++ show myTeam) $
awayTeam (gs $ Just AwayGame) `shouldBe` myTeam
gameWonSpec :: Spec
gameWonSpec = describe "gameWon" $ mapM_
(\(t, h, a, expected) -> let
desc = "game type: " ++ show t ++
", home score: " ++ show h ++
", away score: " ++ show a
gs = newGameState
& gameType .~ t
& homeScore .~ h
& awayScore .~ a
in context desc $
it ("should be " ++ show expected) $
gameWon gs `shouldBe` expected)
-- gameType, homeScore, awayScore, expected
[ ( Just HomeGame, Just 1, Just 1, Just False )
, ( Just HomeGame, Just 1, Just 2, Just False )
, ( Just HomeGame, Just 2, Just 1, Just True )
, ( Just AwayGame, Just 1, Just 1, Just False )
, ( Just AwayGame, Just 1, Just 2, Just True )
, ( Just AwayGame, Just 2, Just 1, Just False )
, ( Nothing, Just 1, Just 2, Nothing )
, ( Just HomeGame, Nothing, Just 1, Nothing )
, ( Just AwayGame, Nothing, Just 1, Nothing )
, ( Just HomeGame, Just 1, Nothing, Nothing )
, ( Just AwayGame, Just 1, Nothing, Nothing )
, ( Nothing, Nothing, Nothing, Nothing )
]
gameLostSpec :: Spec
gameLostSpec = describe "gameLost" $ mapM_
(\(t, h, a, ot, expected) -> let
desc = "game type: " ++ show t ++
", home score: " ++ show h ++
", away score: " ++ show a ++
", overtimr flag: " ++ show ot
gs = newGameState
& gameType .~ t
& homeScore .~ h
& awayScore .~ a
& overtimeFlag .~ ot
in context desc $
it ("should be " ++ show expected) $
gameLost gs `shouldBe` expected)
-- gameType, homeScore, awayScore, overtimeFlag, expected
[ ( Just HomeGame, Just 1, Just 1, Just False, Just False )
, ( Just HomeGame, Just 1, Just 2, Just False, Just True )
, ( Just HomeGame, Just 1, Just 2, Just True, Just False )
, ( Just HomeGame, Just 2, Just 1, Just False, Just False )
, ( Just AwayGame, Just 1, Just 1, Just False, Just False )
, ( Just AwayGame, Just 1, Just 2, Just False, Just False )
, ( Just AwayGame, Just 2, Just 1, Just False, Just True )
, ( Just AwayGame, Just 2, Just 1, Just True, Just False )
, ( Nothing, Just 1, Just 2, Just False, Nothing )
, ( Just HomeGame, Nothing, Just 1, Just False, Nothing )
, ( Just AwayGame, Nothing, Just 1, Just False, Nothing )
, ( Just HomeGame, Just 1, Nothing, Just False, Nothing )
, ( Just AwayGame, Just 1, Nothing, Just False, Nothing )
, ( Just HomeGame, Just 1, Just 2, Nothing, Nothing )
, ( Just AwayGame, Just 1, Just 2, Nothing, Nothing )
, ( Nothing, Nothing, Nothing, Just False, Nothing )
]
gameTiedSpec :: Spec
gameTiedSpec = describe "gameTied" $ mapM_
(\(home, away, expected) -> let
desc = "home score: " ++ show home ++
", away score: " ++ show away
gs = newGameState
& homeScore .~ home
& awayScore .~ away
in context desc $
it ("should be " ++ show expected) $
gameTied gs `shouldBe` expected)
[ ( Nothing, Nothing, Nothing )
, ( Nothing, Just 1, Nothing )
, ( Just 1, Nothing, Nothing )
, ( Just 1, Just 1, Just True )
, ( Just 1, Just 2, Just False )
]
unaccountedPointsSpec :: Spec
unaccountedPointsSpec = describe "unaccounted points" $ do
context "no data" $
it "should return Nothing" $
unaccountedPoints newGameState `shouldBe` Nothing
context "unaccounted points" $
it "should return True" $ let
gs = newGameState
& gameType ?~ HomeGame
& homeScore ?~ 1
in unaccountedPoints gs `shouldBe` Just True
context "all points accounted" $
it "should return False" $ let
gs = newGameState
& gameType ?~ HomeGame
& homeScore ?~ 1
& pointsAccounted .~ 1
in unaccountedPoints gs `shouldBe` Just False
context "more points accounted" $
it "should return True" $ let
gs = newGameState
& gameType ?~ HomeGame
& homeScore ?~ 1
& pointsAccounted .~ 2
in unaccountedPoints gs `shouldBe` Just False
gmsGamesSpec :: Spec
gmsGamesSpec = describe "gmsGames" $ mapM_
(\(w, l, ot, expected) -> let
desc = "wins: " ++ show w ++
", losses: " ++ show l ++
", overtime: " ++ show ot
gs = newGameStats
& gmsWins .~ w
& gmsLosses .~ l
& gmsOvertime .~ ot
in context desc $
it ("should be " ++ show expected) $
gmsGames gs `shouldBe` expected)
-- wins, losses, overtime, expected
[ ( 0, 0, 0, 0 )
, ( 1, 0, 0, 1 )
, ( 0, 1, 0, 1 )
, ( 0, 0, 1, 1 )
, ( 1, 1, 1, 3 )
, ( 2, 3, 5, 10 )
]
gmsPointsSpec :: Spec
gmsPointsSpec = describe "gmsPoints" $ mapM_
(\(w, l, ot, expected) -> let
gs
= newGameStats
& gmsWins .~ w
& gmsLosses .~ l
& gmsOvertime .~ ot
in context (show gs) $
it ("should be " ++ show expected) $
gmsPoints gs `shouldBe` expected)
-- wins, losses, overtime, expected
[ ( 0, 0, 0, 0 )
, ( 1, 0, 0, 2 )
, ( 0, 1, 0, 0 )
, ( 0, 1, 1, 1 )
, ( 1, 1, 1, 3 )
, ( 2, 4, 3, 7 )
]
addGameStatsSpec :: Spec
addGameStatsSpec = describe "addGameStats" $
it "should add the values" $ let
s1 = GameStats
{ _gmsWins = 1
, _gmsLosses = 2
, _gmsOvertime = 3
, _gmsGoalsFor = 4
, _gmsGoalsAgainst = 5
}
s2 = GameStats
{ _gmsWins = 6
, _gmsLosses = 7
, _gmsOvertime = 8
, _gmsGoalsFor = 9
, _gmsGoalsAgainst = 10
}
expected = GameStats
{ _gmsWins = 7
, _gmsLosses = 9
, _gmsOvertime = 11
, _gmsGoalsFor = 13
, _gmsGoalsAgainst = 15
}
in addGameStats s1 s2 `shouldBe` expected
playerSearchSpec :: Spec
playerSearchSpec = describe "playerSearch" $ mapM_
(\(sStr, expected) -> context sStr $
it ("should return " ++ show expected) $ let
ps = [joe, bob, steve]
in playerSearch sStr ps `shouldBe` expected)
-- search, result
[ ( "joe", [(0, joe)] )
, ( "o", [(0, joe), (1, bob)] )
, ( "e", [(0, joe), (2, steve)] )
, ( "x", [] )
]
playerSearchExactSpec :: Spec
playerSearchExactSpec = describe "playerSearchExact" $ mapM_
(\(sStr, expected) -> context sStr $
it ("should be " ++ show expected) $ let
ps = [joe, bob, steve]
in playerSearchExact sStr ps `shouldBe` expected)
-- search, result
[ ( "Joe", Just (0, joe) )
, ( "Bob", Just (1, bob) )
, ( "Steve", Just (2, steve) )
, ( "Sam", Nothing )
, ( "", Nothing )
]
modifyPlayerSpec :: Spec
modifyPlayerSpec = describe "modifyPlayer" $ mapM_
(\(name, j, b, s) -> let
modifier = pLifetime.psGoals .~ 1
players = modifyPlayer modifier name [joe, bob, steve]
in context ("modify " ++ name) $ do
context "Joe's lifetime goals" $
it ("should be " ++ show j) $
head players^.pLifetime.psGoals `shouldBe` j
context "Bob's lifetime goals" $
it ("should be " ++ show b) $
(players !! 1)^.pLifetime.psGoals `shouldBe` b
context "Steve's lifetime goals" $
it ("should be " ++ show s) $
last players^.pLifetime.psGoals `shouldBe` s)
-- player name, Joe's goals, Bob's goals, Steve's goals
[ ( "Joe", 1, 0, 0 )
, ( "Bob", 0, 1, 0 )
, ( "Steve", 0, 0, 1 )
, ( "Sam", 0, 0, 0 )
]
playerSummarySpec :: Spec
playerSummarySpec = describe "playerSummary" $
it "should be \"Joe (2) center\"" $
playerSummary joe `shouldBe` "Joe (2) center"
playerIsActiveSpec :: Spec
playerIsActiveSpec = describe "playerIsActive" $ do
let
pStats = newPlayerStats
& psGoals .~ 10
& psAssists .~ 11
& psPMin .~ 12
p = newPlayer 1 "Joe" "centre" & pLifetime .~ pStats
mapM_
(\(label, p', expected) -> context label $
it ("should be " ++ show expected) $
playerIsActive p' `shouldBe` expected)
-- label, player, expected
[ ( "not active", p, False )
, ( "has goal", p & pYtd.psGoals .~ 1, True )
, ( "has assist", p & pYtd.psAssists .~ 1, True )
, ( "has penalty minute", p & pYtd.psPMin .~ 1, True )
]
psPointsSpec :: Spec
psPointsSpec = describe "psPoints" $ mapM_
(\(goals, assists, points) -> let
desc = "goals: " ++ show goals ++
", assists: " ++ show assists
stats = newPlayerStats &
psGoals .~ goals &
psAssists .~ assists
in context desc $
it ("should be " ++ show points) $
psPoints stats `shouldBe` points)
-- goals, assists, points
[ ( 0, 0, 0 )
, ( 1, 0, 1 )
, ( 0, 1, 1 )
, ( 2, 3, 5 )
]
addPlayerStatsSpec :: Spec
addPlayerStatsSpec = describe "addPlayerStats" $ do
let
s1
= newPlayerStats
& psGoals .~ 1
& psAssists .~ 2
& psPMin .~ 3
s2
= newPlayerStats
& psGoals .~ 4
& psAssists .~ 5
& psPMin .~ 6
s3 = addPlayerStats s1 s2
describe "psGoals" $
it "should be 5" $
s3^.psGoals `shouldBe` 5
describe "psAssists" $
it "should be 7" $
s3^.psAssists `shouldBe` 7
describe "psPMin" $
it "should be 9" $
s3^.psPMin `shouldBe` 9
goalieSearchSpec :: Spec
goalieSearchSpec = describe "goalieSearch" $ do
let
goalies =
[ newGoalie 2 "Joe"
, newGoalie 3 "Bob"
, newGoalie 5 "Steve"
]
result n = (n, goalies!!n)
context "partial match" $
it "should return Joe and Steve" $
goalieSearch "e" goalies `shouldBe` [result 0, result 2]
context "no match" $
it "should return an empty list" $
goalieSearch "x" goalies `shouldBe` []
context "exact match" $
it "should return Bob" $
goalieSearch "bob" goalies `shouldBe` [result 1]
goalieSearchExactSpec :: Spec
goalieSearchExactSpec = describe "goalieSearchExact" $ do
let
goalies =
[ newGoalie 2 "Joe"
, newGoalie 3 "Bob"
, newGoalie 5 "Steve"
]
result n = (n, goalies!!n)
mapM_
(\(name, num) -> context name $
it ("should return " ++ name) $
goalieSearchExact name goalies `shouldBe` Just (result num))
-- name, num
[ ( "Joe", 0 )
, ( "Bob", 1 )
, ( "Steve", 2 )
]
context "Greg" $
it "should return Nothing" $
goalieSearchExact "Greg" goalies `shouldBe` Nothing
goalieSummarySpec :: Spec
goalieSummarySpec = describe "goalieSummary" $
it "should provide a summary string" $
goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)"
goalieIsActiveSpec :: Spec
goalieIsActiveSpec = describe "goalieIsActive" $ mapM_
(\(label, input, expected) -> context label $
it ("should be " ++ show expected) $
goalieIsActive input `shouldBe` expected)
-- label, input, expected
[ ( "inactive", inactive, False )
, ( "active", active, True )
]
where
inactive = newGoalie 1 "Joe"
& gLifetime.gsMinsPlayed .~ 1
active = inactive
& gYtd.gsMinsPlayed .~ 1
addGoalieStatsSpec :: Spec
addGoalieStatsSpec = describe "addGoalieStats" $ let
g1 = GoalieStats
{ _gsGames = 1
, _gsMinsPlayed = 2
, _gsGoalsAllowed = 3
, _gsShutouts = 4
, _gsWins = 5
, _gsLosses = 6
, _gsTies = 7
}
g2 = GoalieStats
{ _gsGames = 8
, _gsMinsPlayed = 9
, _gsGoalsAllowed = 10
, _gsShutouts = 11
, _gsWins = 12
, _gsLosses = 13
, _gsTies = 14
}
expected = GoalieStats
{ _gsGames = 9
, _gsMinsPlayed = 11
, _gsGoalsAllowed = 13
, _gsShutouts = 15
, _gsWins = 17
, _gsLosses = 19
, _gsTies = 21
}
actual = g1 `addGoalieStats` g2
in it ("should be " ++ show expected) $
actual `shouldBe` expected
gsAverageSpec :: Spec
gsAverageSpec = describe "gsAverage" $ mapM_
(\(label, stats, expected) -> context label $
it ("should be " ++ show expected) $
gsAverage stats `shouldBe` expected)
-- label, stats, expected
[ ( "with minutes", gs, 3 % 2 )
, ( "no minutes", newGoalieStats , 0 )
]
where
gs = newGoalieStats
& gsMinsPlayed .~ 2 * gameLength
& gsGoalsAllowed .~ 3
joe :: Player
joe = newPlayer 2 "Joe" "center"
bob :: Player
bob = newPlayer 3 "Bob" "defense"
steve :: Player
steve = newPlayer 5 "Steve" "forward"
-- | Creates a 'Player'
makePlayer :: IO Player
makePlayer = Player
<$> makeNum
<*> makeName
<*> makeName
<*> makeBool
<*> makeBool
<*> makePlayerStats
<*> makePlayerStats
-- | Creates a 'Goalie'
makeGoalie :: IO Goalie
makeGoalie = Goalie
<$> makeNum
<*> makeName
<*> makeBool
<*> makeBool
<*> makeGoalieStats
<*> makeGoalieStats
-- | Creates a 'PlayerStats' value
makePlayerStats :: IO PlayerStats
makePlayerStats = PlayerStats
<$> makeNum
<*> makeNum
<*> makeNum
-- | Creates a 'GoalieStats' value
makeGoalieStats :: IO GoalieStats
makeGoalieStats = GoalieStats
<$> makeNum
<*> makeNum
<*> makeNum
<*> makeNum
<*> makeNum
<*> makeNum
<*> makeNum
makeNum :: IO Int
makeNum = randomRIO (1, 10)
makeBool :: IO Bool
makeBool = randomIO
makeName :: IO String
makeName = replicateM 10 $ randomRIO ('A', 'Z')
instance Comparable GoalieStats where
compareTest actual expected = mapM_
(\(name, lens) -> describe name $
it ("should be " ++ show (expected^.lens)) $
actual^.lens `shouldBe` expected^.lens)
-- name, lens
[ ( "gsGames", gsGames )
, ( "gsMinsPlayed", gsMinsPlayed )
, ( "gsGoalsAllowed", gsGoalsAllowed )
, ( "gsWins", gsWins )
, ( "gsLosses", gsLosses )
, ( "gsTies", gsTies )
]
instance Comparable GameState where
compareTest actual expected =
it ("should be " ++ show expected) $
actual `shouldBe` expected
instance Comparable CreatePlayerState where
compareTest actual expected = do
describe "cpsNumber" $
it ("should be " ++ show (expected^.cpsNumber)) $
actual^.cpsNumber `shouldBe` expected^.cpsNumber
describe "cpsName" $
it ("should be " ++ expected^.cpsName) $
actual^.cpsName `shouldBe` expected^.cpsName
describe "cpsPosition" $
it ("should be " ++ expected^.cpsPosition) $
actual^.cpsPosition `shouldBe` expected^.cpsPosition
instance Comparable EditPlayerState where
compareTest actual expected = do
describe "epsSelectedPlayer" $
it ("should be " ++ show (expected^.epsSelectedPlayer)) $
actual^.epsSelectedPlayer `shouldBe` expected^.epsSelectedPlayer
describe "epsMode" $
it ("should be " ++ show (expected^.epsMode)) $
actual^.epsMode `shouldBe` expected^.epsMode
instance Comparable EditGoalieState where
compareTest actual expected = do
describe "egsSelectedGoalie" $
it ("should be " ++ show (expected^.egsSelectedGoalie)) $
actual^.egsSelectedGoalie `shouldBe` expected^.egsSelectedGoalie
describe "egsMode" $
it ("should be " ++ show (expected^.egsMode)) $
actual^.egsMode `shouldBe` expected^.egsMode
instance Comparable CreateGoalieState where
compareTest actual expected = do
describe "cgsNuber" $
it("should be " ++ show (expected^.cgsNumber)) $
actual^.cgsNumber `shouldBe` expected^.cgsNumber
describe "cgsName" $
it ("should be " ++ expected^.cgsName) $
actual^.cgsName `shouldBe` expected^.cgsName
instance Comparable EditStandingsMode where
compareTest actual expected =
it ("should be " ++ show expected) $
actual `shouldBe` expected