diff --git a/ChangeLog.md b/ChangeLog.md index 727fd55..0caf699 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -4,6 +4,7 @@ - Fixed player creation bug - Prompt for goalie informaiton on game data entry +- Implemented player editing ## v0.4.0 diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index e75caa0..f24461a 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -32,6 +32,7 @@ module Mtlstats.Actions , validateGameDate , createPlayer , createGoalie + , editPlayer , addPlayer , addGoalie , resetCreatePlayerState @@ -159,6 +160,10 @@ createGoalie = let & cgsFailureCallback .~ callback in progMode .~ CreateGoalie cgs +-- | Starts the player editing process +editPlayer :: ProgState -> ProgState +editPlayer = progMode .~ EditPlayer newEditPlayerState + -- | Adds the entered player to the roster addPlayer :: ProgState -> ProgState addPlayer s = fromMaybe s $ do diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 688f788..40e42f5 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.EditPlayer import Mtlstats.Control.GoalieInput import Mtlstats.Format import Mtlstats.Handlers @@ -70,6 +71,7 @@ dispatch s = case s^.progMode of | null $ cgs^.cgsNumber -> getGoalieNumC | null $ cgs^.cgsName -> getGoalieNameC | otherwise -> confirmCreateGoalieC + EditPlayer eps -> editPlayerC eps mainMenuC :: Controller mainMenuC = Controller diff --git a/src/Mtlstats/Control/EditPlayer.hs b/src/Mtlstats/Control/EditPlayer.hs new file mode 100644 index 0000000..8c7b65d --- /dev/null +++ b/src/Mtlstats/Control/EditPlayer.hs @@ -0,0 +1,143 @@ +{- | + +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.EditPlayer (editPlayerC) where + +import Data.Maybe (fromMaybe) +import Lens.Micro ((^.)) +import qualified UI.NCurses as C + +import Mtlstats.Menu +import Mtlstats.Prompt +import Mtlstats.Prompt.EditPlayer +import Mtlstats.Types +import Mtlstats.Util + +-- | Dispatcher/controller for the player edit mode +editPlayerC :: EditPlayerState -> Controller +editPlayerC eps + | null $ eps^.epsSelectedPlayer = selectPlayerC + | otherwise = case eps^.epsMode of + EPMenu -> menuC + EPNumber -> numberC + EPName -> nameC + EPPosition -> positionC + EPYtdGoals -> ytdGoalsC + EPYtdAssists -> ytdAssistsC + EPYtdPMin -> ytdPMinC + EPLtGoals -> ltGoalsC + EPLtAssists -> ltAssistsC + EPLtPMin -> ltPMinC + +selectPlayerC :: Controller +selectPlayerC = Controller + { drawController = drawPrompt playerToEditPrompt + , handleController = \e -> do + promptHandler playerToEditPrompt e + return True + } + +menuC :: Controller +menuC = Controller + { drawController = \s -> do + let + header = fromMaybe "" $ do + pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer + p <- nth pid $ s^.database.dbPlayers + Just $ playerDetails p ++ "\n" + C.drawString header + drawMenu editPlayerMenu + , handleController = \e -> do + menuHandler editPlayerMenu e + return True + } + +numberC :: Controller +numberC = Controller + { drawController = drawPrompt editPlayerNumPrompt + , handleController = \e -> do + promptHandler editPlayerNumPrompt e + return True + } + +nameC :: Controller +nameC = Controller + { drawController = drawPrompt editPlayerNamePrompt + , handleController = \e -> do + promptHandler editPlayerNamePrompt e + return True + } + +positionC :: Controller +positionC = Controller + { drawController = drawPrompt editPlayerPosPrompt + , handleController = \e -> do + promptHandler editPlayerPosPrompt e + return True + } + +ytdGoalsC :: Controller +ytdGoalsC = Controller + { drawController = drawPrompt editPlayerYtdGoalsPrompt + , handleController = \e -> do + promptHandler editPlayerYtdGoalsPrompt e + return True + } + +ytdAssistsC :: Controller +ytdAssistsC = Controller + { drawController = drawPrompt editPlayerYtdAssistsPrompt + , handleController = \e -> do + promptHandler editPlayerYtdAssistsPrompt e + return True + } + +ytdPMinC :: Controller +ytdPMinC = Controller + { drawController = drawPrompt editPlayerYtdPMinPrompt + , handleController = \e -> do + promptHandler editPlayerYtdPMinPrompt e + return True + } + +ltGoalsC :: Controller +ltGoalsC = Controller + { drawController = drawPrompt editPlayerLtGoalsPrompt + , handleController = \e -> do + promptHandler editPlayerLtGoalsPrompt e + return True + } + +ltAssistsC :: Controller +ltAssistsC = Controller + { drawController = drawPrompt editPlayerLtAssistsPrompt + , handleController = \e -> do + promptHandler editPlayerLtAssistsPrompt e + return True + } + +ltPMinC :: Controller +ltPMinC = Controller + { drawController = drawPrompt editPlayerLtPMinPrompt + , handleController = \e -> do + promptHandler editPlayerLtPMinPrompt e + return True + } diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index d1521f7..b365078 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -27,7 +27,8 @@ module Mtlstats.Menu ( mainMenu, newSeasonMenu, gameMonthMenu, - gameTypeMenu + gameTypeMenu, + editPlayerMenu ) where import Control.Monad.IO.Class (liftIO) @@ -73,7 +74,9 @@ mainMenu = Menu "*** MAIN MENU ***" True modify createPlayer >> return True , MenuItem '4' "Create Goalie" $ modify createGoalie >> return True - , MenuItem '5' "Exit" $ do + , MenuItem '5' "Edit Player" $ + modify editPlayer >> return True + , MenuItem '6' "Exit" $ do db <- gets $ view database liftIO $ do dir <- getAppUserDataDirectory appName @@ -121,3 +124,21 @@ gameTypeMenu = Menu "Game type:" () , MenuItem '2' "Away Game" $ modify $ progMode.gameStateL.gameType ?~ AwayGame ] + +-- | The player edit menu +editPlayerMenu :: Menu () +editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map + (\(ch, label, mode) -> MenuItem ch label $ case mode of + Nothing -> modify $ progMode .~ MainMenu + Just m -> modify $ progMode.editPlayerStateL.epsMode .~ m) + [ ( '1', "Change number", Just EPNumber ) + , ( '2', "Change name", Just EPName ) + , ( '3', "Change position", Just EPPosition ) + , ( '4', "YTD goals", Just EPYtdGoals ) + , ( '5', "YTD assists", Just EPYtdAssists ) + , ( '6', "YTD penalty mins", Just EPYtdPMin ) + , ( '7', "Lifetime goals", Just EPLtGoals ) + , ( '8', "Lifetime assists", Just EPLtAssists ) + , ( '9', "Lifetime penalty mins", Just EPLtPMin ) + , ( '0', "Finished editing", Nothing ) + ] diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index 24ca51e..97aab82 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -47,7 +47,8 @@ module Mtlstats.Prompt ( goalieNamePrompt, selectGameGoaliePrompt, goalieMinsPlayedPrompt, - goalsAllowedPrompt + goalsAllowedPrompt, + playerToEditPrompt ) where import Control.Monad (when) @@ -327,5 +328,9 @@ goalsAllowedPrompt = numPrompt "Goals allowed: " $ \n -> do modify $ progMode.gameStateL.goaliesRecorded .~ True modify recordGoalieStats +playerToEditPrompt :: Prompt +playerToEditPrompt = selectPlayerPrompt "Player to edit: " $ + modify . (progMode.editPlayerStateL.epsSelectedPlayer .~) + drawSimplePrompt :: String -> ProgState -> C.Update () drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer diff --git a/src/Mtlstats/Prompt/EditPlayer.hs b/src/Mtlstats/Prompt/EditPlayer.hs new file mode 100644 index 0000000..dc6bb7e --- /dev/null +++ b/src/Mtlstats/Prompt/EditPlayer.hs @@ -0,0 +1,92 @@ +{- | + +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.Prompt.EditPlayer + ( editPlayerNumPrompt + , editPlayerNamePrompt + , editPlayerPosPrompt + , editPlayerYtdGoalsPrompt + , editPlayerYtdAssistsPrompt + , editPlayerYtdPMinPrompt + , editPlayerLtGoalsPrompt + , editPlayerLtAssistsPrompt + , editPlayerLtPMinPrompt + ) where + +import Control.Monad.Extra (whenJustM) +import Control.Monad.Trans.State (gets, modify) +import Lens.Micro ((^.), (.~), (%~)) + +import Mtlstats.Prompt +import Mtlstats.Types +import Mtlstats.Util + +-- | Prompt to edit a player's number +editPlayerNumPrompt :: Prompt +editPlayerNumPrompt = numPrompt "Player number: " $ + editPlayer . (pNumber .~) + +-- | Prompt to edit a player's name +editPlayerNamePrompt :: Prompt +editPlayerNamePrompt = strPrompt "Player name: " $ + editPlayer . (pName .~) + +-- | Prompt to edit a player's position +editPlayerPosPrompt :: Prompt +editPlayerPosPrompt = strPrompt "Player position: " $ + editPlayer . (pPosition .~) + +-- | Prompt to edit a player's year-to-date goals +editPlayerYtdGoalsPrompt :: Prompt +editPlayerYtdGoalsPrompt = numPrompt "Year-to-date goals: " $ + editPlayer . (pYtd.psGoals .~) + +-- | Prompt to edit a player's year-to-date assists +editPlayerYtdAssistsPrompt :: Prompt +editPlayerYtdAssistsPrompt = numPrompt "Year-to-date assists: " $ + editPlayer . (pYtd.psAssists .~) + +-- | Prompt to edit a player's year-to-date penalty minutes +editPlayerYtdPMinPrompt :: Prompt +editPlayerYtdPMinPrompt = numPrompt "Year-to-date penalty minutes: " $ + editPlayer . (pYtd.psPMin .~) + +-- | Prompt to edit a player's lifetime goals +editPlayerLtGoalsPrompt :: Prompt +editPlayerLtGoalsPrompt = numPrompt "Lifetime goals: " $ + editPlayer . (pLifetime.psGoals .~) + +-- | Prompt to edit a player's lifetime assists +editPlayerLtAssistsPrompt :: Prompt +editPlayerLtAssistsPrompt = numPrompt "Lifetime assists: " $ + editPlayer . (pLifetime.psAssists .~) + +-- | Prompt to edit a player's lifetime penalty minutes +editPlayerLtPMinPrompt :: Prompt +editPlayerLtPMinPrompt = numPrompt "Lifetime penalty minutes: " $ + editPlayer . (pLifetime.psPMin .~) + +editPlayer :: (Player -> Player) -> Action () +editPlayer f = + whenJustM (gets (^.progMode.editPlayerStateL.epsSelectedPlayer)) $ \pid -> + modify + $ (database.dbPlayers %~ modifyNth pid f) + . (progMode.editPlayerStateL.epsMode .~ EPMenu) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 994753b..1bd6708 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -31,6 +31,8 @@ module Mtlstats.Types ( GameType (..), CreatePlayerState (..), CreateGoalieState (..), + EditPlayerState (..), + EditPlayerMode (..), Database (..), Player (..), PlayerStats (..), @@ -49,6 +51,7 @@ module Mtlstats.Types ( gameStateL, createPlayerStateL, createGoalieStateL, + editPlayerStateL, -- ** GameState Lenses gameYear, gameMonth, @@ -82,6 +85,9 @@ module Mtlstats.Types ( cgsName, cgsSuccessCallback, cgsFailureCallback, + -- ** EditPlayerState Lenses + epsSelectedPlayer, + epsMode, -- ** Database Lenses dbPlayers, dbGoalies, @@ -121,6 +127,7 @@ module Mtlstats.Types ( newGameState, newCreatePlayerState, newCreateGoalieState, + newEditPlayerState, newDatabase, newPlayer, newPlayerStats, @@ -146,6 +153,7 @@ module Mtlstats.Types ( playerSearchExact, modifyPlayer, playerSummary, + playerDetails, playerIsActive, -- ** PlayerStats Helpers psPoints, @@ -208,6 +216,7 @@ data ProgMode | NewGame GameState | CreatePlayer CreatePlayerState | CreateGoalie CreateGoalieState + | EditPlayer EditPlayerState instance Show ProgMode where show MainMenu = "MainMenu" @@ -215,6 +224,7 @@ instance Show ProgMode where show (NewGame _) = "NewGame" show (CreatePlayer _) = "CreatePlayer" show (CreateGoalie _) = "CreateGoalie" + show (EditPlayer _) = "EditPlayer" -- | The game state data GameState = GameState @@ -298,6 +308,28 @@ data CreateGoalieState = CreateGoalieState -- ^ The function to call on failure } +-- | Player edit status +data EditPlayerState = EditPlayerState + { _epsSelectedPlayer :: Maybe Int + -- ^ The index number of the player being edited + , _epsMode :: EditPlayerMode + -- ^ The editing mode + } + +-- | Player editing mode +data EditPlayerMode + = EPMenu + | EPNumber + | EPName + | EPPosition + | EPYtdGoals + | EPYtdAssists + | EPYtdPMin + | EPLtGoals + | EPLtAssists + | EPLtPMin + deriving (Eq, Show) + -- | Represents the database data Database = Database { _dbPlayers :: [Player] @@ -544,6 +576,7 @@ makeLenses ''ProgState makeLenses ''GameState makeLenses ''CreatePlayerState makeLenses ''CreateGoalieState +makeLenses ''EditPlayerState makeLenses ''Database makeLenses ''Player makeLenses ''PlayerStats @@ -572,6 +605,13 @@ createGoalieStateL = lens _ -> newCreateGoalieState) (\_ cgs -> CreateGoalie cgs) +editPlayerStateL :: Lens' ProgMode EditPlayerState +editPlayerStateL = lens + (\case + EditPlayer eps -> eps + _ -> newEditPlayerState) + (\_ eps -> EditPlayer eps) + -- | Constructor for a 'ProgState' newProgState :: ProgState newProgState = ProgState @@ -626,6 +666,13 @@ newCreateGoalieState = CreateGoalieState , _cgsFailureCallback = return () } +-- | Constructor for an 'EditPlayerState' +newEditPlayerState :: EditPlayerState +newEditPlayerState = EditPlayerState + { _epsSelectedPlayer = Nothing + , _epsMode = EPMenu + } + -- | Constructor for a 'Database' newDatabase :: Database newDatabase = Database @@ -814,6 +861,20 @@ playerSummary :: Player -> String playerSummary p = p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition +-- | Provides a detailed string describing a 'Player' +playerDetails :: Player -> String +playerDetails p = unlines + [ " Number: " ++ show (p^.pNumber) + , " Name: " ++ p^.pName + , " Position: " ++ p^.pPosition + , " YTD goals: " ++ show (p^.pYtd.psGoals) + , " YTD assists: " ++ show (p^.pYtd.psAssists) + , " YTD penalty mins: " ++ show (p^.pYtd.psPMin) + , " Lifetime goals: " ++ show (p^.pLifetime.psGoals) + , " Lifetime assists: " ++ show (p^.pLifetime.psAssists) + , "Lifetime penalty mins: " ++ show (p^.pLifetime.psPMin) + ] + -- | Determines whether or not a player has been active in the current -- season/year playerIsActive :: Player -> Bool diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 11adbf1..16ec6a4 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -57,6 +57,7 @@ spec = describe "Mtlstats.Actions" $ do validateGameDateSpec createPlayerSpec createGoalieSpec + editPlayerSpec addPlayerSpec addGoalieSpec resetCreatePlayerStateSpec @@ -366,6 +367,12 @@ createGoalieSpec = describe "createGoalie" $ s = createGoalie newProgState in show (s^.progMode) `shouldBe` "CreateGoalie" +editPlayerSpec :: Spec +editPlayerSpec = describe "editPlayer" $ + it "should change the mode appropriately" $ let + s = editPlayer newProgState + in show (s^.progMode) `shouldBe` "EditPlayer" + addPlayerSpec :: Spec addPlayerSpec = describe "addPlayer" $ do let diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index 27ea3f6..9a1d349 100644 --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -47,6 +47,7 @@ spec = describe "Mtlstats.Types" $ do gameStateLSpec createPlayerStateLSpec createGoalieStateLSpec + editPlayerStateLSpec teamScoreSpec otherScoreSpec homeTeamSpec @@ -62,6 +63,7 @@ spec = describe "Mtlstats.Types" $ do playerSearchExactSpec modifyPlayerSpec playerSummarySpec + playerDetailsSpec playerIsActiveSpec psPointsSpec addPlayerStatsSpec @@ -141,6 +143,24 @@ createGoalieStateLSpec = describe "createGoalieStateL" $ & cgsNumber ?~ 2 & cgsName .~ "Bob" +editPlayerStateLSpec :: Spec +editPlayerStateLSpec = describe "editPlayerStateL" $ + lensSpec editPlayerStateL + -- getters + [ ( "missing state", MainMenu, newEditPlayerState ) + , ( "withState", EditPlayer eps1, eps1 ) + ] + -- setters + [ ( "set state", MainMenu, eps1 ) + , ( "change state", EditPlayer eps1, eps2 ) + , ( "clear state", EditPlayer eps1, newEditPlayerState ) + ] + where + eps1 = newEditPlayerState + & epsSelectedPlayer ?~ 1 + eps2 = newEditPlayerState + & epsSelectedPlayer ?~ 2 + teamScoreSpec :: Spec teamScoreSpec = describe "teamScore" $ do let @@ -589,6 +609,36 @@ playerSummarySpec = describe "playerSummary" $ it "should be \"Joe (2) center\"" $ playerSummary joe `shouldBe` "Joe (2) center" +playerDetailsSpec :: Spec +playerDetailsSpec = describe "playerDetails" $ + it "should give a detailed description" $ let + + player = newPlayer 1 "Joe" "centre" + & pYtd .~ PlayerStats + { _psGoals = 2 + , _psAssists = 3 + , _psPMin = 4 + } + & pLifetime .~ PlayerStats + { _psGoals = 5 + , _psAssists = 6 + , _psPMin = 7 + } + + expected = unlines + [ " Number: 1" + , " Name: Joe" + , " Position: centre" + , " YTD goals: 2" + , " YTD assists: 3" + , " YTD penalty mins: 4" + , " Lifetime goals: 5" + , " Lifetime assists: 6" + , "Lifetime penalty mins: 7" + ] + + in playerDetails player `shouldBe` expected + playerIsActiveSpec :: Spec playerIsActiveSpec = describe "playerIsActive" $ do let @@ -734,6 +784,17 @@ instance Comparable CreatePlayerState where it ("should be " ++ expected^.cpsPosition) $ actual^.cpsPosition `shouldBe` expected^.cpsPosition +instance Comparable EditPlayerState where + compareTest actual expected = do + + describe "epsSelectedPlayer" $ + it ("should be " ++ show (expected^.epsSelectedPlayer)) $ + actual^.epsSelectedPlayer `shouldBe` expected^.epsSelectedPlayer + + describe "epsMode" $ + it ("should be " ++ show (expected^.epsMode)) $ + actual^.epsMode `shouldBe` expected^.epsMode + instance Comparable CreateGoalieState where compareTest actual expected = do