Merge pull request #29 from mtlstats/goalie-data

Record goalie data

src/Mtlstats/Actions.hs

@@ -31,12 +31,17 @@ module Mtlstats.Actions
   , updateGameStats
   , validateGameDate
   , createPlayer
+  , createGoalie
   , addPlayer
+  , addGoalie
+  , resetCreatePlayerState
+  , resetCreateGoalieState
   , recordGoalAssists
   , awardGoal
   , awardAssist
   , resetGoalData
   , assignPMins
+  , recordGoalieStats
   , backHome
   , scrollUp
   , scrollDown
@@ -139,13 +144,21 @@ validateGameDate s = fromMaybe s $ do
 -- | Starts player creation mode
 createPlayer :: ProgState -> ProgState
 createPlayer = let
-  cb = modify $ progMode .~ MainMenu
+  callback = modify $ progMode .~ MainMenu
-  cps
+  cps = newCreatePlayerState
-    = newCreatePlayerState
+    & cpsSuccessCallback .~ callback
-    & cpsSuccessCallback .~ cb
+    & cpsFailureCallback .~ callback
-    & cpsFailureCallback .~ cb
   in progMode .~ CreatePlayer cps
 
+-- | Starts goalie creation mode
+createGoalie :: ProgState -> ProgState
+createGoalie = let
+  callback = modify $ progMode .~ MainMenu
+  cgs = newCreateGoalieState
+    & cgsSuccessCallback .~ callback
+    & cgsFailureCallback .~ callback
+  in progMode .~ CreateGoalie cgs
+
 -- | Adds the entered player to the roster
 addPlayer :: ProgState -> ProgState
 addPlayer s = fromMaybe s $ do
@@ -158,6 +171,30 @@ addPlayer s = fromMaybe s $ do
   Just $ s & database.dbPlayers
     %~ (++[player])
 
+-- | Adds the entered goalie to the roster
+addGoalie :: ProgState -> ProgState
+addGoalie s = fromMaybe s $ do
+  let cgs = s^.progMode.createGoalieStateL
+  num <- cgs^.cgsNumber
+  let
+    name   = cgs^.cgsName
+    goalie = newGoalie num name
+  Just $ s & database.dbGoalies
+    %~ (++[goalie])
+
+-- | Resets the 'CreatePlayerState' value
+resetCreatePlayerState :: ProgState -> ProgState
+resetCreatePlayerState = progMode.createPlayerStateL
+  %~ (cpsNumber   .~ Nothing)
+  .  (cpsName     .~ "")
+  .  (cpsPosition .~ "")
+
+-- | Resets the 'CreateGoalieState' value
+resetCreateGoalieState :: ProgState -> ProgState
+resetCreateGoalieState = progMode.createGoalieStateL
+  %~ (cgsNumber .~ Nothing)
+  .  (cgsName   .~ "")
+
 -- | Awards the goal and assists to the players
 recordGoalAssists :: ProgState -> ProgState
 recordGoalAssists ps = fromMaybe ps $ do
@@ -233,6 +270,31 @@ assignPMins mins s = fromMaybe s $ do
          )
       .  (selectedPlayer .~ Nothing)
 
+-- | Records the goalie's game stats
+recordGoalieStats :: ProgState -> ProgState
+recordGoalieStats s = fromMaybe s $ do
+  let gs = s^.progMode.gameStateL
+  gid    <- gs^.gameSelectedGoalie
+  goalie <- nth gid $ s^.database.dbGoalies
+  mins   <- gs^.goalieMinsPlayed
+  goals  <- gs^.goalsAllowed
+
+  let
+    bumpStats gs = gs
+      & gsMinsPlayed   +~ mins
+      & gsGoalsAllowed +~ goals
+
+  Just $ s
+    & progMode.gameStateL
+      %~ (gameGoalieStats    %~ updateMap gid newGoalieStats bumpStats)
+      .  (gameSelectedGoalie .~ Nothing)
+      .  (goalieMinsPlayed   .~ Nothing)
+      .  (goalsAllowed       .~ Nothing)
+    & database.dbGoalies
+      %~ modifyNth gid (\goalie -> goalie
+         & gYtd      %~ bumpStats
+         & gLifetime %~ bumpStats)
+
 -- | Resets the program state back to the main menu
 backHome :: ProgState -> ProgState
 backHome

src/Mtlstats/Config.hs

@@ -40,3 +40,7 @@ dbFname = "database.json"
 -- | The maximum number of assists
 maxAssists :: Int
 maxAssists = 2
+
+-- | The length of a typical game (in minutes)
+gameLength :: Int
+gameLength = 60

src/Mtlstats/Control.hs

@@ -31,6 +31,7 @@ import Lens.Micro.Extras (view)
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
+import Mtlstats.Control.GoalieInput
 import Mtlstats.Format
 import Mtlstats.Handlers
 import Mtlstats.Menu
@@ -58,12 +59,17 @@ dispatch s = case s^.progMode of
     | fromJust (unaccountedPoints gs) -> goalInput gs
     | isJust $ gs^.selectedPlayer     -> getPMinsC
     | not $ gs^.pMinsRecorded         -> pMinPlayerC
+    | not $ gs^.goaliesRecorded       -> goalieInput gs
     | otherwise                       -> reportC
   CreatePlayer cps
     | null $ cps^.cpsNumber   -> getPlayerNumC
     | null $ cps^.cpsName     -> getPlayerNameC
     | null $ cps^.cpsPosition -> getPlayerPosC
     | otherwise               -> confirmCreatePlayerC
+  CreateGoalie cgs
+    | null $ cgs^.cgsNumber -> getGoalieNumC
+    | null $ cgs^.cgsName   -> getGoalieNameC
+    | otherwise             -> confirmCreateGoalieC
 
 mainMenuC :: Controller
 mainMenuC = Controller
@@ -336,6 +342,44 @@ confirmCreatePlayerC = Controller
     return True
   }
 
+getGoalieNumC :: Controller
+getGoalieNumC = Controller
+  { drawController = drawPrompt goalieNumPrompt
+  , handleController = \e -> do
+    promptHandler goalieNumPrompt e
+    return True
+  }
+
+getGoalieNameC :: Controller
+getGoalieNameC = Controller
+  { drawController = drawPrompt goalieNamePrompt
+  , handleController = \e -> do
+    promptHandler goalieNamePrompt e
+    return True
+  }
+
+confirmCreateGoalieC :: Controller
+confirmCreateGoalieC = Controller
+  { drawController = \s -> do
+    let cgs = s^.progMode.createGoalieStateL
+    C.drawString $ unlines
+      [ "Goalie number: " ++ show (fromJust $ cgs^.cgsNumber)
+      , "  Goalie name: " ++ cgs^.cgsName
+      , ""
+      , "Create goalie: are you sure?  (Y/N)"
+      ]
+    return C.CursorInvisible
+  , handleController = \e -> do
+    case ynHandler e of
+      Just True -> do
+        modify addGoalie
+        join $ gets (^.progMode.createGoalieStateL.cgsSuccessCallback)
+      Just False ->
+        join $ gets (^.progMode.createGoalieStateL.cgsFailureCallback)
+      Nothing -> return ()
+    return True
+  }
+
 gameGoal :: ProgState -> (Int, Int)
 gameGoal s =
   ( s^.database.dbGames

src/Mtlstats/Control/GoalieInput.hs

@@ -0,0 +1,75 @@
+{- |
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Control.GoalieInput (goalieInput) where
+
+import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.))
+import qualified UI.NCurses as C
+
+import Mtlstats.Format
+import Mtlstats.Prompt
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | The dispatcher for handling goalie input
+goalieInput :: GameState -> Controller
+goalieInput gs
+  | null $ gs^.gameSelectedGoalie = selectGoalieC
+  | null $ gs^.goalieMinsPlayed   = minsPlayedC
+  | otherwise                     = goalsAllowedC
+
+selectGoalieC :: Controller
+selectGoalieC = Controller
+  { drawController   = drawPrompt selectGameGoaliePrompt
+  , handleController = \e -> do
+    promptHandler selectGameGoaliePrompt e
+    return True
+  }
+
+minsPlayedC :: Controller
+minsPlayedC = Controller
+  { drawController = \s -> do
+    C.drawString $ header s
+    drawPrompt goalieMinsPlayedPrompt s
+  , handleController = \e -> do
+    promptHandler goalieMinsPlayedPrompt e
+    return True
+  }
+
+goalsAllowedC :: Controller
+goalsAllowedC = Controller
+  { drawController = \s -> do
+    C.drawString $ header s
+    drawPrompt goalsAllowedPrompt s
+  , handleController = \e -> do
+    promptHandler goalsAllowedPrompt e
+    return True
+  }
+
+header :: ProgState -> String
+header s = unlines
+  [ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***"
+  , fromMaybe "" $ do
+    n <- s^.progMode.gameStateL.gameSelectedGoalie
+    g <- nth n $ s^.database.dbGoalies
+    Just $ goalieSummary g
+  ]

src/Mtlstats/Menu.hs

@@ -71,7 +71,9 @@ mainMenu = Menu "*** MAIN MENU ***" True
     modify startNewGame >> return True
   , MenuItem '3' "Create Player" $
     modify createPlayer >> return True
-  , MenuItem '4' "Exit" $ do
+  , MenuItem '4' "Create Goalie" $
+    modify createGoalie >> return True
+  , MenuItem '5' "Exit" $ do
     db <- gets $ view database
     liftIO $ do
       dir <- getAppUserDataDirectory appName

src/Mtlstats/Prompt.hs

@@ -27,6 +27,7 @@ module Mtlstats.Prompt (
   promptHandler,
   strPrompt,
   numPrompt,
+  selectPrompt,
   -- * Individual prompts
   gameYearPrompt,
   gameDayPrompt,
@@ -37,16 +38,24 @@ module Mtlstats.Prompt (
   playerNamePrompt,
   playerPosPrompt,
   selectPlayerPrompt,
+  selectGoaliePrompt,
   recordGoalPrompt,
   recordAssistPrompt,
   pMinPlayerPrompt,
-  assignPMinsPrompt
+  assignPMinsPrompt,
+  goalieNumPrompt,
+  goalieNamePrompt,
+  selectGameGoaliePrompt,
+  goalieMinsPlayedPrompt,
+  goalsAllowedPrompt
 ) where
 
 import Control.Monad (when)
+import Control.Monad.Extra (whenJust)
 import Control.Monad.Trans.State (gets, modify)
 import Data.Char (isDigit, toUpper)
 import Data.Foldable (forM_)
+import Data.Maybe (fromMaybe)
 import Lens.Micro ((^.), (&), (.~), (?~), (%~))
 import Lens.Micro.Extras (view)
 import Text.Read (readMaybe)
@@ -108,6 +117,43 @@ numPrompt pStr act = Prompt
   , promptSpecialKey = const $ return ()
   }
 
+-- | Builds a selection prompt
+selectPrompt :: SelectParams a -> Prompt
+selectPrompt params = Prompt
+  { promptDrawer = \s -> do
+    let sStr = s^.inputBuffer
+    C.drawString $ spPrompt params ++ sStr
+    (row, col) <- C.cursorPosition
+    C.drawString $ "\n\n" ++ spSearchHeader params ++ "\n"
+    let results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
+    C.drawString $ unlines $ map
+      (\(n, (_, x)) -> let
+        desc = spElemDesc params x
+        in "F" ++ show n ++ ") " ++ desc)
+      results
+    C.moveCursor row col
+  , promptCharCheck = const True
+  , promptAction = \sStr -> if null sStr
+    then spCallback params Nothing
+    else do
+      db <- gets (^.database)
+      case spSearchExact params sStr db of
+        Nothing -> spNotFound params sStr
+        Just n  -> spCallback params $ Just n
+  , promptSpecialKey = \case
+    C.KeyFunction rawK -> do
+      sStr <- gets (^.inputBuffer)
+      db   <- gets (^.database)
+      let
+        n       = pred $ fromInteger rawK
+        results = spSearch params sStr db
+      when (n < maxFunKeys) $
+        whenJust (nth n results) $ \(n, _) -> do
+          modify $ inputBuffer .~ ""
+          spCallback params $ Just n
+    _ -> return ()
+  }
+
 -- | Prompts for the game year
 gameYearPrompt :: Prompt
 gameYearPrompt = numPrompt "Game year: " $
@@ -156,49 +202,52 @@ selectPlayerPrompt
   -- ^ The callback to run (takes the index number of the payer as
   -- input)
   -> Prompt
-selectPlayerPrompt pStr callback = Prompt
+selectPlayerPrompt pStr callback = selectPrompt SelectParams
-  { promptDrawer = \s -> do
+  { spPrompt       = pStr
-    let sStr = s^.inputBuffer
+  , spSearchHeader = "Player select:"
-    C.drawString pStr
+  , spSearch       = \sStr db -> playerSearch sStr (db^.dbPlayers)
-    C.drawString sStr
+  , spSearchExact  = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
-    (row, col) <- C.cursorPosition
+  , spElemDesc     = playerSummary
-    C.drawString "\n\nPlayer select:\n"
+  , spCallback     = callback
-    let sel = zip [1..maxFunKeys] $ playerSearch sStr $ s^.database.dbPlayers
+  , spNotFound     = \sStr -> do
-    mapM_
+    mode <- gets (^.progMode)
-      (\(n, (_, p)) -> C.drawString $
+    let
-        "F" ++ show n ++ ") " ++ p^.pName ++ " (" ++ show (p^.pNumber) ++ ")\n")
+      cps = newCreatePlayerState
-      sel
+        & cpsName .~ sStr
-    C.moveCursor row col
+        & cpsSuccessCallback .~ do
-  , promptCharCheck = const True
+          modify $ progMode .~ mode
-  , promptAction = \sStr -> if null sStr
+          index <- pred . length <$> gets (^.database.dbPlayers)
-    then callback Nothing
+          callback $ Just index
-    else do
+        & cpsFailureCallback .~ modify (progMode .~ mode)
-      players <- gets $ view $ database.dbPlayers
+    modify $ progMode .~ CreatePlayer cps
-      case playerSearchExact sStr players of
+  }
-        Just (n, _) -> callback $ Just n
+
-        Nothing -> do
+-- | Selects a goalie (creating one if necessary)
-          mode <- gets $ view progMode
+selectGoaliePrompt
-          let
+  :: String
-            cps = newCreatePlayerState
+  -- ^ The prompt string
-              & cpsName      .~ sStr
+  -> (Maybe Int -> Action ())
-              & cpsSuccessCallback .~ do
+  -- ^ The callback to run (takes the index number of the goalie as
-                modify $ progMode .~ mode
+  -- input)
-                pIndex <- pred . length <$> gets (view $ database.dbPlayers)
+  -> Prompt
-                callback $ Just pIndex
+selectGoaliePrompt pStr callback = selectPrompt SelectParams
-              & cpsFailureCallback .~ do
+  { spPrompt       = pStr
-                modify $ progMode .~ mode
+  , spSearchHeader = "Goalie select:"
-          modify $ progMode .~ CreatePlayer cps
+  , spSearch       = \sStr db -> goalieSearch sStr (db^.dbGoalies)
-  , promptSpecialKey = \case
+  , spSearchExact  = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
-    C.KeyFunction n -> do
+  , spElemDesc     = goalieSummary
-      sStr    <- gets $ view inputBuffer
+  , spCallback     = callback
-      players <- gets $ view $ database.dbPlayers
+  , spNotFound     = \sStr -> do
-      modify $ inputBuffer .~ ""
+    mode <- gets (^.progMode)
-      let
+    let
-        fKey    = pred $ fromIntegral n
+      cgs = newCreateGoalieState
-        options = playerSearch sStr players
+        & cgsName .~ sStr
-        sel     = fst <$> nth fKey options
+        & cgsSuccessCallback .~ do
-      callback sel
+          modify $ progMode .~ mode
-    _ -> return ()
+          index <- pred . length <$> gets (^.database.dbGoalies)
+          callback $ Just index
+        & cgsFailureCallback .~ modify (progMode .~ mode)
+    modify $ progMode .~ CreateGoalie cgs
   }
 
 -- | Prompts for the player who scored the goal
@@ -234,6 +283,7 @@ recordAssistPrompt game goal assist = selectPlayerPrompt
       when (nAssists >= maxAssists) $
         modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
 
+-- | Prompts for the player to assign penalty minutes to
 pMinPlayerPrompt :: Prompt
 pMinPlayerPrompt = selectPlayerPrompt
   "Assign penalty minutes to: " $
@@ -241,9 +291,41 @@ pMinPlayerPrompt = selectPlayerPrompt
     Nothing -> modify $ progMode.gameStateL.pMinsRecorded .~ True
     Just n  -> modify $ progMode.gameStateL.selectedPlayer ?~ n
 
+-- | Prompts for the number of penalty mintues to assign to the player
 assignPMinsPrompt :: Prompt
 assignPMinsPrompt = numPrompt "Penalty minutes: " $
   modify . assignPMins
 
+-- | Prompts tor the goalie's number
+goalieNumPrompt :: Prompt
+goalieNumPrompt = numPrompt "Goalie number: " $
+  modify . (progMode.createGoalieStateL.cgsNumber ?~)
+
+-- | Prompts for the goalie's name
+goalieNamePrompt :: Prompt
+goalieNamePrompt = strPrompt "Goalie name: " $
+  modify . (progMode.createGoalieStateL.cgsName .~)
+
+-- | Prompts for a goalie who played in the game
+selectGameGoaliePrompt :: Prompt
+selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $
+  \case
+    Nothing -> modify $ progMode.gameStateL.goaliesRecorded .~ True
+    Just n  -> modify $ progMode.gameStateL.gameSelectedGoalie  ?~ n
+
+-- | Prompts for the number of minutes the goalie has played
+goalieMinsPlayedPrompt :: Prompt
+goalieMinsPlayedPrompt = numPrompt "Minutes played: " $
+  modify . (progMode.gameStateL.goalieMinsPlayed ?~)
+
+-- | Prompts for the number of goals the goalie allowed
+goalsAllowedPrompt :: Prompt
+goalsAllowedPrompt = numPrompt "Goals allowed: " $ \n -> do
+  modify (progMode.gameStateL.goalsAllowed ?~ n)
+  mins <- fromMaybe 0 <$> gets (^.progMode.gameStateL.goalieMinsPlayed)
+  when (mins >= gameLength) $
+    modify $ progMode.gameStateL.goaliesRecorded .~ True
+  modify recordGoalieStats
+
 drawSimplePrompt :: String -> ProgState -> C.Update ()
 drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer

src/Mtlstats/Types.hs

@@ -30,6 +30,7 @@ module Mtlstats.Types (
   GameState (..),
   GameType (..),
   CreatePlayerState (..),
+  CreateGoalieState (..),
   Database (..),
   Player (..),
   PlayerStats (..),
@@ -37,6 +38,7 @@ module Mtlstats.Types (
   GoalieStats (..),
   GameStats (..),
   Prompt (..),
+  SelectParams (..),
   -- * Lenses
   -- ** ProgState Lenses
   database,
@@ -46,6 +48,7 @@ module Mtlstats.Types (
   -- ** ProgMode Lenses
   gameStateL,
   createPlayerStateL,
+  createGoalieStateL,
   -- ** GameState Lenses
   gameYear,
   gameMonth,
@@ -63,12 +66,22 @@ module Mtlstats.Types (
   confirmGoalDataFlag,
   selectedPlayer,
   pMinsRecorded,
+  gameGoalieStats,
+  gameSelectedGoalie,
+  goalieMinsPlayed,
+  goalsAllowed,
+  goaliesRecorded,
   -- ** CreatePlayerState Lenses
   cpsNumber,
   cpsName,
   cpsPosition,
   cpsSuccessCallback,
   cpsFailureCallback,
+  -- ** CreateGoalieState Lenses
+  cgsNumber,
+  cgsName,
+  cgsSuccessCallback,
+  cgsFailureCallback,
   -- ** Database Lenses
   dbPlayers,
   dbGoalies,
@@ -94,7 +107,6 @@ module Mtlstats.Types (
   gsGames,
   gsMinsPlayed,
   gsGoalsAllowed,
-  gsGoalsAgainst,
   gsWins,
   gsLosses,
   gsTies,
@@ -108,6 +120,7 @@ module Mtlstats.Types (
   newProgState,
   newGameState,
   newCreatePlayerState,
+  newCreateGoalieState,
   newDatabase,
   newPlayer,
   newPlayerStats,
@@ -136,7 +149,11 @@ module Mtlstats.Types (
   playerIsActive,
   -- ** PlayerStats Helpers
   psPoints,
-  addPlayerStats
+  addPlayerStats,
+  -- ** Goalie Helpers
+  goalieSearch,
+  goalieSearchExact,
+  goalieSummary
 ) where
 
 import Control.Monad.Trans.State (StateT)
@@ -190,12 +207,14 @@ data ProgMode
   | NewSeason
   | NewGame GameState
   | CreatePlayer CreatePlayerState
+  | CreateGoalie CreateGoalieState
 
 instance Show ProgMode where
   show MainMenu         = "MainMenu"
   show NewSeason        = "NewSeason"
   show (NewGame _)      = "NewGame"
   show (CreatePlayer _) = "CreatePlayer"
+  show (CreateGoalie _) = "CreateGoalie"
 
 -- | The game state
 data GameState = GameState
@@ -233,6 +252,18 @@ data GameState = GameState
   -- ^ Index number of the selected 'Player'
   , _pMinsRecorded       :: Bool
   -- ^ Set when the penalty mintes have been recorded
+  , _gameGoalieStats     :: M.Map Int GoalieStats
+  -- ^ The goalie stats accumulated over the game
+  , _gameSelectedGoalie  :: Maybe Int
+  -- ^ Index number of the selected 'Goalie'
+  , _goalieMinsPlayed    :: Maybe Int
+  -- ^ The number of minutes the currently selected goalie played in
+  -- the game
+  , _goalsAllowed        :: Maybe Int
+  -- ^ The number of goals the currently selected goalie allowed in
+  -- the game
+  , _goaliesRecorded     :: Bool
+  -- ^ Set when the user confirms that all goalie info has been entered
   } deriving (Eq, Show)
 
 -- | The type of game
@@ -255,6 +286,18 @@ data CreatePlayerState = CreatePlayerState
   -- ^ The function to call on failure
   }
 
+-- | Goalie creation status
+data CreateGoalieState = CreateGoalieState
+  { _cgsNumber    :: Maybe Int
+  -- ^ The goalie's number
+  , _cgsName      :: String
+  -- ^ The goalie's name
+  , _cgsSuccessCallback :: Action ()
+  -- ^ The function to call on success
+  , _cgsFailureCallback :: Action ()
+  -- ^ The function to call on failure
+  }
+
 -- | Represents the database
 data Database = Database
   { _dbPlayers       :: [Player]
@@ -396,8 +439,6 @@ data GoalieStats = GoalieStats
   -- ^ The number of minutes played
   , _gsGoalsAllowed :: Int
   -- ^ The number of goals allowed
-  , _gsGoalsAgainst :: Int
-  -- ^ The number of goals against
   , _gsWins         :: Int
   -- ^ The number of wins
   , _gsLosses       :: Int
@@ -411,28 +452,25 @@ instance FromJSON GoalieStats where
     <$> v .: "games"
     <*> v .: "mins_played"
     <*> v .: "goals_allowed"
-    <*> v .: "goals_against"
     <*> v .: "wins"
     <*> v .: "losses"
     <*> v .: "ties"
 
 instance ToJSON GoalieStats where
-  toJSON (GoalieStats g m al ag w l t) = object
+  toJSON (GoalieStats g m a w l t) = object
     [ "games"         .= g
     , "mins_played"   .= m
-    , "goals_allowed" .= al
+    , "goals_allowed" .= a
-    , "goals_against" .= ag
     , "wins"          .= w
     , "losses"        .= l
     , "ties"          .= t
     ]
-  toEncoding (GoalieStats g m al ag w l t) = pairs $
+  toEncoding (GoalieStats g m a w l t) = pairs $
-      "games"         .= g  <>
+      "games"         .= g <>
-      "mins_played"   .= m  <>
+      "mins_played"   .= m <>
-      "goals_allowed" .= al <>
+      "goals_allowed" .= a <>
-      "goals_against" .= ag <>
+      "wins"          .= w <>
-      "wins"          .= w  <>
+      "losses"        .= l <>
-      "losses"        .= l  <>
       "ties"          .= t
 
 -- | Game statistics
@@ -484,9 +522,28 @@ data Prompt = Prompt
   -- ^ Action to perform when a special key is pressed
   }
 
+-- | Parameters for a search prompt
+data SelectParams a = SelectParams
+  { spPrompt       :: String
+  -- ^ The search prompt
+  , spSearchHeader :: String
+  -- ^ The header to display at the top of the search list
+  , spSearch       :: String -> Database -> [(Int, a)]
+  -- ^ The search function
+  , spSearchExact  :: String -> Database -> Maybe Int
+  -- ^ Search function looking for an exact match
+  , spElemDesc     :: a -> String
+  -- ^ Provides a string description of an element
+  , spCallback     :: Maybe Int -> Action ()
+  -- ^ The function when the selection is made
+  , spNotFound     :: String -> Action ()
+  -- ^ The function to call when the selection doesn't exist
+  }
+
 makeLenses ''ProgState
 makeLenses ''GameState
 makeLenses ''CreatePlayerState
+makeLenses ''CreateGoalieState
 makeLenses ''Database
 makeLenses ''Player
 makeLenses ''PlayerStats
@@ -508,6 +565,13 @@ createPlayerStateL = lens
     _                -> newCreatePlayerState)
   (\_ cps -> CreatePlayer cps)
 
+createGoalieStateL :: Lens' ProgMode CreateGoalieState
+createGoalieStateL = lens
+  (\case
+    CreateGoalie cgs -> cgs
+    _                -> newCreateGoalieState)
+  (\_ cgs -> CreateGoalie cgs)
+
 -- | Constructor for a 'ProgState'
 newProgState :: ProgState
 newProgState = ProgState
@@ -536,6 +600,11 @@ newGameState = GameState
   , _confirmGoalDataFlag = False
   , _selectedPlayer      = Nothing
   , _pMinsRecorded       = False
+  , _gameGoalieStats     = M.empty
+  , _gameSelectedGoalie  = Nothing
+  , _goalieMinsPlayed    = Nothing
+  , _goalsAllowed        = Nothing
+  , _goaliesRecorded     = False
   }
 
 -- | Constructor for a 'CreatePlayerState'
@@ -548,6 +617,15 @@ newCreatePlayerState = CreatePlayerState
   , _cpsFailureCallback = return ()
   }
 
+-- | Constructor for a 'CreateGoalieState'
+newCreateGoalieState :: CreateGoalieState
+newCreateGoalieState = CreateGoalieState
+  { _cgsNumber          = Nothing
+  , _cgsName            = ""
+  , _cgsSuccessCallback = return ()
+  , _cgsFailureCallback = return ()
+  }
+
 -- | Constructor for a 'Database'
 newDatabase :: Database
 newDatabase = Database
@@ -603,7 +681,6 @@ newGoalieStats = GoalieStats
   { _gsGames        = 0
   , _gsMinsPlayed   = 0
   , _gsGoalsAllowed = 0
-  , _gsGoalsAgainst = 0
   , _gsWins         = 0
   , _gsLosses       = 0
   , _gsTies         = 0
@@ -757,3 +834,33 @@ addPlayerStats s1 s2 = newPlayerStats
   & psGoals   .~ s1^.psGoals + s2^.psGoals
   & psAssists .~ s1^.psAssists + s2^.psAssists
   & psPMin    .~ s1^.psPMin + s2^.psPMin
+
+-- | Searches a list of goalies
+goalieSearch
+  :: String
+  -- ^ The search string
+  -> [Goalie]
+  -- ^ The list to search
+  -> [(Int, Goalie)]
+  -- ^ The search results with their corresponding index numbers
+goalieSearch sStr = filter (\(_, goalie) -> sStr `isInfixOf` (goalie^.gName)) .
+  zip [0..]
+
+-- | Searches a list of goalies for an exact match
+goalieSearchExact
+  :: String
+  -- ^ The search string
+  -> [Goalie]
+  -- ^ The list to search
+  -> Maybe (Int, Goalie)
+  -- ^ The result with its index number
+goalieSearchExact sStr goalies = let
+  results = filter (\(_, goalie) -> sStr == goalie^.gName) $
+    zip [0..] goalies
+  in case results of
+    []       -> Nothing
+    result:_ -> Just result
+
+-- | Provides a description string for a 'Goalie'
+goalieSummary :: Goalie -> String
+goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")"

test/ActionsSpec.hs

@@ -43,6 +43,8 @@ import Mtlstats.Actions
 import Mtlstats.Types
 import Mtlstats.Util
 
+import qualified TypesSpec as TS
+
 spec :: Spec
 spec = describe "Mtlstats.Actions" $ do
   startNewSeasonSpec
@@ -54,12 +56,17 @@ spec = describe "Mtlstats.Actions" $ do
   updateGameStatsSpec
   validateGameDateSpec
   createPlayerSpec
+  createGoalieSpec
   addPlayerSpec
+  addGoalieSpec
+  resetCreatePlayerStateSpec
+  resetCreateGoalieStateSpec
   recordGoalAssistsSpec
   awardGoalSpec
   awardAssistSpec
   resetGoalDataSpec
   assignPMinsSpec
+  recordGoalieStatsSpec
   backHomeSpec
   scrollUpSpec
   scrollDownSpec
@@ -117,14 +124,12 @@ resetYtdSpec = describe "resetYtd" $
         ytd ^. gsGames        `shouldBe`    0
         ytd ^. gsMinsPlayed   `shouldBe`    0
         ytd ^. gsGoalsAllowed `shouldBe`    0
-        ytd ^. gsGoalsAgainst `shouldBe`    0
         ytd ^. gsWins         `shouldBe`    0
         ytd ^. gsLosses       `shouldBe`    0
         ytd ^. gsTies         `shouldBe`    0
         lt ^. gsGames         `shouldNotBe` 0
         lt ^. gsMinsPlayed    `shouldNotBe` 0
         lt ^. gsGoalsAllowed  `shouldNotBe` 0
-        lt ^. gsGoalsAgainst  `shouldNotBe` 0
         lt ^. gsWins          `shouldNotBe` 0
         lt ^. gsLosses        `shouldNotBe` 0
         lt ^. gsTies          `shouldNotBe` 0) $
@@ -355,6 +360,12 @@ createPlayerSpec = describe "createPlayer" $
     s = createPlayer newProgState
     in show (s^.progMode) `shouldBe` "CreatePlayer"
 
+createGoalieSpec :: Spec
+createGoalieSpec = describe "createGoalie" $
+  it "should change the mode appropriately" $ let
+    s = createGoalie newProgState
+    in show (s^.progMode) `shouldBe` "CreateGoalie"
+
 addPlayerSpec :: Spec
 addPlayerSpec = describe "addPlayer" $ do
   let
@@ -379,6 +390,48 @@ addPlayerSpec = describe "addPlayer" $ do
       s' = addPlayer $ s MainMenu
       in s'^.database.dbPlayers `shouldBe` [p1]
 
+addGoalieSpec :: Spec
+addGoalieSpec = describe "addGoalie" $ do
+  let
+    g1 = newGoalie 2 "Joe"
+    g2 = newGoalie 3 "Bob"
+    db = newDatabase
+      & dbGoalies .~ [g1]
+    s pm = newProgState
+      & database .~ db
+      & progMode .~ pm
+
+  context "data available" $
+    it "should create the goalie" $ let
+      s' = addGoalie $ s $ CreateGoalie $ newCreateGoalieState
+        & cgsNumber ?~ 3
+        & cgsName   .~ "Bob"
+      in s'^.database.dbGoalies `shouldBe` [g1, g2]
+
+  context "data unavailable" $
+    it "should not create the goalie" $ let
+      s' = addGoalie $ s MainMenu
+      in s'^.database.dbGoalies `shouldBe` [g1]
+
+resetCreatePlayerStateSpec :: Spec
+resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let
+  cps = newCreatePlayerState
+    & cpsNumber   ?~ 1
+    & cpsName     .~ "Joe"
+    & cpsPosition .~ "centre"
+  ps  = resetCreatePlayerState $
+    newProgState & progMode.createPlayerStateL .~ cps
+  in TS.compareTest (ps^.progMode.createPlayerStateL) newCreatePlayerState
+
+resetCreateGoalieStateSpec :: Spec
+resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
+  cgs = newCreateGoalieState
+    & cgsNumber ?~ 1
+    & cgsName   .~ "Joe"
+  ps = resetCreateGoalieState $
+    newProgState & progMode.createGoalieStateL .~ cgs
+  in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
+
 recordGoalAssistsSpec :: Spec
 recordGoalAssistsSpec = describe "recordGoalAssists" $ do
   let
@@ -618,6 +671,137 @@ assignPMinsSpec = describe "assignPMins" $ let
     , ( Nothing, 4,      3,       2,        6,      5,       0        )
     ]
 
+recordGoalieStatsSpec :: Spec
+recordGoalieStatsSpec = describe "recordGoalieStats" $ let
+  goalieStats mins goals = newGoalieStats
+    & gsMinsPlayed   .~ mins
+    & gsGoalsAllowed .~ goals
+
+  joe = newGoalie 2 "Joe"
+    & gYtd      .~ goalieStats 10 11
+    & gLifetime .~ goalieStats 12 13
+
+  bob = newGoalie 3 "Bob"
+    & gYtd      .~ goalieStats 14 15
+    & gLifetime .~ goalieStats 16 17
+
+  gameState n mins goals = newGameState
+    & gameGoalieStats    .~ M.fromList [(1, goalieStats 1 2)]
+    & gameSelectedGoalie .~ n
+    & goalieMinsPlayed   .~ mins
+    & goalsAllowed       .~ goals
+
+  progState n mins goals = newProgState
+    & database.dbGoalies  .~ [joe, bob]
+    & progMode.gameStateL .~ gameState n mins goals
+
+  in mapM_
+    (\(name, gid, mins, goals, joeData, bobData, reset) -> let
+      s = recordGoalieStats $ progState gid mins goals
+      in context name $ do
+
+        mapM_
+          (\(name, gid, (gMins, gGoals, ytdMins, ytdGoals, ltMins, ltGoals)) ->
+            context name $ do
+              let
+                gs     = s^.progMode.gameStateL.gameGoalieStats
+                game   = M.findWithDefault newGoalieStats gid gs
+                goalie = fromJust $ nth gid $ s^.database.dbGoalies
+                ytd    = goalie^.gYtd
+                lt     = goalie^.gLifetime
+
+              context "game minutes played" $
+                it ("should be " ++ show gMins) $
+                  game^.gsMinsPlayed `shouldBe` gMins
+
+              context "game goals allowed" $
+                it ("should be " ++ show gGoals) $
+                  game^.gsGoalsAllowed `shouldBe` gGoals
+
+              context "year-to-date minutes played" $
+                it ("should be " ++ show ytdMins) $
+                  ytd^.gsMinsPlayed `shouldBe` ytdMins
+
+              context "year-to-date goals allowed" $
+                it ("should be " ++ show ytdGoals) $
+                  ytd^.gsGoalsAllowed `shouldBe` ytdGoals
+
+              context "lifetime minutes played" $
+                it ("should be " ++ show ltMins) $
+                  lt^.gsMinsPlayed `shouldBe` ltMins
+
+              context "lifetime goals allowed" $
+                it ("should be " ++ show ltGoals) $
+                  lt^.gsGoalsAllowed `shouldBe` ltGoals)
+          [ ( "Joe", 0, joeData )
+          , ( "Bob", 1, bobData )
+          ]
+
+        context "selected goalie" $ let
+          expected = if reset then Nothing else gid
+          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.goalieMinsPlayed) `shouldBe` expected
+
+        context "goals allowed" $ let
+          expected = if reset then Nothing else goals
+          in it ("should be " ++ show expected) $
+            (s^.progMode.gameStateL.goalsAllowed) `shouldBe` expected)
+
+    [ ( "Joe"
+      , Just 0
+      , Just 1
+      , Just 2
+      , ( 1, 2, 11, 13, 13, 15 )
+      , ( 1, 2, 14, 15, 16, 17 )
+      , True
+      )
+    , ( "Bob"
+      , Just 1
+      , Just 1
+      , Just 2
+      , (0, 0, 10, 11, 12, 13 )
+      , (2, 4, 15, 17, 17, 19 )
+      , True
+      )
+    , ( "goalie out of bounds"
+      , Just 2
+      , Just 1
+      , Just 2
+      , (0, 0, 10, 11, 12, 13 )
+      , (1, 2, 14, 15, 16, 17 )
+      , False
+      )
+    , ( "missing goalie"
+      , Nothing
+      , Just 1
+      , Just 2
+      , (0, 0, 10, 11, 12, 13 )
+      , (1, 2, 14, 15, 16, 17 )
+      , False
+      )
+    , ( "missing minutes"
+      , Just 0
+      , Nothing
+      , Just 1
+      , (0, 0, 10, 11, 12, 13 )
+      , (1, 2, 14, 15, 16, 17 )
+      , False
+      )
+    , ( "missing goals"
+      , Just 0
+      , Just 1
+      , Nothing
+      , (0, 0, 10, 11, 12, 13 )
+      , (1, 2, 14, 15, 16, 17 )
+      , False
+      )
+    ]
+
 makePlayer :: IO Player
 makePlayer = Player
   <$> makeNum
@@ -647,7 +831,6 @@ makeGoalieStats = GoalieStats
   <*> makeNum
   <*> makeNum
   <*> makeNum
-  <*> makeNum
 
 makeNum :: IO Int
 makeNum = randomRIO (1, 10)

test/TypesSpec.hs

@@ -21,7 +21,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 {-# LANGUAGE OverloadedStrings, RankNTypes #-}
 
-module TypesSpec (spec) where
+module TypesSpec (Comparable (..), spec) where
 
 import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
 import Data.Aeson.Types (Value (Object))
@@ -35,6 +35,9 @@ 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
@@ -43,6 +46,7 @@ spec = describe "Mtlstats.Types" $ do
   databaseSpec
   gameStateLSpec
   createPlayerStateLSpec
+  createGoalieStateLSpec
   teamScoreSpec
   otherScoreSpec
   homeTeamSpec
@@ -61,6 +65,9 @@ spec = describe "Mtlstats.Types" $ do
   playerIsActiveSpec
   psPointsSpec
   addPlayerStatsSpec
+  goalieSearchSpec
+  goalieSearchExactSpec
+  goalieSummarySpec
   Menu.spec
 
 playerSpec :: Spec
@@ -79,43 +86,60 @@ databaseSpec = describe "Database" $ jsonSpec db dbJSON
 gameStateLSpec :: Spec
 gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
   -- getters
-  [ ( MainMenu,              newGameState )
+  [ ( "missing state", MainMenu,              newGameState )
-  , ( NewGame $ gs HomeGame, gs HomeGame  )
+  , ( "home game",     NewGame $ gs HomeGame, gs HomeGame  )
+  , ( "away game",     NewGame $ gs AwayGame, gs AwayGame  )
   ]
   -- setters
-  [ ( MainMenu,              gs HomeGame  )
+  [ ( "set home",     MainMenu,              gs HomeGame  )
-  , ( NewGame $ gs HomeGame, gs AwayGame  )
+  , ( "home to away", NewGame $ gs HomeGame, gs AwayGame  )
-  , ( NewGame $ gs HomeGame, newGameState )
+  , ( "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" $ do
+createPlayerStateLSpec = describe "createPlayerStateL" $
-  context "getters" $ do
+  lensSpec createPlayerStateL
-    context "state missing" $ let
+  -- getters
-      pm  = MainMenu
+  [ ( "missing state", MainMenu,          newCreatePlayerState )
-      cps = pm^.createPlayerStateL
+  , ( "with state",    CreatePlayer cps1, cps1                 )
-      in it "should not have a number" $
+  ]
-        cps^.cpsNumber `shouldBe` Nothing
+  -- 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"
 
-    context "existing state" $ let
+createGoalieStateLSpec :: Spec
-      pm  = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
+createGoalieStateLSpec = describe "createGoalieStateL" $
-      cps = pm^.createPlayerStateL
+  lensSpec createGoalieStateL
-      in it "should have a number of 1" $
+  -- getters
-        cps^.cpsNumber `shouldBe` Just 1
+  [ ( "missing state", MainMenu,          newCreateGoalieState )
-
+  , ( "with state",    CreateGoalie cgs1, cgs1                 )
-  context "setters" $ do
+  ]
-    context "state missing" $ let
+  -- setters
-      pm  = MainMenu
+  [ ( "set state",    MainMenu,          cgs1                 )
-      pm' = pm & createPlayerStateL.cpsNumber ?~ 1
+  , ( "change state", CreateGoalie cgs1, cgs2                 )
-      in it "should set the player number to 1" $
+  , ( "clear state",  CreateGoalie cgs1, newCreateGoalieState )
-        pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 1
+  ]
-
+  where
-    context "existing state" $ let
+    cgs1 = newCreateGoalieState
-      pm  = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
+      & cgsNumber    ?~ 1
-      pm' = pm & createPlayerStateL.cpsNumber ?~ 2
+      & cgsName      .~ "Joe"
-      in it "should set the player number to 2" $
+    cgs2 = newCreateGoalieState
-        pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 2
+      & cgsNumber ?~ 2
+      & cgsName   .~ "Bob"
 
 teamScoreSpec :: Spec
 teamScoreSpec = describe "teamScore" $ do
@@ -177,24 +201,23 @@ jsonSpec x j = do
       decode (encode x) `shouldBe` Just x
 
 lensSpec
-  :: (Eq a, Show s, Show a)
+  :: Comparable a
   => Lens' s a
-  -> [(s, a)]
+  -> [(String, s, a)]
-  -> [(s, a)]
+  -> [(String, s, a)]
   -> Spec
-lensSpec l gs ss = do
+lensSpec lens getters setters = do
 
   context "getters" $ mapM_
-    (\(s, x) -> context (show s) $
+    (\(label, s, x) -> context label $
-      it ("should be " ++ show x) $
+      compareTest (s^.lens) x)
-        s ^. l `shouldBe` x)
+    getters
-    gs
 
   context "setters" $ mapM_
-    (\(s, x) -> context (show s) $
+    (\(label, s, x) -> context label $ let
-      it ("should set to " ++ show x) $
+      s' = s & lens .~ x
-        (s & l .~ x) ^. l `shouldBe` x)
+      in compareTest (s'^.lens) x)
-    ss
+    setters
 
 player :: Player
 player = newPlayer 1 "Joe" "centre"
@@ -241,20 +264,18 @@ goalieStats n = newGoalieStats
   & gsGames        .~ n
   & gsMinsPlayed   .~ n + 1
   & gsGoalsAllowed .~ n + 2
-  & gsGoalsAgainst .~ n + 3
+  & gsWins         .~ n + 3
-  & gsWins         .~ n + 4
+  & gsLosses       .~ n + 4
-  & gsLosses       .~ n + 5
+  & gsTies         .~ 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 )
-  , ( "goals_against", toJSON $ n + 3 )
+  , ( "wins",          toJSON $ n + 3 )
-  , ( "wins",          toJSON $ n + 4 )
+  , ( "losses",        toJSON $ n + 4 )
-  , ( "losses",        toJSON $ n + 5 )
+  , ( "ties",          toJSON $ n + 5 )
-  , ( "ties",          toJSON $ n + 6 )
   ]
 
 gameStats :: Int -> GameStats
@@ -633,6 +654,57 @@ addPlayerStatsSpec = describe "addPlayerStats" $ do
     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 Steve" $
+      goalieSearch "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)"
+
 joe :: Player
 joe = newPlayer 2 "Joe" "center"
 
@@ -641,3 +713,34 @@ bob = newPlayer 3 "Bob" "defense"
 
 steve :: Player
 steve = newPlayer 5 "Steve" "forward"
+
+instance Comparable GameState where
+  compareTest actual expected =
+    it ("should be " ++ show expected) $
+      actual `shouldBe` expected
+
+instance Comparable CreatePlayerState where
+  compareTest actual expected = do
+
+    describe "cpsNumber" $
+      it ("should be " ++ show (expected^.cpsNumber)) $
+        actual^.cpsNumber `shouldBe` expected^.cpsNumber
+
+    describe "cpsName" $
+      it ("should be " ++ expected^.cpsName) $
+        actual^.cpsName `shouldBe` expected^.cpsName
+
+    describe "cpsPosition" $
+      it ("should be " ++ expected^.cpsPosition) $
+        actual^.cpsPosition `shouldBe` expected^.cpsPosition
+
+instance Comparable 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