version 0.14.0

output report to a text file (report.txt)

.gitignore

@@ -1,3 +1,6 @@
 .stack-work/
 mtlstats.cabal
+.vagrant
+data
+*.log
 *~

ChangeLog.md

@@ -1,5 +1,15 @@
 # Changelog for mtlstats
 
+## 0.14.0
+- Fixed a bug that was causing shutouts to not be recorded
+- Output report to a text file (report.txt)
+
+## 0.13.0
+- Added autocomplete to player position prompt
+- Don't prompt for lifetime stats on rookie player/goalie creation
+- Ask whether a player/goalie is active on creation
+- Don't ask which goalie to assign the game to when there's only one
+
 ## 0.12.0
 - Edit lifetime stats on new player/goalie creation
 - Sort goalies by minutes played

Vagrantfile

@@ -0,0 +1,10 @@
+# -*- mode: ruby -*-
+# vi: set ft=ruby :
+
+Vagrant.configure("2") do |config|
+  config.vm.box = "ubuntu/xenial64"
+  config.vm.provision "shell", path: "vagrant/provision.sh"
+  config.vm.provider :virtualbox do |v|
+    v.customize ["modifyvm", :id, "--memory", 4096]
+  end
+end

package.yaml

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

src/Mtlstats/Actions.hs

@@ -161,11 +161,15 @@ editSelectedGoalie f s = fromMaybe s $ do
 addPlayer :: ProgState -> ProgState
 addPlayer s = fromMaybe s $ do
   let cps = s^.progMode.createPlayerStateL
-  num <- cps^.cpsNumber
+  num   <- cps^.cpsNumber
+  rFlag <- cps^.cpsRookieFlag
+  aFlag <- cps^.cpsActiveFlag
   let
     name   = cps^.cpsName
     pos    = cps^.cpsPosition
     player = newPlayer num name pos
+      & pRookie .~ rFlag
+      & pActive .~ aFlag
   Just $ s & database.dbPlayers
     %~ (++[player])
 
@@ -173,10 +177,14 @@ addPlayer s = fromMaybe s $ do
 addGoalie :: ProgState -> ProgState
 addGoalie s = fromMaybe s $ do
   let cgs = s^.progMode.createGoalieStateL
-  num <- cgs^.cgsNumber
+  num   <- cgs^.cgsNumber
+  rFlag <- cgs^.cgsRookieFlag
+  aFlag <- cgs^.cgsActiveFlag
   let
     name   = cgs^.cgsName
     goalie = newGoalie num name
+      & gRookie .~ rFlag
+      & gActive .~ aFlag
   Just $ s & database.dbGoalies
     %~ (++[goalie])
 

src/Mtlstats/Actions/NewGame.hs

@@ -124,12 +124,13 @@ awardGoal n ps = ps
     (\m -> let
       stats = M.findWithDefault newPlayerStats n m
       in M.insert n (stats & psGoals %~ succ) m)
-  & database.dbPlayers %~ map
+  & database.dbPlayers %~ zipWith
-    (\(i, p) -> if i == n
+    (\i p -> if i == n
       then p
         & pYtd.psGoals      %~ succ
         & pLifetime.psGoals %~ succ
-      else p) . zip [0..]
+      else p)
+    [0..]
 
 -- | Awards an assist to a player
 awardAssist
@@ -142,12 +143,13 @@ awardAssist n ps = ps
     (\m -> let
       stats = M.findWithDefault newPlayerStats n m
       in M.insert n (stats & psAssists %~ succ) m)
-  & database.dbPlayers %~ map
+  & database.dbPlayers %~ zipWith
-    (\(i, p) -> if i == n
+    (\i p -> if i == n
       then p
         & pYtd.psAssists      %~ succ
         & pLifetime.psAssists %~ succ
-      else p) . zip [0..]
+      else p)
+    [0..]
 
 -- | Resets the entered data for the current goal
 resetGoalData :: ProgState -> ProgState

src/Mtlstats/Actions/NewGame/GoalieInput.hs

@@ -36,8 +36,12 @@ import Mtlstats.Util
 
 -- | Attempts to finish game goalie entry
 finishGoalieEntry :: ProgState -> ProgState
-finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded
+finishGoalieEntry s = case M.toList $ s^.progMode.gameStateL.gameGoalieStats of
-  .~ not (null $ s^.progMode.gameStateL.gameGoalieStats)
+  []         -> s
+  [(gid, _)] -> setGameGoalie gid s'
+  _          -> s'
+  where
+    s' = s & progMode.gameStateL.gameGoaliesRecorded .~ True
 
 -- | Records the goalie's game stats
 recordGoalieStats :: ProgState -> ProgState
@@ -83,18 +87,22 @@ setGameGoalie
   -> ProgState
 setGameGoalie gid s = fromMaybe s $ do
   let gs = s^.progMode.gameStateL
-  won  <- gameWon gs
+  won     <- gameWon gs
-  lost <- gameLost gs
+  lost    <- gameLost gs
-  tied <- gs^.overtimeFlag
+  tied    <- gs^.overtimeFlag
+  shutout <- (==0) <$> otherScore gs
+
   let
-    w = if won then 1 else 0
+    w  = if won then 1 else 0
-    l = if lost then 1 else 0
+    l  = if lost then 1 else 0
-    t = if tied then 1 else 0
+    t  = if tied then 1 else 0
+    so = if shutout then 1 else 0
 
     updateStats
-      = (gsWins   +~ w)
+      = (gsWins     +~ w)
-      . (gsLosses +~ l)
+      . (gsLosses   +~ l)
-      . (gsTies   +~ t)
+      . (gsTies     +~ t)
+      . (gsShutouts +~ so)
 
     updateGoalie
       = (gYtd      %~ updateStats)

src/Mtlstats/Config.hs

@@ -44,3 +44,11 @@ maxAssists = 2
 -- | The length of a typical game (in minutes)
 gameLength :: Int
 gameLength = 60
+
+-- | Report output filename
+reportFilename :: FilePath
+reportFilename = "report.txt"
+
+-- | Number of columns in report file
+reportCols :: Int
+reportCols = 79

src/Mtlstats/Control/CreateGoalie.hs

@@ -21,13 +21,12 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control.CreateGoalie (createGoalieC) where
 
-import Control.Monad (join)
 import Control.Monad.Trans.State (gets, modify)
-import Data.Maybe (fromJust)
 import Lens.Micro ((^.), (.~), (?~), (%~), to)
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
+import Mtlstats.Format
 import Mtlstats.Handlers
 import Mtlstats.Prompt
 import Mtlstats.Types
@@ -35,23 +34,39 @@ import Mtlstats.Types
 -- | Handles goalie creation
 createGoalieC :: CreateGoalieState -> Controller
 createGoalieC cgs
-  | null $ cgs^.cgsNumber = getGoalieNumC
+  | null $ cgs^.cgsNumber     = getGoalieNumC
-  | null $ cgs^.cgsName   = getGoalieNameC
+  | null $ cgs^.cgsName       = getGoalieNameC
-  | otherwise             = confirmCreateGoalieC
+  | null $ cgs^.cgsRookieFlag = getRookieFlagC
+  | null $ cgs^.cgsActiveFlag = getActiveFlagC
+  | otherwise                 = confirmCreateGoalieC
 
 getGoalieNumC :: Controller
-getGoalieNumC = Controller
+getGoalieNumC = promptController goalieNumPrompt
-  { drawController = drawPrompt goalieNumPrompt
+
+getGoalieNameC :: Controller
+getGoalieNameC = promptController goalieNamePrompt
+
+getRookieFlagC :: Controller
+getRookieFlagC = Controller
+  { drawController = const $ do
+    C.drawString "Is this goalie a rookie? (Y/N)"
+    return C.CursorInvisible
   , handleController = \e -> do
-    promptHandler goalieNumPrompt e
+    modify $ case ynHandler e of
+      Just True -> progMode.createGoalieStateL
+        %~ (cgsRookieFlag ?~ True)
+        .  (cgsActiveFlag ?~ True)
+      rf -> progMode.createGoalieStateL.cgsRookieFlag .~ rf
     return True
   }
 
-getGoalieNameC :: Controller
+getActiveFlagC :: Controller
-getGoalieNameC = Controller
+getActiveFlagC = Controller
-  { drawController = drawPrompt goalieNamePrompt
+  { drawController = const $ do
+    C.drawString "Is this goalie active? (Y/N)"
+    return C.CursorInvisible
   , handleController = \e -> do
-    promptHandler goalieNamePrompt e
+    modify $ progMode.createGoalieStateL.cgsActiveFlag .~ ynHandler e
     return True
   }
 
@@ -60,25 +75,33 @@ confirmCreateGoalieC = Controller
   { drawController = \s -> do
     let cgs = s^.progMode.createGoalieStateL
     C.drawString $ unlines
-      [ "Goalie number: " ++ show (fromJust $ cgs^.cgsNumber)
+      $  labelTable
-      , "  Goalie name: " ++ cgs^.cgsName
+         [ ( "Goalie number", maybe "?" show $ cgs^.cgsNumber     )
-      , ""
+         , ( "Goalie name",   cgs^.cgsName                        )
-      , "Create goalie: are you sure?  (Y/N)"
+         , ( "Rookie",        maybe "?" show $ cgs^.cgsRookieFlag )
-      ]
+         , ( "Active",        maybe "?" show $ cgs^.cgsActiveFlag )
+         ]
+      ++ [ ""
+         , "Create goalie: are you sure?  (Y/N)"
+         ]
     return C.CursorInvisible
   , handleController = \e -> do
+    cgs <- gets (^.progMode.createGoalieStateL)
+    let
+      success = cgs^.cgsSuccessCallback
+      failure = cgs^.cgsFailureCallback
     case ynHandler e of
       Just True -> do
         gid <- gets (^.database.dbGoalies.to length)
-        cb  <- gets (^.progMode.createGoalieStateL.cgsSuccessCallback)
+        let rookie = cgs^.cgsRookieFlag == Just True
-        modify
+        modify addGoalie
-          $ (progMode.editGoalieStateL
+        if rookie
+          then success
+          else modify $ progMode.editGoalieStateL
             %~ (egsSelectedGoalie ?~ gid)
-            .  (egsMode .~ EGLtGames True)
+            .  (egsMode           .~ EGLtGames True)
-            .  (egsCallback .~ cb))
+            .  (egsCallback       .~ success)
-          . addGoalie
+      Just False -> failure
-      Just False ->
+      Nothing    -> return ()
-        join $ gets (^.progMode.createGoalieStateL.cgsFailureCallback)
-      Nothing -> return ()
     return True
   }

src/Mtlstats/Control/CreatePlayer.hs

@@ -21,13 +21,12 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control.CreatePlayer (createPlayerC) where
 
-import Control.Monad (join)
 import Control.Monad.Trans.State (gets, modify)
-import Data.Maybe (fromJust)
 import Lens.Micro ((^.), (.~), (?~), (%~), to)
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
+import Mtlstats.Format
 import Mtlstats.Handlers
 import Mtlstats.Prompt
 import Mtlstats.Types
@@ -35,32 +34,43 @@ import Mtlstats.Types
 -- | Handles player creation
 createPlayerC :: CreatePlayerState -> Controller
 createPlayerC cps
-  | null $ cps^.cpsNumber   = getPlayerNumC
+  | null $ cps^.cpsNumber     = getPlayerNumC
-  | null $ cps^.cpsName     = getPlayerNameC
+  | null $ cps^.cpsName       = getPlayerNameC
-  | null $ cps^.cpsPosition = getPlayerPosC
+  | null $ cps^.cpsPosition   = getPlayerPosC
-  | otherwise               = confirmCreatePlayerC
+  | null $ cps^.cpsRookieFlag = getRookieFlagC
+  | null $ cps^.cpsActiveFlag = getActiveFlagC
+  | otherwise                 = confirmCreatePlayerC
 
 getPlayerNumC :: Controller
-getPlayerNumC = Controller
+getPlayerNumC = promptController playerNumPrompt
-  { drawController   = drawPrompt playerNumPrompt
-  , handleController = \e -> do
-    promptHandler playerNumPrompt e
-    return True
-  }
 
 getPlayerNameC :: Controller
-getPlayerNameC = Controller
+getPlayerNameC = promptController playerNamePrompt
-  { drawController   = drawPrompt playerNamePrompt
+
+getPlayerPosC :: Controller
+getPlayerPosC = promptController playerPosPrompt
+
+getRookieFlagC :: Controller
+getRookieFlagC = Controller
+  { drawController = const $ do
+    C.drawString "Is this player a rookie? (Y/N)"
+    return C.CursorInvisible
   , handleController = \e -> do
-    promptHandler playerNamePrompt e
+    modify $ case ynHandler e of
+      Just True -> progMode.createPlayerStateL
+        %~ (cpsRookieFlag ?~ True)
+        .  (cpsActiveFlag ?~ True)
+      rf -> progMode.createPlayerStateL.cpsRookieFlag .~ rf
     return True
   }
 
-getPlayerPosC :: Controller
+getActiveFlagC :: Controller
-getPlayerPosC = Controller
+getActiveFlagC = Controller
-  { drawController   = drawPrompt playerPosPrompt
+  { drawController = const $ do
+    C.drawString "Is the player active? (Y/N)"
+    return C.CursorInvisible
   , handleController = \e -> do
-    promptHandler playerPosPrompt e
+    modify $ progMode.createPlayerStateL.cpsActiveFlag .~ ynHandler e
     return True
   }
 
@@ -68,24 +78,35 @@ confirmCreatePlayerC :: Controller
 confirmCreatePlayerC = Controller
   { drawController = \s -> do
     let cps = s^.progMode.createPlayerStateL
-    C.drawString $ "  Player number: " ++ show (fromJust $ cps^.cpsNumber) ++ "\n"
+    C.drawString $ unlines
-    C.drawString $ "    Player name: " ++ cps^.cpsName ++ "\n"
+      $  labelTable
-    C.drawString $ "Player position: " ++ cps^.cpsPosition ++ "\n\n"
+         [ ( "Player number",   maybe "?" show $ cps^.cpsNumber     )
-    C.drawString "Create player: are you sure?  (Y/N)"
+         , ( "Player name",     cps^.cpsName                        )
+         , ( "Player position", cps^.cpsPosition                    )
+         , ( "Rookie",          maybe "?" show $ cps^.cpsRookieFlag )
+         , ( "Active",          maybe "?" show $ cps^.cpsActiveFlag )
+         ]
+      ++ [ ""
+         , "Create player: are you sure?  (Y/N)"
+         ]
     return C.CursorInvisible
   , handleController = \e -> do
+    cps <- gets (^.progMode.createPlayerStateL)
+    let
+      success = cps^.cpsSuccessCallback
+      failure = cps^.cpsFailureCallback
     case ynHandler e of
       Just True -> do
         pid <- gets (^.database.dbPlayers.to length)
-        cb  <- gets (^.progMode.createPlayerStateL.cpsSuccessCallback)
+        let rookie = cps^.cpsRookieFlag == Just True
-        modify
+        modify addPlayer
-          $ (progMode.editPlayerStateL
+        if rookie
+          then success
+          else modify $ progMode.editPlayerStateL
             %~ (epsSelectedPlayer ?~ pid)
-            .  (epsMode .~ EPLtGoals True)
+            .  (epsMode           .~ EPLtGoals True)
-            .  (epsCallback .~ cb))
+            .  (epsCallback       .~ success)
-          . addPlayer
+      Just False -> failure
-      Just False ->
-        join $ gets (^.progMode.createPlayerStateL.cpsFailureCallback)
       Nothing -> return ()
     return True
   }

src/Mtlstats/Control/NewGame.hs

@@ -21,13 +21,15 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control.NewGame (newGameC) where
 
-import Control.Monad.Trans.State (gets, modify)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.State (get, gets, modify)
 import Data.Maybe (fromJust, fromMaybe, isJust)
 import Lens.Micro ((^.), (.~))
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
 import Mtlstats.Actions.NewGame
+import Mtlstats.Config
 import Mtlstats.Control.NewGame.GoalieInput
 import Mtlstats.Format
 import Mtlstats.Handlers
@@ -211,9 +213,12 @@ reportC = Controller
       C.EventSpecialKey C.KeyUpArrow   -> modify scrollUp
       C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
       C.EventSpecialKey C.KeyHome      -> modify $ scrollOffset .~ 0
-      C.EventSpecialKey _              -> modify backHome
+
-      C.EventCharacter _               -> modify backHome
+      C.EventCharacter '\n' -> do
-      _                                -> return ()
+        get >>= liftIO . writeFile reportFilename . unlines . report reportCols
+        modify backHome
+
+      _ -> return ()
     return True
   }
 

src/Mtlstats/Helpers/Position.hs

@@ -0,0 +1,89 @@
+{- |
+
+mtlstats
+Copyright (C) 1984, 1985, 2019, 2020 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 LambdaCase #-}
+
+module Mtlstats.Helpers.Position
+  ( posSearch
+  , posSearchExact
+  , posCallback
+  , getPositions
+  ) where
+
+import Control.Monad.Trans.State (gets)
+import Data.Char (toUpper)
+import Data.List (isInfixOf)
+import Data.Maybe (fromMaybe)
+import qualified Data.Set as S
+import Lens.Micro ((^.), to)
+
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Searches the 'Database' for all the positions used
+posSearch
+  :: String
+  -- ^ The search string
+  -> Database
+  -- ^ The database
+  -> [(Int, String)]
+  -- ^ A list of result indices and their values
+posSearch sStr db = filter sFunc $ zip [0..] ps
+  where
+    sFunc (_, pos) = map toUpper sStr `isInfixOf` map toUpper pos
+    ps = getPositions db
+
+-- | Searches the 'Database' for an exact position
+posSearchExact
+  :: String
+  -- ^ The search string
+  -> Database
+  -- ^ The database
+  -> Maybe Int
+  -- ^ The index of the result (or 'Nothing' if not found)
+posSearchExact sStr db = case filter sFunc $ zip [0..] ps of
+  []      -> Nothing
+  (n,_):_ -> Just n
+  where
+    sFunc (_, pos) = sStr == pos
+    ps = getPositions db
+
+-- | Builds a callback function for when a 'Player' position is
+-- selected
+posCallback
+  :: (String -> Action ())
+  -- ^ The raw callback function
+  -> Maybe Int
+  -- ^ The index number of the position selected or 'Nothing' if blank
+  -> Action ()
+  -- ^ The action to perform
+posCallback callback = \case
+  Nothing -> callback ""
+  Just n  -> do
+    ps <- gets (^.database.to getPositions)
+    let pos = fromMaybe "" $ nth n ps
+    callback pos
+
+-- | Extracts a list of positions from a 'Database'
+getPositions :: Database -> [String]
+getPositions = do
+  raw <- map (^.pPosition) . (^.dbPlayers)
+  return $ S.toList $ S.fromList raw

src/Mtlstats/Menu.hs

@@ -170,10 +170,11 @@ gameGoalieMenu s = let
       goalie <- nth n $ s^.database.dbGoalies
       Just (n, goalie))
     gids
-  in Menu title () $ map
+  in Menu title () $ zipWith
-    (\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
+    (\ch (gid, goalie) -> MenuItem ch (goalieSummary goalie) $
-      modify $ GI.setGameGoalie gid) $
+      modify $ GI.setGameGoalie gid)
-    zip ['1'..] goalies
+    ['1'..]
+    goalies
 
 -- | The edit menu
 editMenu :: Menu ()

src/Mtlstats/Prompt.hs

@@ -42,6 +42,7 @@ module Mtlstats.Prompt (
   goalieNamePrompt,
   selectPlayerPrompt,
   selectGoaliePrompt,
+  selectPositionPrompt,
   playerToEditPrompt
 ) where
 
@@ -56,6 +57,7 @@ import qualified UI.NCurses as C
 
 import Mtlstats.Actions
 import Mtlstats.Config
+import Mtlstats.Helpers.Position
 import Mtlstats.Types
 import Mtlstats.Util
 
@@ -162,9 +164,7 @@ numPromptWithFallback pStr fallback act = Prompt
   , promptProcessChar = \ch str -> if isDigit ch
     then str ++ [ch]
     else str
-  , promptAction      = \inStr -> case readMaybe inStr of
+  , promptAction      = maybe fallback act . readMaybe
-      Nothing -> fallback
-      Just n  -> act n
   , promptSpecialKey  = const $ return ()
   }
 
@@ -236,7 +236,7 @@ playerNamePrompt = namePrompt "Player name: " $
 
 -- | Prompts for a new player's position
 playerPosPrompt :: Prompt
-playerPosPrompt = ucStrPrompt "Player position: " $
+playerPosPrompt = selectPositionPrompt "Player position: " $
   modify . (progMode.createPlayerStateL.cpsPosition .~)
 
 -- | Prompts tor the goalie's number
@@ -307,6 +307,24 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
     modify $ progMode .~ CreateGoalie cgs
   }
 
+-- | Selects (or creates) a player position
+selectPositionPrompt
+  :: String
+  -- ^ The 'Prompt' string
+  -> (String -> Action ())
+  -- ^ The action to perform when a value is entered
+  -> Prompt
+selectPositionPrompt pStr callback = selectPrompt SelectParams
+  { spPrompt = pStr
+  , spSearchHeader = "Positions:"
+  , spSearch = posSearch
+  , spSearchExact = posSearchExact
+  , spElemDesc = id
+  , spProcessChar = \ch -> (++ [toUpper ch])
+  , spCallback = posCallback callback
+  , spNotFound = callback
+  }
+
 playerToEditPrompt :: Prompt
 playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
   modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)

src/Mtlstats/Prompt/EditPlayer.hs

@@ -62,7 +62,7 @@ editPlayerPosPrompt
   :: Action ()
   -- ^ The action to be performed upon completion
   -> Prompt
-editPlayerPosPrompt callback = ucStrPrompt "Player position: " $ \pos -> do
+editPlayerPosPrompt callback = selectPositionPrompt "Player position: " $ \pos -> do
   if null pos
     then goto EPMenu
     else doEdit EPMenu $ pPosition .~ pos

src/Mtlstats/Report.hs

@@ -241,8 +241,7 @@ filteredPlayerReport width label criteria showTotals lineNumbers ps = let
     else repeat ""
 
   table = overlayLast olayText
-    $ map (\(ln, line) -> overlay ln $ centre width line)
+    $ zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
-    $ zip lnOverlay
     $ complexTable ([right, left] ++ repeat right)
     $ tHeader : body ++ if showTotals
       then [separator, totals]
@@ -301,8 +300,7 @@ goalieReport width showTotals lineNumbers goalieData = let
     then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
     else repeat ""
 
-  in map (\(ln, line) -> overlay ln $ centre width line)
+  in zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
-    $ zip lnOverlay
     $ overlayLast olayText
     $ complexTable ([right, left] ++ repeat right)
     $ header : body ++ if showTotals

src/Mtlstats/Types.hs

@@ -88,11 +88,15 @@ module Mtlstats.Types (
   cpsNumber,
   cpsName,
   cpsPosition,
+  cpsRookieFlag,
+  cpsActiveFlag,
   cpsSuccessCallback,
   cpsFailureCallback,
   -- ** CreateGoalieState Lenses
   cgsNumber,
   cgsName,
+  cgsRookieFlag,
+  cgsActiveFlag,
   cgsSuccessCallback,
   cgsFailureCallback,
   -- ** EditPlayerState Lenses
@@ -204,9 +208,8 @@ import Data.Aeson
   , (.=)
   )
 import Data.Char (toUpper)
-import Data.List (isInfixOf)
+import Data.List (find, isInfixOf)
 import qualified Data.Map as M
-import Data.Maybe (listToMaybe)
 import Lens.Micro (Lens', lens, (&), (^.), (.~))
 import Lens.Micro.TH (makeLenses)
 import qualified UI.NCurses as C
@@ -328,6 +331,10 @@ data CreatePlayerState = CreatePlayerState
   -- ^ The player's name
   , _cpsPosition        :: String
   -- ^ The player's position
+  , _cpsRookieFlag      :: Maybe Bool
+  -- ^ Indicates whether or not the player is a rookie
+  , _cpsActiveFlag      :: Maybe Bool
+  -- ^ Indicates whether or not the plauer is active
   , _cpsSuccessCallback :: Action ()
   -- ^ The function to call on success
   , _cpsFailureCallback :: Action ()
@@ -336,10 +343,14 @@ data CreatePlayerState = CreatePlayerState
 
 -- | Goalie creation status
 data CreateGoalieState = CreateGoalieState
-  { _cgsNumber    :: Maybe Int
+  { _cgsNumber          :: Maybe Int
   -- ^ The goalie's number
-  , _cgsName      :: String
+  , _cgsName            :: String
   -- ^ The goalie's name
+  , _cgsRookieFlag      :: Maybe Bool
+  -- ^ Indicates whether or not the goalie is a rookie
+  , _cgsActiveFlag      :: Maybe Bool
+  -- ^ Indicates whether or not the goalie is active
   , _cgsSuccessCallback :: Action ()
   -- ^ The function to call on success
   , _cgsFailureCallback :: Action ()
@@ -807,6 +818,8 @@ newCreatePlayerState = CreatePlayerState
   { _cpsNumber          = Nothing
   , _cpsName            = ""
   , _cpsPosition        = ""
+  , _cpsRookieFlag      = Nothing
+  , _cpsActiveFlag      = Nothing
   , _cpsSuccessCallback = return ()
   , _cpsFailureCallback = return ()
   }
@@ -816,6 +829,8 @@ newCreateGoalieState :: CreateGoalieState
 newCreateGoalieState = CreateGoalieState
   { _cgsNumber          = Nothing
   , _cgsName            = ""
+  , _cgsRookieFlag      = Nothing
+  , _cgsActiveFlag      = Nothing
   , _cgsSuccessCallback = return ()
   , _cgsFailureCallback = return ()
   }
@@ -1003,7 +1018,7 @@ playerSearchExact
   -> Maybe (Int, Player)
   -- ^ The player's index and value
 playerSearchExact sStr =
-  listToMaybe . filter match . zip [0..]
+  find match . zip [0..]
   where match (_, p) = p^.pName == sStr
 
 -- | Modifies a player with a given name

src/Mtlstats/Util.hs

@@ -52,8 +52,9 @@ modifyNth
   -> [a]
   -- ^ The list
   -> [a]
-modifyNth n f = map (\(i, x) -> if i == n then f x else x)
+modifyNth n f = zipWith
-  . zip [0..]
+  (\i x -> if i == n then f x else x)
+  [0..]
 
 -- | Modify a value indexed by a given key in a map using a default
 -- initial value if not present

test/Actions/NewGame/GoalieInputSpec.hs

@@ -23,7 +23,7 @@ module Actions.NewGame.GoalieInputSpec (spec) where
 
 import qualified Data.Map as M
 import Data.Maybe (fromJust)
-import Lens.Micro ((^.), (&), (.~), (?~))
+import Lens.Micro ((^.), (&), (.~), (?~), (%~))
 import Test.Hspec (Spec, context, describe, it, shouldBe)
 
 import Mtlstats.Actions.NewGame.GoalieInput
@@ -33,27 +33,50 @@ import Mtlstats.Util
 import qualified TypesSpec as TS
 
 spec :: Spec
-spec = describe "Mtlstats.Actions.GoalieInput" $ do
+spec = describe "GoalieInput" $ do
   finishGoalieEntrySpec
   recordGoalieStatsSpec
   setGameGoalieSpec
 
 finishGoalieEntrySpec :: Spec
-finishGoalieEntrySpec = describe "finishGoalieEntry" $ do
+finishGoalieEntrySpec = describe "finishGoalieEntry" $ mapM_
-  let
+  (\(label, stats, grFlag, gaFlag) -> context label $ do
-    progState stats = newProgState
+    let
-      & progMode.gameStateL.gameGoalieStats .~ stats
+      ps = newProgState
-      & finishGoalieEntry
+        & progMode.gameStateL
+          %~ (gameGoalieStats .~ stats)
+          .  (gameType        ?~ HomeGame)
+          .  (homeScore       ?~ 1)
+          .  (awayScore       ?~ 0)
+          .  (overtimeFlag    ?~ False)
+        & database.dbGoalies .~ goalies
 
-  context "no goalie data" $
+      ps' = finishGoalieEntry ps
-    it "should not set goaliesRecorded" $ let
+      gs  = ps'^.progMode.gameStateL
-      s = progState M.empty
-      in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` False
 
-  context "goalie data" $
+    describe "gameGoaliesRecorded" $
-    it "should set goaliesRecorded" $ let
+      it ("should be " ++ show grFlag) $
-      s = progState $ M.fromList [(1, newGoalieStats)]
+        gs^.gameGoaliesRecorded `shouldBe` grFlag
-      in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` True
+
+    describe "gameGoalieAssigned" $
+      it ("should be " ++ show gaFlag) $
+        gs^.gameGoalieAssigned `shouldBe` gaFlag)
+
+  --  label,         initial stats, goalies recorded, goalie assigned
+  [ ( "no goalies",  noGoalies,     False,            False           )
+  , ( "one goalie",  oneGoalie,     True,             True            )
+  , ( "two goalies", twoGoalies,    True,             False           )
+  ]
+
+  where
+    goalies    = [joe, bob]
+    joe        = newGoalie 2 "Joe"
+    bob        = newGoalie 3 "Bob"
+    noGoalies  = M.empty
+    oneGoalie  = M.fromList [joeStats]
+    twoGoalies = M.fromList [joeStats, bobStats]
+    joeStats   = (0, newGoalieStats)
+    bobStats   = (1, newGoalieStats)
 
 recordGoalieStatsSpec :: Spec
 recordGoalieStatsSpec = describe "recordGoalieStats" $ let
@@ -185,107 +208,175 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
     ]
 
 setGameGoalieSpec :: Spec
-setGameGoalieSpec = describe "setGameGoalie" $ let
+setGameGoalieSpec = describe "setGameGoalie" $ mapM_
 
-  goalieStats w l t = newGoalieStats
+  (\(label, goalieId, ps, expectedJoe, expectedBob, expectedGStats) ->
-    & gsWins   .~ w
+    context label $ do
-    & gsLosses .~ l
-    & gsTies   .~ t
 
-  bob = newGoalie 2 "Bob"
+      let
-    & gYtd      .~ goalieStats 10 11 12
+        ps'          = setGameGoalie goalieId ps
-    & gLifetime .~ goalieStats 20 21 22
+        [joe', bob'] = ps'^.database.dbGoalies
+        gStats'      = ps'^.progMode.gameStateL.gameGoalieStats
 
-  joe = newGoalie 3 "Joe"
+      context "Joe" $ joe' `TS.compareTest` expectedJoe
-    & gYtd      .~ goalieStats 30 31 32
+      context "Bob" $ bob' `TS.compareTest` expectedBob
-    & gLifetime .~ goalieStats 40 41 42
+      context "game stats" $ gStats' `TS.compareTest` expectedGStats)
 
-  gameState h a ot = newGameState
+  [ ( "Joe wins - no shutout"
-    & gameType        ?~ HomeGame
+    , 0
-    & homeScore       ?~ h
+    , psWin
-    & awayScore       ?~ a
+    , joeWin
-    & overtimeFlag    ?~ ot
+    , bob
+    , gsJoeWin
+    )
 
-  winningGame = gameState 1 0 False
+  , ( "Bob wins - no shutout"
-  losingGame  = gameState 0 1 False
+    , 1
-  tiedGame    = gameState 0 1 True
+    , psWin
+    , joe
+    , bobWin
+    , gsBobWin
+    )
 
-  in mapM_
+  , ( "Joe wins - shutout"
-    (\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
+    , 0
+    , psWinSO
+    , joeWinSO
+    , bob
+    , gsJoeWinSO
+    )
 
-      progState = newProgState
+  , ( "Bob wins - shutout"
-        & database.dbGoalies  .~ [bob, joe]
+    , 1
-        & progMode.gameStateL .~ gs
+    , psWinSO
-        & setGameGoalie setGid
+    , joe
+    , bobWinSO
+    , gsBobWinSO
+    )
 
-      in mapM_
+  , ( "Joe loses"
-        (\( chkLabel
+    , 0
-          , chkGid
+    , psLose
-          , ( gWins
+    , joeLose
-            , gLosses
+    , bob
-            , gTies
+    , gsJoeLose
-            , ytdWins
+    )
-            , ytdLosses
-            , ytdTies
-            , ltWins
-            , ltLosses
-            , ltTies
-            )
-          ) -> context chkLabel $ do
-            let
-              goalie = (progState^.database.dbGoalies) !! chkGid
-              gameStats = progState^.progMode.gameStateL.gameGoalieStats
-              game      = M.findWithDefault newGoalieStats chkGid gameStats
-              ytd       = goalie^.gYtd
-              lifetime  = goalie^.gLifetime
 
-            mapM_
+  , ( "Bob loses"
-              (\(label', expected, actual) -> context label' $
+    , 1
-                expected `TS.compareTest` actual)
+    , psLose
-              [ ( "game stats",     game,     goalieStats gWins   gLosses   gTies   )
+    , joe
-              , ( "YTD stats",      ytd,      goalieStats ytdWins ytdLosses ytdTies )
+    , bobLose
-              , ( "lifetime stats", lifetime, goalieStats ltWins  ltLosses  ltTies  )
+    , gsBobLose
-              ]
+    )
 
-            it "should set the gameGoalieAssigned flag" $
+  , ( "Joe overtime"
-              progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
+    , 0
-        [ ( "checking Bob", 0, bobData )
+    , psOT
-        , ( "checking Joe", 1, joeData )
+    , joeOT
-        ])
+    , bob
-    [ ( "Bob wins"
+    , gsJoeOT
-      , winningGame
+    )
-      , 0
+
-      , ( 1, 0, 0, 11, 11, 12, 21, 21, 22 )
+  , ( "Bob overtime"
-      , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
+    , 1
-      )
+    , psOT
-    , ( "Bob loses"
+    , joe
-      , losingGame
+    , bobOT
-      , 0
+    , gsBobOT
-      , ( 0, 1, 0, 10, 12, 12, 20, 22, 22 )
+    )
-      , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
+  ]
-      )
+
-    , ( "Bob ties"
+  where
-      , tiedGame
+
-      , 0
+    joe
-      , ( 0, 0, 1, 10, 11, 13, 20, 21, 23 )
+      = newGoalie 2 "Joe"
-      , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
+      & gYtd
-      )
+        %~ (gsShutouts .~ 11)
-    , ( "Joe wins"
+        .  (gsWins     .~ 12)
-      , winningGame
+        .  (gsLosses   .~ 13)
-      , 1
+        .  (gsTies     .~ 14)
-      , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
+      & gLifetime
-      , ( 1, 0, 0, 31, 31, 32, 41, 41, 42 )
+        %~ (gsShutouts .~ 21)
-      )
+        .  (gsWins     .~ 22)
-    , ( "Joe loses"
+        .  (gsLosses   .~ 23)
-      , losingGame
+        .  (gsTies     .~ 24)
-      , 1
+
-      , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
+    bob
-      , ( 0, 1, 0, 30, 32, 32, 40, 42, 42 )
+      = newGoalie 3 "Bob"
-      )
+      & gYtd
-    , ( "Joe ties"
+        %~ (gsShutouts .~ 31)
-      , tiedGame
+        .  (gsWins     .~ 32)
-      , 1
+        .  (gsLosses   .~ 33)
-      , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
+        .  (gsTies     .~ 34)
-      , ( 0, 0, 1, 30, 31, 33, 40, 41, 43 )
+      & gLifetime
-      )
+        %~ (gsShutouts .~ 41)
-    ]
+        .  (gsWins     .~ 42)
+        .  (gsLosses   .~ 43)
+        .  (gsTies     .~ 44)
+
+    joeWin   = win joe
+    bobWin   = win bob
+    joeWinSO = winSO joe
+    bobWinSO = winSO bob
+    joeLose  = lose joe
+    bobLose  = lose bob
+    joeOT    = tie joe
+    bobOT    = tie bob
+
+    psWin = mkProgState
+      $ (homeScore ?~ 2)
+      . (awayScore ?~ 1)
+
+    psWinSO = mkProgState
+      $ (homeScore ?~ 1)
+      . (awayScore ?~ 0)
+
+    psLose = mkProgState
+      $ (homeScore ?~ 0)
+      . (awayScore ?~ 1)
+
+    psOT = mkProgState
+      $ (homeScore    ?~ 0)
+      . (awayScore    ?~ 1)
+      . (overtimeFlag ?~ True)
+
+    mkProgState f
+      = newProgState
+      & database.dbGoalies  .~ [joe, bob]
+      & progMode.gameStateL
+        %~ f
+        .  (gameType     ?~ HomeGame)
+        .  (overtimeFlag ?~ False)
+
+    gsJoeWin   = mkGameStats 0 incWin
+    gsBobWin   = mkGameStats 1 incWin
+    gsJoeWinSO = mkGameStats 0 $ incWin . incSO
+    gsBobWinSO = mkGameStats 1 $ incWin . incSO
+    gsJoeLose  = mkGameStats 0 incLoss
+    gsBobLose  = mkGameStats 1 incLoss
+    gsJoeOT    = mkGameStats 0 incOT
+    gsBobOT    = mkGameStats 1 incOT
+
+    mkGameStats n f = M.fromList [(n, f newGoalieStats)]
+
+    win
+      = (gYtd      %~ incWin)
+      . (gLifetime %~ incWin)
+
+    winSO
+      = (gYtd      %~ (incWin . incSO))
+      . (gLifetime %~ (incWin . incSO))
+
+    lose
+      = (gYtd      %~ incLoss)
+      . (gLifetime %~ incLoss)
+
+    tie
+      = (gYtd      %~ incOT)
+      . (gLifetime %~ incOT)
+
+    incWin  = gsWins     %~ succ
+    incSO   = gsShutouts %~ succ
+    incLoss = gsLosses   %~ succ
+    incOT   = gsTies     %~ succ

test/ActionsSpec.hs

@@ -312,51 +312,93 @@ editSelectedGoalieSpec = describe "editSelectedGoalie" $ mapM_
     goalie' n      = newGoalie n "foo"
 
 addPlayerSpec :: Spec
-addPlayerSpec = describe "addPlayer" $ do
+addPlayerSpec = describe "addPlayer" $ mapM_
-  let
+  (\(label, expectation, pm, players) -> context label $
-    p1 = newPlayer 1 "Joe" "centre"
+    it expectation $ let
-    p2 = newPlayer 2 "Bob" "defense"
+      ps = newProgState
-    db = newDatabase
+        & progMode           .~ pm
-      & dbPlayers .~ [p1]
+        & database.dbPlayers .~ [joe]
-    s pm = newProgState
+      ps' = addPlayer ps
-      & progMode .~ pm
+      in ps'^.database.dbPlayers `shouldBe` players)
-      & database .~ db
 
-  context "data available" $
+  --  label,                 expectation, progMode,  players
-    it "should create the player" $ let
+  [ ( "wrong mode",          failure,     MainMenu,  [joe]          )
-      s' = addPlayer $ s $ CreatePlayer $ newCreatePlayerState
+  , ( "missing number",      failure,     noNum,     [joe]          )
-        & cpsNumber   ?~ 2
+  , ( "missing rookie flag", failure,     noRookie,  [joe]          )
-        & cpsName     .~ "Bob"
+  , ( "missing active flag", failure,     noActive,  [joe]          )
-        & cpsPosition .~ "defense"
+  , ( "rookie",              success,     mkRookie,  [joe, rookie]  )
-      in s'^.database.dbPlayers `shouldBe` [p1, p2]
+  , ( "retired",             success,     mkRetired, [joe, retired] )
+  , ( "normal player",       success,     mkNormal,  [joe, normal]  )
+  ]
 
-  context "data unavailable" $
+  where
-    it "should not create the player" $ let
+    failure   = "should not create the player"
-      s' = addPlayer $ s MainMenu
+    success   = "should create the player"
-      in s'^.database.dbPlayers `shouldBe` [p1]
+    noNum     = mkpm Nothing  (Just False) (Just True)
+    noRookie  = mkpm (Just 3) Nothing      (Just True)
+    noActive  = mkpm (Just 3) (Just False) Nothing
+    mkRookie  = mkpm (Just 3) (Just True)  (Just True)
+    mkRetired = mkpm (Just 3) (Just False) (Just False)
+    mkNormal  = mkpm (Just 3) (Just False) (Just True)
+    joe       = newPlayer 2 "Joe" "centre"
+    rookie    = player True  True
+    retired   = player False False
+    normal    = player False True
+
+    player r a = newPlayer 3 "Bob" "defense"
+      & pRookie .~ r
+      & pActive .~ a
+
+    mkpm n r a = CreatePlayer $ newCreatePlayerState
+      & cpsNumber     .~ n
+      & cpsName       .~ "Bob"
+      & cpsPosition   .~ "defense"
+      & cpsRookieFlag .~ r
+      & cpsActiveFlag .~ a
 
 addGoalieSpec :: Spec
-addGoalieSpec = describe "addGoalie" $ do
+addGoalieSpec = describe "addGoalie" $ mapM_
-  let
+  (\(label, expectation, pm, goalies) -> context label $
-    g1 = newGoalie 2 "Joe"
+    it expectation $ let
-    g2 = newGoalie 3 "Bob"
+      ps = newProgState
-    db = newDatabase
+        & progMode           .~ pm
-      & dbGoalies .~ [g1]
+        & database.dbGoalies .~ [joe]
-    s pm = newProgState
+      ps' = addGoalie ps
-      & database .~ db
+      in ps'^.database.dbGoalies `shouldBe` goalies)
-      & progMode .~ pm
 
-  context "data available" $
+  --  label,            expectation, progMode,  expected goalies
-    it "should create the goalie" $ let
+  [ ( "wrong mode",     failure,     MainMenu,  [joe]            )
-      s' = addGoalie $ s $ CreateGoalie $ newCreateGoalieState
+  , ( "no number",      failure,     noNum,     [joe]            )
-        & cgsNumber ?~ 3
+  , ( "no rookie flag", failure,     noRookie,  [joe]            )
-        & cgsName   .~ "Bob"
+  , ( "no active flag", failure,     noActive,  [joe]            )
-      in s'^.database.dbGoalies `shouldBe` [g1, g2]
+  , ( "rookie",         success,     mkRookie,  [joe, rookie]    )
+  , ( "retired",        success,     mkRetired, [joe, retired]   )
+  , ( "normal goalie",  success,     mkNormal,  [joe, normal]    )
+  ]
 
-  context "data unavailable" $
+  where
-    it "should not create the goalie" $ let
+    failure   = "should not create the goalie"
-      s' = addGoalie $ s MainMenu
+    success   = "should create the goalie"
-      in s'^.database.dbGoalies `shouldBe` [g1]
+    noNum     = cgs Nothing  (Just False) (Just True)
+    noRookie  = cgs (Just 3) Nothing      (Just True)
+    noActive  = cgs (Just 3) (Just False) Nothing
+    mkRookie  = cgs (Just 3) (Just True)  (Just True)
+    mkRetired = cgs (Just 3) (Just False) (Just False)
+    mkNormal  = cgs (Just 3) (Just False) (Just True)
+    joe       = newGoalie 2 "Joe"
+    rookie    = goalie True  True
+    retired   = goalie False False
+    normal    = goalie False True
+
+    goalie r a = newGoalie 3 "Bob"
+      & gRookie .~ r
+      & gActive .~ a
+
+    cgs n r a = CreateGoalie $ newCreateGoalieState
+      & cgsNumber     .~ n
+      & cgsName       .~ "Bob"
+      & cgsRookieFlag .~ r
+      & cgsActiveFlag .~ a
 
 resetCreatePlayerStateSpec :: Spec
 resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let

test/Helpers/PositionSpec.hs

@@ -0,0 +1,79 @@
+{-
+
+mtlstats
+Copyright (C) 1984, 1985, 2019, 2020 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/>.
+
+-}
+
+module Helpers.PositionSpec (spec) where
+
+import Lens.Micro ((&), (.~))
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Mtlstats.Helpers.Position
+import Mtlstats.Types
+
+spec :: Spec
+spec = describe "Position" $ do
+  posSearchSpec
+  posSearchExactSpec
+  getPositionsSpec
+
+posSearchSpec :: Spec
+posSearchSpec = describe "posSearch" $ mapM_
+  (\(sStr, expected) -> context ("search string: " ++ show sStr) $
+    it ("should be " ++ show expected) $
+      posSearch sStr db `shouldBe` expected)
+  [ ( "fOo"
+    , [ ( 2, "foo" )
+      ]
+    )
+  , ( "A"
+    , [ ( 0, "bar" )
+      , ( 1, "baz" )
+      ]
+    )
+  ]
+
+posSearchExactSpec :: Spec
+posSearchExactSpec = describe "posSearchExact" $ mapM_
+  (\(input, expected) -> context ("input: " ++ show input) $
+    it ("should be " ++ show expected) $
+      posSearchExact input db `shouldBe` expected)
+
+  --  input,  expected
+  [ ( "foo",  Just 2   )
+  , ( "FOO",  Nothing  )
+  , ( "bar",  Just 0   )
+  , ( "baz",  Just 1   )
+  , ( "a",    Nothing  )
+  , ( "quux", Nothing  )
+  ]
+
+getPositionsSpec :: Spec
+getPositionsSpec = describe "getPositions" $ let
+  expected = ["bar", "baz", "foo"]
+  in it ("should be " ++ show expected) $
+    getPositions db `shouldBe` expected
+
+db :: Database
+db = newDatabase & dbPlayers .~
+  [ newPlayer 2 "Joe"  "foo"
+  , newPlayer 3 "Bob"  "bar"
+  , newPlayer 5 "Bill" "foo"
+  , newPlayer 8 "Ed"   "baz"
+  ]

test/HelpersSpec.hs

@@ -25,8 +25,10 @@ import Test.Hspec (Spec, describe)
 
 import qualified Helpers.GoalieSpec as Goalie
 import qualified Helpers.PlayerSpec as Player
+import qualified Helpers.PositionSpec as Position
 
 spec :: Spec
 spec = describe "Helper" $ do
   Player.spec
   Goalie.spec
+  Position.spec

test/TypesSpec.hs

@@ -19,7 +19,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE OverloadedStrings, RankNTypes #-}
+{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-}
 
 module TypesSpec
   ( Comparable (..)
@@ -33,6 +33,7 @@ module TypesSpec
 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', (&), (^.), (.~), (?~))
@@ -1005,3 +1006,48 @@ 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)

vagrant/as_user.sh

@@ -0,0 +1,8 @@
+#!/bin/sh
+
+echo "export PATH=\"$HOME/.local/bin:$PATH\"" >>~vagrant/.bashrc
+mkdir /vagrant/data
+ln -s /vagrant/data ~vagrant/.mtlstats
+
+cd /vagrant
+stack install

vagrant/provision.sh

@@ -0,0 +1,10 @@
+#!/bin/sh
+
+apt-get update
+apt-get upgrade
+apt-get -y install libghc-ncurses-dev
+wget -qO- https://get.haskellstack.org/ | sh
+
+export HOME=/home/vagrant
+
+sudo -u vagrant /vagrant/vagrant/as_user.sh