mtlstats/test/TypesSpec.hs
2021-05-08 12:21:41 -04:00

1194 lines
35 KiB
Haskell

{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 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 FlexibleInstances, 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.Map.Lazy as M
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
activePlayerSearchSpec
playerSearchExactSpec
modifyPlayerSpec
playerSummarySpec
playerIsActiveSpec
psPointsSpec
addPlayerStatsSpec
goalieSearchSpec
activeGoalieSearchSpec
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", [] )
]
activePlayerSearchSpec :: Spec
activePlayerSearchSpec = describe "activePlayerSearch" $ mapM_
(\(sStr, expected) -> context sStr $
it ("should return " ++ show expected) $ let
ps = [joe, bob, steve & pActive .~ False]
in activePlayerSearch sStr ps `shouldBe` expected)
-- search, result
[ ( "joe", [(0, joe)] )
, ( "o", [(0, joe), (1, bob)] )
, ( "e", [(0, joe)] )
, ( "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]
activeGoalieSearchSpec :: Spec
activeGoalieSearchSpec = describe "activeGoalieSearch" $ do
let
goalies =
[ newGoalie 2 "Joe"
, newGoalie 3 "Bob"
, newGoalie 5 "Steve" & gActive .~ False
]
result n = (n, goalies!!n)
context "partial match" $
it "should return Joe" $
activeGoalieSearch "e" goalies `shouldBe` [result 0]
context "no match" $
it "should return an empty list" $
activeGoalieSearch "x" goalies `shouldBe` []
context "exact match" $
it "should return Bob" $
activeGoalieSearch "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 ProgState where
compareTest act expect = do
compareLenses "database" database act expect
compareLenses "progMode" progMode act expect
compareLenses "dbName" dbName act expect
compareLenses "inputBuffer" inputBuffer act expect
compareLenses "scrollOffset" scrollOffset act expect
instance Comparable ProgMode where
compareTest TitleScreen TitleScreen = return ()
compareTest MainMenu MainMenu = return ()
compareTest (NewSeason act) (NewSeason expect) =
context "NewSeason flag" $
act `compareTest` expect
compareTest (NewGame act) (NewGame expect) =
context "NewGame GameState" $
act `compareTest` expect
compareTest EditMenu EditMenu = return ()
compareTest (CreatePlayer act) (CreatePlayer expect) =
context "CreatePlayer CreatePlayerState" $
act `compareTest` expect
compareTest (CreateGoalie act) (CreateGoalie expect) =
context "CreateGoalie CreateGoalieState" $
act `compareTest` expect
compareTest (EditPlayer act) (EditPlayer expect) =
context "EditPlayer EditPlayerState" $
act `compareTest` expect
compareTest (EditGoalie act) (EditGoalie expect) =
context "EditGoalie EditGoalieState" $
act `compareTest` expect
compareTest (EditStandings act) (EditStandings expect) =
context "EditStandings EditStandingsMode" $
act `compareTest` expect
compareTest _ _ = fail "ProgMode mismatch"
instance Comparable GameState where
compareTest act expect = do
compareLenses "gameYear" gameYear act expect
compareLenses "gameMonth" gameMonth act expect
compareLenses "gameDay" gameDay act expect
compareLenses "gameType" gameType act expect
compareLenses "otherTeam" otherTeam act expect
compareLenses "homeScore" homeScore act expect
compareLenses "awayScore" awayScore act expect
compareLenses "overtimeFlag" overtimeFlag act expect
compareLenses "dataVerified" dataVerified act expect
compareLenses "pointsAccounted" pointsAccounted act expect
compareLenses "goalBy" goalBy act expect
compareLenses "assistsBy" assistsBy act expect
compareLenses "gamePlayerStats" gamePlayerStats act expect
compareLenses "confirmGoalDataGlag" confirmGoalDataFlag act expect
compareLenses "gameSelectedPlayer" gameSelectedPlayer act expect
compareLenses "gamePMinsRecorded" gamePMinsRecorded act expect
compareLenses "gameGoalieStats" gameGoalieStats act expect
compareLenses "gameSelectedGoalie" gameSelectedGoalie act expect
compareLenses "gameGoalieMinsPlayed" gameGoalieMinsPlayed act expect
compareLenses "gameGoalsAllowed" gameGoalsAllowed act expect
compareLenses "gameGoaliesRecorded" gameGoaliesRecorded act expect
compareLenses "gameGoalieAssigned" gameGoalieAssigned act expect
instance Comparable Database where
compareTest act expect = do
compareLenses "dbPlayers" dbPlayers act expect
compareLenses "dbGoalies" dbGoalies act expect
compareLenses "dbGames" dbGames act expect
compareLenses "dbHomeGameStats" dbHomeGameStats act expect
compareLenses "dbAwayGameStats" dbAwayGameStats act expect
instance Comparable Player where
compareTest act expect = do
compareLenses "pNumber" pNumber act expect
compareLenses "pName" pName act expect
compareLenses "pPosition" pPosition act expect
compareLenses "pRookie" pRookie act expect
compareLenses "pActive" pActive act expect
compareLenses "pYtd" pYtd act expect
compareLenses "pLifetime" pLifetime act expect
instance Comparable [Player] where
compareTest = compareLists
instance Comparable PlayerStats where
compareTest act expect = do
compareLenses "psGoals" psGoals act expect
compareLenses "psAssists" psAssists act expect
compareLenses "psPMin" psPMin act expect
instance Comparable Goalie where
compareTest act expect = do
compareLenses "gNumber" gNumber act expect
compareLenses "gName" gName act expect
compareLenses "gRookie" gRookie act expect
compareLenses "gActive" gActive act expect
compareLenses "gYtd" gYtd act expect
compareLenses "gLifetime" gLifetime act expect
instance Comparable [Goalie] where
compareTest = compareLists
instance Comparable GoalieStats where
compareTest act expect = do
compareLenses "gsGames" gsGames act expect
compareLenses "gsMisPlayed" gsMinsPlayed act expect
compareLenses "gsGoalsAllowed" gsGoalsAllowed act expect
compareLenses "gsWins" gsWins act expect
compareLenses "gsLosses" gsLosses act expect
compareLenses "gsTies" gsTies act expect
instance Comparable GameStats where
compareTest act expect = do
compareLenses "gmsWins" gmsWins act expect
compareLenses "gmsLosses" gmsLosses act expect
compareLenses "gmsOvertime" gmsOvertime act expect
compareLenses "gmsGoalsFor" gmsGoalsFor act expect
compareLenses "gmsGoalsAgainst" gmsGoalsAgainst act expect
instance Comparable GameType where
compareTest = compareVals
instance Comparable CreatePlayerState where
compareTest act expect = do
compareLenses "cpsNumber" cpsNumber act expect
compareLenses "cpsName" cpsName act expect
compareLenses "cpsPosition" cpsPosition act expect
instance Comparable EditPlayerState where
compareTest act expect = do
compareLenses "epsSelectedPlayer" epsSelectedPlayer act expect
compareLenses "epsMode" epsMode act expect
instance Comparable EditPlayerMode where
compareTest = compareVals
instance Comparable EditGoalieState where
compareTest act expect = do
compareLenses "egsSelectedGoalie" egsSelectedGoalie act expect
compareLenses "egsMode" egsMode act expect
instance Comparable EditGoalieMode where
compareTest = compareVals
instance Comparable CreateGoalieState where
compareTest act expect = do
compareLenses "cgsNumber" cgsNumber act expect
compareLenses "cgsName" cgsName act expect
instance Comparable EditStandingsMode where
compareTest = compareVals
instance Comparable Int where
compareTest = compareVals
instance Comparable Bool where
compareTest = compareVals
instance Comparable String where
compareTest = compareVals
instance Comparable [Int] where
compareTest = compareLists
instance Comparable a => Comparable (Maybe a) where
compareTest Nothing Nothing = return ()
compareTest (Just a) (Just e) = a `compareTest` e
compareTest Nothing (Just _) = error "Unexpectedly received a value"
compareTest (Just _) Nothing = error "Received Nothing"
instance (Ord k, Show k, Comparable v) => Comparable (M.Map k v) where
compareTest actM expectM = do
context "number of elements" $
length actM `compareVals` length expectM
context "check values" $
mapM_
( \k -> context (show k) $
M.lookup k actM `compareTest` M.lookup k expectM
) $ M.keys actM
compareLists :: (Comparable a) => [a] -> [a] -> Spec
compareLists acts expects = do
let
aLen = length acts
eLen = length expects
context "count elements" $
it ("should be " ++ show eLen) $
aLen `shouldBe` eLen
context "compare elements" $
mapM_
( \(n, act, expect) ->
context ("element " ++ show n) $
expect `compareTest` act
) $ zip3 ([0..] :: [Int]) acts expects
compareVals :: (Eq a, Show a) => a -> a -> Spec
compareVals expect act =
it ("should be " ++ show expect) $
act `shouldBe` expect
compareLenses
:: Comparable b
=> String
-> Lens' a b
-> a
-> a
-> Spec
compareLenses label lens act expect =
describe label $
(act^.lens) `compareTest` (expect^.lens)