mtlstats/test/TypesSpec.hs

{-

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 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

instance Comparable Goalie where
  compareTest actual expected = do

    describe "gNumber" $
      it ("should be " ++ show (expected^.gNumber)) $
        actual^.gNumber `shouldBe` expected^.gNumber

    describe "gName" $
      it ("should be " ++ show (expected^.gName)) $
        actual^.gName `shouldBe` expected^.gName

    describe "gRookie" $
      it ("should be " ++ show (expected^.gRookie)) $
        actual^.gRookie `shouldBe` expected^.gRookie

    describe "gActive" $
      it ("should be " ++ show (expected^.gActive)) $
        actual^.gActive `shouldBe` expected^.gActive

    describe "gYtd" $
      (actual^.gYtd) `compareTest` (expected^.gYtd)

    describe "gLifetime" $
      (actual^.gLifetime) `compareTest` (expected^.gLifetime)

instance Comparable (M.Map Int GoalieStats) where
  compareTest actual expected = do

    let
      aList = M.toList actual
      eList = M.toList expected

    it "should have the correct number of elements" $
      length aList `shouldBe` length eList

    mapM_
      (\(n, (ka, va), (ke, ve)) -> context ("element " ++ show n) $ do

        context "key" $
          it ("should be " ++ show ke) $
            ka `shouldBe` ke

        context "value" $ va `compareTest` ve)
      (zip3 ([0..] :: [Int]) aList eList)