{- mtlstats Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe 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 . -} {-# 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 , expectationFailure , 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 _ _ = it "should be the expected mode" $ expectationFailure "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)