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