fix ProgMode comparison failure

also updated copyright notice

ChangeLog.md

@@ -1,5 +1,14 @@
 # Changelog for mtlstats
 
+## 0.16.1
+- Don't automatically start a new game on new season
+
+## 0.16.0
+- enter months by number
+
+## 0.15.2
+- allow ties
+
 ## 0.15.1
 - only search for active players/goalies on game data input
 

package.yaml

@@ -1,5 +1,5 @@
 name:                mtlstats
-version:             0.15.1
+version:             0.16.1
 github:              "mtlstats/mtlstats"
 license:             GPL-3
 author:              "Jonathan Lamothe"

src/Mtlstats.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Actions.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Actions/EditStandings.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Actions/NewGame.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -43,9 +43,7 @@ import Mtlstats.Util
 overtimeCheck :: ProgState -> ProgState
 overtimeCheck s
   | fromMaybe False $ gameTied $ s^.progMode.gameStateL =
-    s & progMode.gameStateL
+    s & progMode.gameStateL.overtimeFlag ?~ True
-    %~ (homeScore .~ Nothing)
-    .  (awayScore .~ Nothing)
   | fromMaybe False $ gameWon $ s^.progMode.gameStateL =
     s & progMode.gameStateL.overtimeFlag ?~ False
   | otherwise  = s

src/Mtlstats/Actions/NewGame/GoalieInput.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Config.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Control.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Control/CreateGoalie.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Control/CreatePlayer.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Control/EditGoalie.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Control/EditPlayer.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Control/EditStandings.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Control/NewGame.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -62,7 +62,7 @@ gameYearC :: Controller
 gameYearC = promptControllerWith header gameYearPrompt
 
 gameMonthC :: Controller
-gameMonthC = menuControllerWith header gameMonthMenu
+gameMonthC = promptControllerWith monthHeader gameMonthPrompt
 
 gameDayC :: Controller
 gameDayC = promptControllerWith header gameDayPrompt
@@ -226,6 +226,31 @@ header :: ProgState -> C.Update ()
 header s = C.drawString $
   "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
 
+monthHeader :: ProgState -> C.Update ()
+monthHeader s = do
+  (_, cols) <- C.windowSize
+  header s
+
+  let
+    table = labelTable $ zip (map show ([1..] :: [Int]))
+      [ "JANUARY"
+      , "FEBRUARY"
+      , "MARCH"
+      , "APRIL"
+      , "MAY"
+      , "JUNE"
+      , "JULY"
+      , "AUGUST"
+      , "SEPTEMBER"
+      , "OCTOBER"
+      , "NOVEMBER"
+      , "DECEMBER"
+      ]
+
+  C.drawString $ unlines $
+    map (centre $ fromIntegral $ pred cols) $
+      ["MONTH:", ""] ++ table ++ [""]
+
 gameGoal :: ProgState -> (Int, Int)
 gameGoal s =
   ( s^.database.dbGames

src/Mtlstats/Control/NewGame/GoalieInput.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Control/TitleScreen.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -41,7 +41,7 @@ titleScreenC = Controller
          ]
       ++ titleText
       ++ [ ""
-         , "Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe"
+         , "Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe"
          , "<rheal.lamothe@gmail.com>"
          , ""
          , "Press any key to continue..."

src/Mtlstats/Format.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -129,9 +129,14 @@ month _  = ""
 labelTable :: [(String, String)] -> [String]
 labelTable xs = let
   labelWidth = maximum $ map (length . fst) xs
+  valWidth   = maximum $ map (length . snd) xs
+
   in map
-    (\(label, val) -> right labelWidth label ++ ": " ++ val)
+    ( \(label, val)
-    xs
+      -> right labelWidth label
+      ++ ": "
+      ++ left valWidth val
+    ) xs
 
 -- | Creates a variable column table of numbers with two axes
 numTable

src/Mtlstats/Handlers.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Helpers/Goalie.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Helpers/Player.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Helpers/Position.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Menu.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -29,7 +29,6 @@ module Mtlstats.Menu (
   -- * Menus
   mainMenu,
   newSeasonMenu,
-  gameMonthMenu,
   gameTypeMenu,
   gameGoalieMenu,
   editMenu
@@ -124,30 +123,10 @@ newSeasonMenu = Menu "SEASON TYPE" ()
     $ resetYtd
     . clearRookies
     . resetStandings
-    . startNewGame
+    . backHome
   , MenuItem 'P' "PLAYOFFS" $ modify
     $ resetStandings
-    . startNewGame
+    . backHome
-  ]
-
--- | Requests the month in which the game took place
-gameMonthMenu :: Menu ()
-gameMonthMenu = Menu "MONTH:" () $ map
-  (\(ch, name, val) ->
-    MenuItem ch name $
-    modify $ progMode.gameStateL.gameMonth ?~ val)
-  [ ( 'A', "JANUARY",   1  )
-  , ( 'B', "FEBRUARY",  2  )
-  , ( 'C', "MARCH",     3  )
-  , ( 'D', "APRIL",     4  )
-  , ( 'E', "MAY",       5  )
-  , ( 'F', "JUNE",      6  )
-  , ( 'G', "JULY",      7  )
-  , ( 'H', "AUGUST",    8  )
-  , ( 'I', "SEPTEMBER", 9  )
-  , ( 'J', "OCTOBER",   10 )
-  , ( 'K', "NOVEMBER",  11 )
-  , ( 'L', "DECEMBER",  12 )
   ]
 
 -- | The game type menu (home/away)

src/Mtlstats/Menu/EditGoalie.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Menu/EditPlayer.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Menu/EditStandings.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Prompt.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -31,6 +31,7 @@ module Mtlstats.Prompt (
   ucStrPrompt,
   namePrompt,
   numPrompt,
+  numPromptRange,
   numPromptWithFallback,
   dbNamePrompt,
   selectPrompt,
@@ -154,6 +155,20 @@ numPrompt
   -> Prompt
 numPrompt pStr = numPromptWithFallback pStr $ return ()
 
+-- | Builds a numberic prompt with a range
+numPromptRange
+  :: Int
+  -- ^ The minimum value
+  -> Int
+  -- ^ The maximum value
+  -> String
+  -- ^ The prompt string
+  -> (Int -> Action ())
+  -- ^ The callback function for the result
+  -> Prompt
+numPromptRange nMin nMax pStr callback = numPrompt pStr $ \n ->
+  when (n >= nMin && n <= nMax) $ callback n
+
 -- | Builds a numeric prompt with a fallback action
 numPromptWithFallback
   :: String

src/Mtlstats/Prompt/EditGoalie.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Prompt/EditPlayer.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Prompt/EditStandings.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Prompt/NewGame.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -23,6 +23,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Prompt.NewGame
   ( gameYearPrompt
+  , gameMonthPrompt
   , gameDayPrompt
   , otherTeamPrompt
   , homeScorePrompt
@@ -48,6 +49,11 @@ gameYearPrompt :: Prompt
 gameYearPrompt = numPrompt "Game year: " $
   modify . (progMode.gameStateL.gameYear ?~)
 
+-- | Prompts for the game month
+gameMonthPrompt :: Prompt
+gameMonthPrompt = numPromptRange 1 12 "Game month: " $
+  modify . (progMode.gameStateL.gameMonth ?~)
+
 -- | Prompts for the day of the month the game took place
 gameDayPrompt :: Prompt
 gameDayPrompt = numPrompt "Day of month: " $

src/Mtlstats/Prompt/NewGame/GoalieInput.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Report.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Types.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Types/Menu.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

src/Mtlstats/Util.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

test/Actions/EditStandingsSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

test/Actions/NewGame/GoalieInputSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -22,13 +22,11 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 module Actions.NewGame.GoalieInputSpec (spec) where
 
 import qualified Data.Map as M
-import Data.Maybe (fromJust)
 import Lens.Micro ((^.), (&), (.~), (?~), (%~))
 import Test.Hspec (Spec, context, describe, it, shouldBe)
 
 import Mtlstats.Actions.NewGame.GoalieInput
 import Mtlstats.Types
-import Mtlstats.Util
 
 import qualified TypesSpec as TS
 
@@ -79,134 +77,59 @@ finishGoalieEntrySpec = describe "finishGoalieEntry" $ mapM_
     bobStats   = (1, newGoalieStats)
 
 recordGoalieStatsSpec :: Spec
-recordGoalieStatsSpec = describe "recordGoalieStats" $ let
+recordGoalieStatsSpec = describe "recordGoalieStats" $ mapM_
-  goalieStats games mins goals = newGoalieStats
+  ( \(label, input, expected) ->
-    & gsGames        .~ games
+    context label $ do
-    & gsMinsPlayed   .~ mins
+      let ps = recordGoalieStats input
-    & gsGoalsAllowed .~ goals
+      ps `TS.compareTest` expected
-
-  joe = newGoalie 2 "Joe"
-    & gYtd      .~ goalieStats 10 11 12
-    & gLifetime .~ goalieStats 20 21 22
-
-  bob = newGoalie 3 "Bob"
-    & gYtd      .~ goalieStats 30 31 32
-    & gLifetime .~ goalieStats 40 41 42
-
-  gameState n mins goals = newGameState
-    & gameGoalieStats      .~ M.fromList [(1, goalieStats 1 2 3)]
-    & gameSelectedGoalie   .~ n
-    & gameGoalieMinsPlayed .~ mins
-    & gameGoalsAllowed     .~ goals
-
-  progState n mins goals = newProgState
-    & database.dbGoalies  .~ [joe, bob]
-    & progMode.gameStateL .~ gameState n mins goals
-
-  in mapM_
-    (\(setName, setGid, mins, goals, joeData, bobData, reset) -> let
-      s = recordGoalieStats $ progState setGid mins goals
-      in context setName $ do
-
-        mapM_
-          (\( chkName
-            , chkGid
-            , ( gGames
-              , gMins
-              , gGoals
-              , ytdGames
-              , ytdMins
-              , ytdGoals
-              , ltGames
-              , ltMins
-              , ltGoals
   )
-            ) -> context chkName $ do
-              let
-                gs     = s^.progMode.gameStateL.gameGoalieStats
-                game   = M.findWithDefault newGoalieStats chkGid gs
-                goalie = fromJust $ nth chkGid $ s^.database.dbGoalies
-                ytd    = goalie^.gYtd
-                lt     = goalie^.gLifetime
 
-              context "game" $
+  [ ( "No goalie"
-                game `TS.compareTest` goalieStats gGames gMins gGoals
+    , noGoalie
-
+    , noGoalie
-              context "year-to-date" $
-                ytd `TS.compareTest` goalieStats ytdGames ytdMins ytdGoals
-
-              context "lifetime" $
-                lt `TS.compareTest` goalieStats ltGames ltMins ltGoals)
-
-          [ ( "checking Joe", 0, joeData )
-          , ( "checking Bob", 1, bobData )
-          ]
-
-        context "selected goalie" $ let
-          expected = if reset then Nothing else setGid
-          in it ("should be " ++ show expected) $
-            (s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
-
-        context "minutes played" $ let
-          expected = if reset then Nothing else mins
-          in it ("should be " ++ show expected) $
-            (s^.progMode.gameStateL.gameGoalieMinsPlayed) `shouldBe` expected
-
-        context "goals allowed" $ let
-          expected = if reset then Nothing else goals
-          in it ("should be " ++ show expected) $
-            (s^.progMode.gameStateL.gameGoalsAllowed) `shouldBe` expected)
-
-    [ ( "updating Joe"
-      , Just 0
-      , Just 1
-      , Just 2
-      , (1, 1, 2, 11, 12, 14, 21, 22, 24)
-      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
-      , True
     )
-    , ( "updating Bob"
+
-      , Just 1
+  , ( "Missing goalie"
-      , Just 1
+    , missingGoalie
-      , Just 2
+    , missingGoalie
-      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
-      , (1, 3, 5, 30, 32, 34, 40, 42, 44)
-      , True
-      )
-    , ( "goalie out of bounds"
-      , Just 2
-      , Just 1
-      , Just 2
-      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
-      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
-      , False
-      )
-    , ( "missing goalie"
-      , Nothing
-      , Just 1
-      , Just 2
-      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
-      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
-      , False
-      )
-    , ( "missing minutes"
-      , Just 0
-      , Nothing
-      , Just 1
-      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
-      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
-      , False
-      )
-    , ( "missing goals"
-      , Just 0
-      , Just 1
-      , Nothing
-      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
-      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
-      , False
     )
   ]
 
+  where
+    noGoalie = defProgState
+
+    missingGoalie = defProgState
+      & progMode.gameStateL.gameSelectedGoalie ?~ 99
+
+    defProgState = newProgState
+      & progMode.gameStateL
+        %~ ( gameType  ?~ HomeGame )
+        .  ( homeScore ?~ 2        )
+        .  ( awayScore ?~ 1        )
+      & database.dbGoalies .~ [jim, bob, steve]
+
+    jim   = mkGoalie 2 "Jim"   1
+    bob   = mkGoalie 3 "Bob"   2
+    steve = mkGoalie 5 "Steve" 3
+
+    mkGoalie num name n = newGoalie num name
+      & gYtd
+        %~ ( gsGames        .~ n     )
+        .  ( gsMinsPlayed   .~ n + 1 )
+        .  ( gsGoalsAllowed .~ n + 2 )
+        .  ( gsShutouts     .~ n + 3 )
+        .  ( gsWins         .~ n + 4 )
+        .  ( gsLosses       .~ n + 5 )
+        .  ( gsTies         .~ n + 6 )
+      & gLifetime
+        %~ ( gsGames        .~ n + 7  )
+        .  ( gsMinsPlayed   .~ n + 8  )
+        .  ( gsGoalsAllowed .~ n + 9  )
+        .  ( gsShutouts     .~ n + 10 )
+        .  ( gsWins         .~ n + 11 )
+        .  ( gsLosses       .~ n + 12 )
+        .  ( gsTies         .~ n + 13 )
+
 setGameGoalieSpec :: Spec
 setGameGoalieSpec = describe "setGameGoalie" $ mapM_
 

test/Actions/NewGameSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -48,61 +48,31 @@ spec = describe "NewGame" $ do
   GoalieInput.spec
 
 overtimeCheckSpec :: Spec
-overtimeCheckSpec = describe "overtimeCheck" $ do
+overtimeCheckSpec = describe "overtimeCheck" $ mapM_
+  (\(label, expectation, gt, home, away, otf) ->
+    context label $
+      it expectation $ let
+        ps = newProgState & progMode.gameStateL
+          %~ (gameType  ?~ gt)
+          .  (homeScore ?~ home)
+          .  (awayScore ?~ away)
 
-  context "tie game" $ do
+        ps' = overtimeCheck ps
-    let
+        in ps'^.progMode.gameStateL.overtimeFlag `shouldBe` otf)
-      s = newProgState
-        & progMode.gameStateL
-          %~ (gameType  ?~ HomeGame)
-          .  (homeScore ?~ 1)
-          .  (awayScore ?~ 1)
-        & overtimeCheck
 
-    it "should clear the home score" $
+  --  label,       expectation, type,     home, away, ot flag
-      s^.progMode.gameStateL.homeScore `shouldBe` Nothing
+  [ ( "home win",  clearFlag,   HomeGame, 2,    1,    Just False )
+  , ( "home loss", leaveFlag,   HomeGame, 1,    2,    Nothing    )
+  , ( "home tie",  setFlag,     HomeGame, 1,    1,    Just True  )
+  , ( "away win",  clearFlag,   AwayGame, 1,    2,    Just False )
+  , ( "away loss", leaveFlag,   AwayGame, 2,    1,    Nothing    )
+  , ( "away tie",  setFlag,     AwayGame, 1,    1,    Just True  )
+  ]
 
-    it "should clear the away score" $
+  where
-      s^.progMode.gameStateL.awayScore `shouldBe` Nothing
+    clearFlag = "should set the overtimeFlag to True"
-
+    setFlag   = "should set the overtimeFlag to False"
-    it "should leave the overtimeFlag blank" $
+    leaveFlag = "should leave the overtimeFlag as Nothing"
-      s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
-
-  context "game won" $ do
-    let
-      s = newProgState
-        & progMode.gameStateL
-          %~ (gameType  ?~ HomeGame)
-          .  (homeScore ?~ 2)
-          .  (awayScore ?~ 1)
-        & overtimeCheck
-
-    it "should not change the home score" $
-      s^.progMode.gameStateL.homeScore `shouldBe` Just 2
-
-    it "should not change the away score" $
-      s^.progMode.gameStateL.awayScore `shouldBe` Just 1
-
-    it "should set the overtimeCheck flag to False" $
-      s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
-
-  context "game lost" $ do
-    let
-      s = newProgState
-        & progMode.gameStateL
-          %~ (gameType  ?~ HomeGame)
-          .  (homeScore ?~ 1)
-          .  (awayScore ?~ 2)
-        & overtimeCheck
-
-    it "should not change the home score" $
-      s^.progMode.gameStateL.homeScore `shouldBe` Just 1
-
-    it "should not change the away score" $
-      s^.progMode.gameStateL.awayScore `shouldBe` Just 2
-
-    it "should leave the overtimeCheck flag blank" $
-      s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
 
 updateGameStatsSpec :: Spec
 updateGameStatsSpec = describe "updateGameStats" $ do

test/ActionsSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

test/FormatSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -141,9 +141,9 @@ labelTableSpec = describe "labelTable" $
       ]
 
     expected =
-      [ "   foo: bar"
+      [ "   foo: bar "
       , "   baz: quux"
-      , "longer: x"
+      , "longer: x   "
       ]
 
     in labelTable input `shouldBe` expected

test/HandlersSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

test/Helpers/GoalieSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -54,7 +54,7 @@ goalieDetailsSpec = describe "goalieDetails" $ let
       .  ( gsTies         .~ 15 )
 
   expected = unlines
-    [ "Number: 1"
+    [ "Number: 1   "
     , "  Name: Joe*"
     , ""
     , "              YTD Lifetime"

test/Helpers/PlayerSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -50,8 +50,8 @@ playerDetailsSpec = describe "playerDetails" $
         }
 
     expected = unlines
-      [ "  Number: 1"
+      [ "  Number: 1     "
-      , "    Name: Joe*"
+      , "    Name: Joe*  "
       , "Position: centre"
       , ""
       , "             YTD Lifetime"

test/Helpers/PositionSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

test/HelpersSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

test/ReportSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

test/Spec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

test/Types/MenuSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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

test/TypesSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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
@@ -38,7 +38,14 @@ 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 Test.Hspec
+  ( Spec
+  , context
+  , describe
+  , expectationFailure
+  , it
+  , shouldBe
+  )
 
 import Mtlstats.Config
 import Mtlstats.Types
@@ -972,119 +979,223 @@ makeBool = randomIO
 makeName :: IO String
 makeName = replicateM 10 $ randomRIO ('A', 'Z')
 
-instance Comparable GoalieStats where
+instance Comparable ProgState where
-  compareTest actual expected = mapM_
+  compareTest act expect = do
-    (\(name, lens) -> describe name $
+    compareLenses "database"     database     act expect
-      it ("should be " ++ show (expected^.lens)) $
+    compareLenses "progMode"     progMode     act expect
-        actual^.lens `shouldBe` expected^.lens)
+    compareLenses "dbName"       dbName       act expect
-    --  name,             lens
+    compareLenses "inputBuffer"  inputBuffer  act expect
-    [ ( "gsGames",        gsGames        )
+    compareLenses "scrollOffset" scrollOffset act expect
-    , ( "gsMinsPlayed",   gsMinsPlayed   )
+
-    , ( "gsGoalsAllowed", gsGoalsAllowed )
+instance Comparable ProgMode where
-    , ( "gsWins",         gsWins         )
+  compareTest TitleScreen TitleScreen = return ()
-    , ( "gsLosses",       gsLosses       )
+  compareTest MainMenu    MainMenu    = return ()
-    , ( "gsTies",         gsTies         )
+
-    ]
+  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 actual expected =
+  compareTest act expect = do
-    it ("should be " ++ show expected) $
+    compareLenses "gameYear"             gameYear             act expect
-      actual `shouldBe` expected
+    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 CreatePlayerState where
+instance Comparable Database where
-  compareTest actual expected = do
+  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
 
-    describe "cpsNumber" $
+instance Comparable Player where
-      it ("should be " ++ show (expected^.cpsNumber)) $
+  compareTest act expect = do
-        actual^.cpsNumber `shouldBe` expected^.cpsNumber
+    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
 
-    describe "cpsName" $
+instance Comparable [Player] where
-      it ("should be " ++ expected^.cpsName) $
+  compareTest = compareLists
-        actual^.cpsName `shouldBe` expected^.cpsName
 
-    describe "cpsPosition" $
+instance Comparable PlayerStats where
-      it ("should be " ++ expected^.cpsPosition) $
+  compareTest act expect = do
-        actual^.cpsPosition `shouldBe` expected^.cpsPosition
+    compareLenses "psGoals"   psGoals   act expect
-
+    compareLenses "psAssists" psAssists act expect
-instance Comparable EditPlayerState where
+    compareLenses "psPMin"    psPMin    act expect
-  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
+  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
 
-    describe "gNumber" $
+instance Comparable [Goalie] where
-      it ("should be " ++ show (expected^.gNumber)) $
+  compareTest = compareLists
-        actual^.gNumber `shouldBe` expected^.gNumber
 
-    describe "gName" $
+instance Comparable GoalieStats where
-      it ("should be " ++ show (expected^.gName)) $
+  compareTest act expect = do
-        actual^.gName `shouldBe` expected^.gName
+    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
 
-    describe "gRookie" $
+instance Comparable GameStats where
-      it ("should be " ++ show (expected^.gRookie)) $
+  compareTest act expect = do
-        actual^.gRookie `shouldBe` expected^.gRookie
+    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
 
-    describe "gActive" $
+instance Comparable GameType where
-      it ("should be " ++ show (expected^.gActive)) $
+  compareTest = compareVals
-        actual^.gActive `shouldBe` expected^.gActive
 
-    describe "gYtd" $
+instance Comparable CreatePlayerState where
-      (actual^.gYtd) `compareTest` (expected^.gYtd)
+  compareTest act expect = do
+    compareLenses "cpsNumber"   cpsNumber   act expect
+    compareLenses "cpsName"     cpsName     act expect
+    compareLenses "cpsPosition" cpsPosition act expect
 
-    describe "gLifetime" $
+instance Comparable EditPlayerState where
-      (actual^.gLifetime) `compareTest` (expected^.gLifetime)
+  compareTest act expect = do
+    compareLenses "epsSelectedPlayer" epsSelectedPlayer act expect
+    compareLenses "epsMode"           epsMode           act expect
 
-instance Comparable (M.Map Int GoalieStats) where
+instance Comparable EditPlayerMode where
-  compareTest actual expected = do
+  compareTest = compareVals
 
-    let
+instance Comparable EditGoalieState where
-      aList = M.toList actual
+  compareTest act expect = do
-      eList = M.toList expected
+    compareLenses "egsSelectedGoalie" egsSelectedGoalie act expect
+    compareLenses "egsMode"           egsMode           act expect
 
-    it "should have the correct number of elements" $
+instance Comparable EditGoalieMode where
-      length aList `shouldBe` length eList
+  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_
-      (\(n, (ka, va), (ke, ve)) -> context ("element " ++ show n) $ do
+        ( \k -> context (show k) $
+          M.lookup k actM `compareTest` M.lookup k expectM
+        ) $ M.keys actM
 
-        context "key" $
+compareLists :: (Comparable a) => [a] -> [a] -> Spec
-          it ("should be " ++ show ke) $
+compareLists acts expects = do
-            ka `shouldBe` ke
+    let
+      aLen = length acts
+      eLen = length expects
 
-        context "value" $ va `compareTest` ve)
+    context "count elements" $
-      (zip3 ([0..] :: [Int]) aList eList)
+      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)

test/UtilSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+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