mtlstats/test/TypesSpec.hs

901 lines
25 KiB
Haskell
Raw Normal View History

2019-08-20 11:31:03 -04:00
{-
mtlstats
Copyright (C) 2019 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/>.
-}
2019-08-27 22:10:03 -04:00
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
2019-08-10 10:01:36 -04:00
module TypesSpec
( Comparable (..)
, spec
, makePlayer
, makeGoalie
, makePlayerStats
, makeGoalieStats
) where
import Control.Monad (replicateM)
2019-08-26 23:55:02 -04:00
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
import Data.Aeson.Types (Value (Object))
import qualified Data.HashMap.Strict as HM
2019-08-27 22:10:03 -04:00
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
import System.Random (randomRIO)
2019-08-09 11:06:13 -04:00
import Test.Hspec (Spec, context, describe, it, shouldBe)
2019-08-26 23:55:02 -04:00
2019-09-02 18:50:21 -04:00
import Mtlstats.Config
2019-08-09 11:06:13 -04:00
import Mtlstats.Types
2019-08-21 00:21:22 -04:00
import qualified Types.MenuSpec as Menu
2019-10-24 00:33:01 -04:00
class Comparable a where
compareTest :: a -> a -> Spec
2019-08-09 11:06:13 -04:00
spec :: Spec
2019-08-10 10:01:36 -04:00
spec = describe "Mtlstats.Types" $ do
playerSpec
2019-08-11 10:24:39 -04:00
goalieSpec
2019-08-26 10:20:10 -04:00
gameStatsSpec
2019-08-16 11:49:04 -04:00
databaseSpec
2019-08-28 01:04:03 -04:00
gameStateLSpec
2019-09-09 11:43:37 -04:00
createPlayerStateLSpec
2019-10-24 09:48:47 -04:00
createGoalieStateLSpec
2019-11-01 03:42:51 -04:00
editPlayerStateLSpec
2019-11-11 20:00:41 -05:00
editGoalieStateLSpec
teamScoreSpec
2019-08-27 12:06:53 -04:00
otherScoreSpec
2019-09-02 18:50:21 -04:00
homeTeamSpec
awayTeamSpec
2019-08-28 13:02:50 -04:00
gameWonSpec
2019-08-30 00:44:40 -04:00
gameLostSpec
2019-08-28 01:47:30 -04:00
gameTiedSpec
unaccountedPointsSpec
2019-09-03 14:15:29 -04:00
gmsGamesSpec
2019-08-30 18:57:56 -04:00
gmsPointsSpec
2019-08-31 09:33:26 -04:00
addGameStatsSpec
2019-09-18 01:55:38 -04:00
playerSearchSpec
2019-09-19 03:11:48 -04:00
playerSearchExactSpec
2019-09-25 02:28:48 -04:00
modifyPlayerSpec
2019-10-02 01:31:07 -04:00
playerSummarySpec
2019-11-01 05:40:01 -04:00
playerDetailsSpec
2019-10-15 00:51:42 -04:00
playerIsActiveSpec
2019-10-09 00:35:35 -04:00
psPointsSpec
2019-10-09 00:24:34 -04:00
addPlayerStatsSpec
2019-10-30 23:01:59 -04:00
goalieSearchSpec
2019-10-30 23:18:15 -04:00
goalieSearchExactSpec
2019-10-30 23:27:38 -04:00
goalieSummarySpec
2019-08-21 00:21:22 -04:00
Menu.spec
2019-08-09 11:06:13 -04:00
playerSpec :: Spec
2019-08-26 23:55:02 -04:00
playerSpec = describe "Player" $ jsonSpec player playerJSON
2019-08-26 23:55:02 -04:00
goalieSpec :: Spec
goalieSpec = describe "Goalie" $ jsonSpec goalie goalieJSON
2019-08-26 10:20:10 -04:00
gameStatsSpec :: Spec
gameStatsSpec = describe "GameStats" $
jsonSpec (gameStats 1) (gameStatsJSON 1)
2019-08-26 23:55:02 -04:00
databaseSpec :: Spec
databaseSpec = describe "Database" $ jsonSpec db dbJSON
2019-08-28 01:04:03 -04:00
gameStateLSpec :: Spec
gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
-- getters
2019-10-24 01:10:42 -04:00
[ ( "missing state", MainMenu, newGameState )
, ( "home game", NewGame $ gs HomeGame, gs HomeGame )
, ( "away game", NewGame $ gs AwayGame, gs AwayGame )
2019-08-28 01:04:03 -04:00
]
-- setters
2019-10-24 01:10:42 -04:00
[ ( "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 )
2019-08-28 01:04:03 -04:00
]
where gs t = newGameState & gameType ?~ t
2019-09-09 11:43:37 -04:00
createPlayerStateLSpec :: Spec
2019-10-24 09:47:48 -04:00
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"
2019-09-09 11:43:37 -04:00
2019-10-24 09:48:47 -04:00
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"
2019-11-01 03:42:51 -04:00
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
2019-11-11 20:00:41 -05:00
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
teamScoreSpec :: Spec
teamScoreSpec = describe "teamScore" $ do
let
2019-08-27 11:44:45 -04:00
s t = newGameState
& gameType ?~ t
& homeScore ?~ 1
& awayScore ?~ 2
2019-08-27 11:44:45 -04:00
context "unknown game type" $
it "should return Nothing" $
2019-08-27 11:44:45 -04:00
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
2019-08-27 12:06:53 -04:00
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
2019-08-26 23:55:02 -04:00
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
2019-08-27 22:10:03 -04:00
lensSpec
2019-10-24 01:10:42 -04:00
:: Comparable a
2019-08-27 22:10:03 -04:00
=> Lens' s a
2019-10-24 01:10:42 -04:00
-> [(String, s, a)]
-> [(String, s, a)]
2019-08-27 22:10:03 -04:00
-> Spec
2019-10-24 01:10:42 -04:00
lensSpec lens getters setters = do
2019-08-27 22:10:03 -04:00
context "getters" $ mapM_
2019-10-24 01:10:42 -04:00
(\(label, s, x) -> context label $
compareTest (s^.lens) x)
getters
2019-08-27 22:10:03 -04:00
context "setters" $ mapM_
2019-10-24 01:10:42 -04:00
(\(label, s, x) -> context label $ let
s' = s & lens .~ x
in compareTest (s'^.lens) x)
setters
2019-08-27 22:10:03 -04:00
2019-08-10 10:01:36 -04:00
player :: Player
player = newPlayer 1 "Joe" "centre"
2019-08-26 23:55:02 -04:00
& pYtd .~ playerStats 1
& pLifetime .~ playerStats 2
playerJSON :: Value
playerJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String) )
, ( "position", toJSON ("centre" :: String) )
, ( "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 )
]
2019-08-10 10:01:36 -04:00
2019-08-11 10:24:39 -04:00
goalie :: Goalie
goalie = newGoalie 1 "Joe"
2019-08-26 23:55:02 -04:00
& gYtd .~ goalieStats 1
& gLifetime .~ goalieStats 2
goalieJSON :: Value
goalieJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String ) )
, ( "ytd", goalieStatsJSON 1 )
, ( "lifetime", goalieStatsJSON 2 )
]
goalieStats :: Int -> GoalieStats
goalieStats n = newGoalieStats
& gsGames .~ n
& gsMinsPlayed .~ n + 1
& gsGoalsAllowed .~ n + 2
2019-10-19 00:58:41 -04:00
& gsWins .~ n + 3
& gsLosses .~ n + 4
& gsTies .~ n + 5
2019-08-26 23:55:02 -04:00
goalieStatsJSON :: Int -> Value
goalieStatsJSON n = Object $ HM.fromList
[ ( "games", toJSON n )
, ( "mins_played", toJSON $ n + 1 )
, ( "goals_allowed", toJSON $ n + 2 )
2019-10-19 00:58:41 -04:00
, ( "wins", toJSON $ n + 3 )
, ( "losses", toJSON $ n + 4 )
, ( "ties", toJSON $ n + 5 )
2019-08-26 23:55:02 -04:00
]
2019-08-11 10:24:39 -04:00
2019-08-26 10:20:10 -04:00
gameStats :: Int -> GameStats
gameStats n = GameStats
{ _gmsWins = n
, _gmsLosses = n + 1
, _gmsOvertime = n + 2
, _gmsGoalsFor = n + 3
, _gmsGoalsAgainst = n + 4
2019-08-26 10:20:10 -04:00
}
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 )
2019-08-26 10:20:10 -04:00
]
2019-08-16 11:49:04 -04:00
db :: Database
db = newDatabase
& dbPlayers .~ [player]
& dbGoalies .~ [goalie]
& dbGames .~ 1
& dbHomeGameStats .~ gameStats 1
& dbAwayGameStats .~ gameStats 2
2019-08-16 11:49:04 -04:00
2019-08-26 23:55:02 -04:00
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 )
2019-08-28 13:02:50 -04:00
]
2019-09-02 18:50:21 -04:00
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
2019-08-28 13:02:50 -04:00
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 )
2019-08-26 23:55:02 -04:00
]
2019-08-28 01:46:09 -04:00
2019-08-30 00:44:40 -04:00
gameLostSpec :: Spec
gameLostSpec = describe "gameLost" $ mapM_
(\(t, h, a, ot, expected) -> let
2019-08-30 00:44:40 -04:00
desc = "game type: " ++ show t ++
", home score: " ++ show h ++
", away score: " ++ show a ++
", overtimr flag: " ++ show ot
2019-08-30 00:44:40 -04:00
gs = newGameState
& gameType .~ t
& homeScore .~ h
& awayScore .~ a
& overtimeFlag .~ ot
2019-08-30 00:44:40 -04:00
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 )
2019-08-30 00:44:40 -04:00
]
gameTiedSpec :: Spec
2019-08-28 01:47:30 -04:00
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 )
2019-08-28 01:47:30 -04:00
]
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
2019-09-03 14:15:29 -04:00
gmsGamesSpec :: Spec
gmsGamesSpec = describe "gmsGames" $ mapM_
(\(w, l, ot, expected) -> let
2019-09-03 14:15:29 -04:00
desc = "wins: " ++ show w ++
", losses: " ++ show l ++
", overtime: " ++ show ot
2019-09-03 14:15:29 -04:00
gs = newGameStats
& gmsWins .~ w
& gmsLosses .~ l
& gmsOvertime .~ ot
2019-09-03 14:15:29 -04:00
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 )
2019-09-03 14:15:29 -04:00
]
2019-08-30 18:57:56 -04:00
gmsPointsSpec :: Spec
gmsPointsSpec = describe "gmsPoints" $ mapM_
(\(w, l, ot, expected) -> let
gs
= newGameStats
& gmsWins .~ w
& gmsLosses .~ l
& gmsOvertime .~ ot
2019-08-30 18:57:56 -04:00
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 )
]
2019-08-31 09:33:26 -04:00
addGameStatsSpec :: Spec
addGameStatsSpec = describe "addGameStats" $
it "should add the values" $ let
s1 = GameStats
{ _gmsWins = 1
, _gmsLosses = 2
, _gmsOvertime = 3
, _gmsGoalsFor = 4
, _gmsGoalsAgainst = 5
2019-08-31 09:33:26 -04:00
}
s2 = GameStats
{ _gmsWins = 6
, _gmsLosses = 7
, _gmsOvertime = 8
, _gmsGoalsFor = 9
, _gmsGoalsAgainst = 10
2019-08-31 09:33:26 -04:00
}
expected = GameStats
{ _gmsWins = 7
, _gmsLosses = 9
, _gmsOvertime = 11
, _gmsGoalsFor = 13
, _gmsGoalsAgainst = 15
2019-08-31 09:33:26 -04:00
}
in addGameStats s1 s2 `shouldBe` expected
2019-09-18 01:55:38 -04:00
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", [] )
]
2019-09-19 03:11:48 -04:00
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 )
]
2019-09-25 02:28:48 -04:00
modifyPlayerSpec :: Spec
modifyPlayerSpec = describe "modifyPlayer" $ mapM_
2019-11-12 17:01:08 -05:00
(\(name, j, b, s) -> let
2019-09-25 02:28:48 -04:00
modifier = pLifetime.psGoals .~ 1
2019-11-12 17:01:08 -05:00
players = modifyPlayer modifier name [joe, bob, steve]
in context ("modify " ++ name) $ do
2019-09-25 02:28:48 -04:00
context "Joe's lifetime goals" $
it ("should be " ++ show j) $
2019-11-12 17:01:08 -05:00
head players^.pLifetime.psGoals `shouldBe` j
2019-09-25 02:28:48 -04:00
context "Bob's lifetime goals" $
it ("should be " ++ show b) $
2019-11-12 17:01:08 -05:00
(players !! 1)^.pLifetime.psGoals `shouldBe` b
2019-09-25 02:28:48 -04:00
context "Steve's lifetime goals" $
it ("should be " ++ show s) $
2019-11-12 17:01:08 -05:00
last players^.pLifetime.psGoals `shouldBe` s)
2019-09-25 02:28:48 -04:00
-- 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 )
]
2019-10-02 01:31:07 -04:00
playerSummarySpec :: Spec
playerSummarySpec = describe "playerSummary" $
it "should be \"Joe (2) center\"" $
playerSummary joe `shouldBe` "Joe (2) center"
2019-11-01 05:40:01 -04:00
playerDetailsSpec :: Spec
playerDetailsSpec = describe "playerDetails" $
it "should give a detailed description" $ let
2019-11-12 17:01:08 -05:00
p = newPlayer 1 "Joe" "centre"
2019-11-01 05:40:01 -04:00
& pYtd .~ PlayerStats
{ _psGoals = 2
, _psAssists = 3
, _psPMin = 4
}
& pLifetime .~ PlayerStats
{ _psGoals = 5
, _psAssists = 6
, _psPMin = 7
}
expected = unlines
[ " Number: 1"
, " Name: Joe"
, " Position: centre"
, " YTD goals: 2"
, " YTD assists: 3"
, " YTD penalty mins: 4"
, " Lifetime goals: 5"
, " Lifetime assists: 6"
, "Lifetime penalty mins: 7"
]
2019-11-12 17:01:08 -05:00
in playerDetails p `shouldBe` expected
2019-11-01 05:40:01 -04:00
2019-10-15 00:51:42 -04:00
playerIsActiveSpec :: Spec
playerIsActiveSpec = describe "playerIsActive" $ do
let
2019-11-12 17:01:08 -05:00
pStats = newPlayerStats
2019-10-15 00:51:42 -04:00
& psGoals .~ 10
& psAssists .~ 11
& psPMin .~ 12
2019-11-12 17:01:08 -05:00
p = newPlayer 1 "Joe" "centre" & pLifetime .~ pStats
2019-10-15 00:51:42 -04:00
mapM_
2019-11-12 17:01:08 -05:00
(\(label, p', expected) -> context label $
2019-10-15 00:51:42 -04:00
it ("should be " ++ show expected) $
2019-11-12 17:01:08 -05:00
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 )
2019-10-15 00:51:42 -04:00
]
2019-10-09 00:35:35 -04:00
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 )
]
2019-10-09 00:24:34 -04:00
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
2019-10-30 23:01:59 -04:00
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 Steve" $
goalieSearch "Bob" goalies `shouldBe` [result 1]
2019-10-30 23:18:15 -04:00
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
2019-10-30 23:27:38 -04:00
goalieSummarySpec :: Spec
goalieSummarySpec = describe "goalieSummary" $
it "should provide a summary string" $
goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)"
2019-09-19 03:11:48 -04:00
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
<*> makePlayerStats
<*> makePlayerStats
-- | Creates a 'Goalie'
makeGoalie :: IO Goalie
makeGoalie = Goalie
<$> makeNum
<*> makeName
<*> 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 :: IO Int
makeNum = randomRIO (1, 10)
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
2019-11-01 03:42:51 -04:00
instance Comparable EditPlayerState where
2019-11-01 04:25:25 -04:00
compareTest actual expected = do
2019-11-01 03:42:51 -04:00
describe "epsSelectedPlayer" $
it ("should be " ++ show (expected^.epsSelectedPlayer)) $
actual^.epsSelectedPlayer `shouldBe` expected^.epsSelectedPlayer
2019-11-01 04:25:25 -04:00
describe "epsMode" $
it ("should be " ++ show (expected^.epsMode)) $
actual^.epsMode `shouldBe` expected^.epsMode
2019-11-11 20:00:41 -05:00
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