diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 7a9b686..e75caa0 100644 --- a/src/Mtlstats/Actions.hs +++ b/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 - cps - = newCreatePlayerState - & cpsSuccessCallback .~ cb - & cpsFailureCallback .~ cb + callback = modify $ progMode .~ MainMenu + cps = newCreatePlayerState + & cpsSuccessCallback .~ callback + & cpsFailureCallback .~ callback 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 diff --git a/src/Mtlstats/Config.hs b/src/Mtlstats/Config.hs index 9a5137f..eb6637a 100644 --- a/src/Mtlstats/Config.hs +++ b/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 diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 3f7fba2..688f788 100644 --- a/src/Mtlstats/Control.hs +++ b/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 diff --git a/src/Mtlstats/Control/GoalieInput.hs b/src/Mtlstats/Control/GoalieInput.hs new file mode 100644 index 0000000..3b5fed3 --- /dev/null +++ b/src/Mtlstats/Control/GoalieInput.hs @@ -0,0 +1,75 @@ +{- | + +mtlstats +Copyright (C) 2019 Rhéal Lamothe + + +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 . + +-} + +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 + ] diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index d3a6f62..d1521f7 100644 --- a/src/Mtlstats/Menu.hs +++ b/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 diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index 16570ae..24ca51e 100644 --- a/src/Mtlstats/Prompt.hs +++ b/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 - { promptDrawer = \s -> do - let sStr = s^.inputBuffer - C.drawString pStr - C.drawString sStr - (row, col) <- C.cursorPosition - C.drawString "\n\nPlayer select:\n" - let sel = zip [1..maxFunKeys] $ playerSearch sStr $ s^.database.dbPlayers - mapM_ - (\(n, (_, p)) -> C.drawString $ - "F" ++ show n ++ ") " ++ p^.pName ++ " (" ++ show (p^.pNumber) ++ ")\n") - sel - C.moveCursor row col - , promptCharCheck = const True - , promptAction = \sStr -> if null sStr - then callback Nothing - else do - players <- gets $ view $ database.dbPlayers - case playerSearchExact sStr players of - Just (n, _) -> callback $ Just n - Nothing -> do - mode <- gets $ view progMode - let - cps = newCreatePlayerState - & cpsName .~ sStr - & cpsSuccessCallback .~ do - modify $ progMode .~ mode - pIndex <- pred . length <$> gets (view $ database.dbPlayers) - callback $ Just pIndex - & cpsFailureCallback .~ do - modify $ progMode .~ mode - modify $ progMode .~ CreatePlayer cps - , promptSpecialKey = \case - C.KeyFunction n -> do - sStr <- gets $ view inputBuffer - players <- gets $ view $ database.dbPlayers - modify $ inputBuffer .~ "" - let - fKey = pred $ fromIntegral n - options = playerSearch sStr players - sel = fst <$> nth fKey options - callback sel - _ -> return () +selectPlayerPrompt pStr callback = selectPrompt SelectParams + { spPrompt = pStr + , spSearchHeader = "Player select:" + , spSearch = \sStr db -> playerSearch sStr (db^.dbPlayers) + , spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers) + , spElemDesc = playerSummary + , spCallback = callback + , spNotFound = \sStr -> do + mode <- gets (^.progMode) + let + cps = newCreatePlayerState + & cpsName .~ sStr + & cpsSuccessCallback .~ do + modify $ progMode .~ mode + index <- pred . length <$> gets (^.database.dbPlayers) + callback $ Just index + & cpsFailureCallback .~ modify (progMode .~ mode) + modify $ progMode .~ CreatePlayer cps + } + +-- | Selects a goalie (creating one if necessary) +selectGoaliePrompt + :: String + -- ^ The prompt string + -> (Maybe Int -> Action ()) + -- ^ The callback to run (takes the index number of the goalie as + -- input) + -> Prompt +selectGoaliePrompt pStr callback = selectPrompt SelectParams + { spPrompt = pStr + , spSearchHeader = "Goalie select:" + , spSearch = \sStr db -> goalieSearch sStr (db^.dbGoalies) + , spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies) + , spElemDesc = goalieSummary + , spCallback = callback + , spNotFound = \sStr -> do + mode <- gets (^.progMode) + let + cgs = newCreateGoalieState + & cgsName .~ sStr + & cgsSuccessCallback .~ do + modify $ progMode .~ mode + 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 diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 14bbfde..994753b 100644 --- a/src/Mtlstats/Types.hs +++ b/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_against" .= ag + , "goals_allowed" .= a , "wins" .= w , "losses" .= l , "ties" .= t ] - toEncoding (GoalieStats g m al ag w l t) = pairs $ - "games" .= g <> - "mins_played" .= m <> - "goals_allowed" .= al <> - "goals_against" .= ag <> - "wins" .= w <> - "losses" .= l <> + toEncoding (GoalieStats g m a w l t) = pairs $ + "games" .= g <> + "mins_played" .= m <> + "goals_allowed" .= a <> + "wins" .= w <> + "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) ++ ")" diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index b45da09..11adbf1 100644 --- a/test/ActionsSpec.hs +++ b/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) diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index b8bd0bb..27ea3f6 100644 --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -21,7 +21,7 @@ along with this program. If not, see . {-# 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 ) - , ( NewGame $ gs HomeGame, gs HomeGame ) + [ ( "missing state", MainMenu, newGameState ) + , ( "home game", NewGame $ gs HomeGame, gs HomeGame ) + , ( "away game", NewGame $ gs AwayGame, gs AwayGame ) ] -- setters - [ ( MainMenu, gs HomeGame ) - , ( NewGame $ gs HomeGame, gs AwayGame ) - , ( NewGame $ gs HomeGame, newGameState ) + [ ( "set home", MainMenu, gs HomeGame ) + , ( "home to away", NewGame $ gs HomeGame, gs AwayGame ) + , ( "away to home", NewGame $ gs AwayGame, gs HomeGame ) + , ( "clear home", NewGame $ gs HomeGame, newGameState ) + , ( "clear away", NewGame $ gs AwayGame, newGameState ) ] where gs t = newGameState & gameType ?~ t createPlayerStateLSpec :: Spec -createPlayerStateLSpec = describe "createPlayerStateL" $ do - context "getters" $ do - context "state missing" $ let - pm = MainMenu - cps = pm^.createPlayerStateL - in it "should not have a number" $ - cps^.cpsNumber `shouldBe` Nothing +createPlayerStateLSpec = describe "createPlayerStateL" $ + lensSpec createPlayerStateL + -- getters + [ ( "missing state", MainMenu, newCreatePlayerState ) + , ( "with state", CreatePlayer cps1, cps1 ) + ] + -- setters + [ ( "missing state", MainMenu, cps1 ) + , ( "change state", CreatePlayer cps1, cps2 ) + , ( "clear state", CreatePlayer cps1, newCreatePlayerState ) + ] + where + cps1 = newCreatePlayerState + & cpsNumber ?~ 1 + & cpsName .~ "Joe" + & cpsPosition .~ "centre" + cps2 = newCreatePlayerState + & cpsNumber ?~ 2 + & cpsName .~ "Bob" + & cpsPosition .~ "defense" - context "existing state" $ let - pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1 - cps = pm^.createPlayerStateL - in it "should have a number of 1" $ - cps^.cpsNumber `shouldBe` Just 1 - - context "setters" $ do - context "state missing" $ let - pm = MainMenu - pm' = pm & createPlayerStateL.cpsNumber ?~ 1 - in it "should set the player number to 1" $ - pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 1 - - context "existing state" $ let - pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1 - pm' = pm & createPlayerStateL.cpsNumber ?~ 2 - in it "should set the player number to 2" $ - pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 2 +createGoalieStateLSpec :: Spec +createGoalieStateLSpec = describe "createGoalieStateL" $ + lensSpec createGoalieStateL + -- getters + [ ( "missing state", MainMenu, newCreateGoalieState ) + , ( "with state", CreateGoalie cgs1, cgs1 ) + ] + -- setters + [ ( "set state", MainMenu, cgs1 ) + , ( "change state", CreateGoalie cgs1, cgs2 ) + , ( "clear state", CreateGoalie cgs1, newCreateGoalieState ) + ] + where + cgs1 = newCreateGoalieState + & cgsNumber ?~ 1 + & cgsName .~ "Joe" + cgs2 = newCreateGoalieState + & cgsNumber ?~ 2 + & cgsName .~ "Bob" 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)] - -> [(s, a)] + -> [(String, s, a)] + -> [(String, s, a)] -> Spec -lensSpec l gs ss = do +lensSpec lens getters setters = do context "getters" $ mapM_ - (\(s, x) -> context (show s) $ - it ("should be " ++ show x) $ - s ^. l `shouldBe` x) - gs + (\(label, s, x) -> context label $ + compareTest (s^.lens) x) + getters context "setters" $ mapM_ - (\(s, x) -> context (show s) $ - it ("should set to " ++ show x) $ - (s & l .~ x) ^. l `shouldBe` x) - ss + (\(label, s, x) -> context label $ let + s' = s & lens .~ x + in compareTest (s'^.lens) x) + 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 + 4 - & gsLosses .~ n + 5 - & gsTies .~ n + 6 + & gsWins .~ n + 3 + & gsLosses .~ n + 4 + & gsTies .~ n + 5 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 + 4 ) - , ( "losses", toJSON $ n + 5 ) - , ( "ties", toJSON $ n + 6 ) + , ( "wins", toJSON $ n + 3 ) + , ( "losses", toJSON $ n + 4 ) + , ( "ties", toJSON $ n + 5 ) ] 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