From be5d10b6fdd4f1251d778e09523deb1ff0016953 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Sat, 7 Sep 2019 11:33:03 -0400 Subject: [PATCH 1/8] moved ProgMode --- src/Mtlstats/Types.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 9bda181..cf29ee4 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -26,8 +26,8 @@ module Mtlstats.Types ( Controller (..), Action, ProgState (..), - GameState (..), ProgMode (..), + GameState (..), GameType (..), Database (..), Player (..), @@ -152,6 +152,13 @@ data ProgState = ProgState -- ^ Buffer for user input } deriving (Eq, Show) +-- | The program mode +data ProgMode + = MainMenu + | NewSeason + | NewGame GameState + deriving (Eq, Show) + -- | The game state data GameState = GameState { _gameYear :: Maybe Int @@ -174,13 +181,6 @@ data GameState = GameState -- ^ Set to 'True' when the user confirms the entered data } deriving (Eq, Show) --- | The program mode -data ProgMode - = MainMenu - | NewSeason - | NewGame GameState - deriving (Eq, Show) - -- | The type of game data GameType = HomeGame From 6b73e367e4fcd020f9b1d45047e13011c503c788 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Sun, 8 Sep 2019 12:06:38 -0400 Subject: [PATCH 2/8] implemented CreatePlayerState --- src/Mtlstats/Types.hs | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index cf29ee4..4375bf6 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -29,6 +29,7 @@ module Mtlstats.Types ( ProgMode (..), GameState (..), GameType (..), + CreatePlayerState (..), Database (..), Player (..), PlayerStats (..), @@ -53,6 +54,11 @@ module Mtlstats.Types ( awayScore, overtimeFlag, dataVerified, + -- ** CreatePlayerState Lenses + cpsNumber, + cpsName, + cpsPosition, + cpsConfirmed, -- ** Database Lenses dbPlayers, dbGoalies, @@ -89,6 +95,7 @@ module Mtlstats.Types ( -- * Constructors newProgState, newGameState, + newCreatePlayerState, newDatabase, newPlayer, newPlayerStats, @@ -187,6 +194,18 @@ data GameType | AwayGame deriving (Eq, Show) +-- | Player creation status +data CreatePlayerState = CreatePlayerState + { _cpsNumber :: Maybe Int + -- ^ The player's number + , _cpsName :: String + -- ^ The player's name + , _cpsPosition :: String + -- ^ The player's position + , _cpsConfirmed :: Bool + -- ^ Set when the user confirms the input + } deriving (Eq, Show) + -- | Represents the database data Database = Database { _dbPlayers :: [Player] @@ -408,6 +427,7 @@ data Prompt = Prompt makeLenses ''ProgState makeLenses ''GameState +makeLenses ''CreatePlayerState makeLenses ''Database makeLenses ''Player makeLenses ''PlayerStats @@ -444,6 +464,15 @@ newGameState = GameState , _dataVerified = False } +-- | Constructor for a 'CreatePlayerState' +newCreatePlayerState :: CreatePlayerState +newCreatePlayerState = CreatePlayerState + { _cpsNumber = Nothing + , _cpsName = "" + , _cpsPosition = "" + , _cpsConfirmed = False + } + -- | Constructor for a 'Database' newDatabase :: Database newDatabase = Database From d5d08aa0f744f49214851124649a3be1087be926 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 9 Sep 2019 10:51:32 -0400 Subject: [PATCH 3/8] added create player option to main menu --- src/Mtlstats/Actions.hs | 5 +++++ src/Mtlstats/Control.hs | 1 + src/Mtlstats/Menu.hs | 4 +++- src/Mtlstats/Types.hs | 1 + test/ActionsSpec.hs | 7 +++++++ 5 files changed, 17 insertions(+), 1 deletion(-) diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 460e3fd..c20e2da 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -30,6 +30,7 @@ module Mtlstats.Actions , overtimeCheck , updateGameStats , validateGameDate + , createPlayer ) where import Data.Maybe (fromMaybe) @@ -111,3 +112,7 @@ validateGameDate s = fromMaybe s $ do . (gameMonth .~ Nothing) . (gameDay .~ Nothing) else s + +-- | Starts player creation mode +createPlayer :: ProgState -> ProgState +createPlayer = progMode .~ CreatePlayer newCreatePlayerState diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 02efaee..01331ad 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -53,6 +53,7 @@ dispatch s = case s^.progMode of | null $ gs^.overtimeFlag -> overtimeFlagC | not $ gs^.dataVerified -> verifyDataC | otherwise -> reportC + CreatePlayer _ -> undefined mainMenuC :: Controller mainMenuC = Controller diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index 42a2e7f..ba2c640 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -60,7 +60,9 @@ mainMenu = Menu "*** MAIN MENU ***" True modify startNewSeason >> return True , MenuItem '2' "New Game" $ modify startNewGame >> return True - , MenuItem '3' "Exit" $ + , MenuItem '3' "Create Player" $ + modify createPlayer >> return True + , MenuItem '4' "Exit" $ return False ] diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 4375bf6..b5a0324 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -164,6 +164,7 @@ data ProgMode = MainMenu | NewSeason | NewGame GameState + | CreatePlayer CreatePlayerState deriving (Eq, Show) -- | The game state diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index c023cbb..3af72f5 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -39,6 +39,7 @@ spec = describe "Mtlstats.Actions" $ do overtimeCheckSpec updateGameStatsSpec validateGameDateSpec + createPlayerSpec startNewSeasonSpec :: Spec startNewSeasonSpec = describe "startNewSeason" $ do @@ -315,6 +316,12 @@ validateGameDateSpec = describe "validateGameDate" $ do s^.progMode.gameStateL.gameMonth `shouldBe` Just 6 s^.progMode.gameStateL.gameDay `shouldBe` Nothing +createPlayerSpec :: Spec +createPlayerSpec = describe "createPlayer" $ + it "should change the mode appropriately" $ let + s = createPlayer newProgState + in s^.progMode `shouldBe` CreatePlayer newCreatePlayerState + makePlayer :: IO Player makePlayer = Player <$> makeNum From 154c3979a55bf0720166da4d4a5a9853304acece Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 9 Sep 2019 11:43:37 -0400 Subject: [PATCH 4/8] implemented createPlayerStateL --- src/Mtlstats/Types.hs | 8 ++++++++ test/TypesSpec.hs | 18 ++++++++++++++++++ 2 files changed, 26 insertions(+) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index b5a0324..645a11e 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -44,6 +44,7 @@ module Mtlstats.Types ( inputBuffer, -- ** ProgMode Lenses gameStateL, + createPlayerStateL, -- ** GameState Lenses gameYear, gameMonth, @@ -443,6 +444,13 @@ gameStateL = lens _ -> newGameState) (\_ gs -> NewGame gs) +createPlayerStateL :: Lens' ProgMode CreatePlayerState +createPlayerStateL = lens + (\case + CreatePlayer cps -> cps + _ -> newCreatePlayerState) + (\_ cps -> CreatePlayer cps) + -- | Constructor for a 'ProgState' newProgState :: ProgState newProgState = ProgState diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index 724a28a..68a15d2 100644 --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -42,6 +42,7 @@ spec = describe "Mtlstats.Types" $ do gameStatsSpec databaseSpec gameStateLSpec + createPlayerStateLSpec teamScoreSpec otherScoreSpec homeTeamSpec @@ -81,6 +82,23 @@ gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL ] where gs t = newGameState & gameType ?~ t +createPlayerStateLSpec :: Spec +createPlayerStateLSpec = describe "createPlayerStateL" $ + lensSpec createPlayerStateL + -- getters + [ ( MainMenu, newCreatePlayerState ) + , ( CreatePlayer $ cps 1 , cps 1 ) + ] + -- setters + [ ( MainMenu, cps 1 ) + , ( CreatePlayer $ cps 1, cps 2 ) + ] + where + cps n = newCreatePlayerState + & cpsNumber ?~ n + & cpsName .~ "foo" + & cpsPosition .~ "bar" + teamScoreSpec :: Spec teamScoreSpec = describe "teamScore" $ do let From 754b3dd25c2d952d4e6d0f98f1e7b845ffe3ef8e Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 9 Sep 2019 13:04:39 -0400 Subject: [PATCH 5/8] prompt for player number --- src/Mtlstats/Control.hs | 12 +++++++++++- src/Mtlstats/Prompt.hs | 8 +++++++- 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 01331ad..f16e9c1 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -53,7 +53,9 @@ dispatch s = case s^.progMode of | null $ gs^.overtimeFlag -> overtimeFlagC | not $ gs^.dataVerified -> verifyDataC | otherwise -> reportC - CreatePlayer _ -> undefined + CreatePlayer cps + | null $ cps^.cpsNumber -> getPlayerNumC + | otherwise -> undefined mainMenuC :: Controller mainMenuC = Controller @@ -195,3 +197,11 @@ reportC = Controller header :: ProgState -> C.Update () header s = C.drawString $ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n" + +getPlayerNumC :: Controller +getPlayerNumC = Controller + { drawController = drawPrompt playerNumPrompt + , handleController = \e -> do + promptHandler playerNumPrompt e + return True + } diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index e25e2b3..b552b70 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -30,7 +30,8 @@ module Mtlstats.Prompt ( gameDayPrompt, otherTeamPrompt, homeScorePrompt, - awayScorePrompt + awayScorePrompt, + playerNumPrompt ) where import Control.Monad (when) @@ -120,5 +121,10 @@ awayScorePrompt :: Prompt awayScorePrompt = numPrompt "Away score: " $ modify . (progMode.gameStateL.awayScore ?~) +-- | Prompts for a new player's number +playerNumPrompt :: Prompt +playerNumPrompt = numPrompt "Player number: " $ + modify . (progMode.createPlayerStateL.cpsNumber ?~) + drawSimplePrompt :: String -> ProgState -> C.Update () drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer From 57ac90038af7295aca7849bc953a5576f7f50da5 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 9 Sep 2019 22:50:44 -0400 Subject: [PATCH 6/8] prompt for player name --- src/Mtlstats/Control.hs | 9 +++++++++ src/Mtlstats/Prompt.hs | 8 +++++++- 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index f16e9c1..49b594f 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -55,6 +55,7 @@ dispatch s = case s^.progMode of | otherwise -> reportC CreatePlayer cps | null $ cps^.cpsNumber -> getPlayerNumC + | null $ cps^.cpsName -> getPlayerNameC | otherwise -> undefined mainMenuC :: Controller @@ -205,3 +206,11 @@ getPlayerNumC = Controller promptHandler playerNumPrompt e return True } + +getPlayerNameC :: Controller +getPlayerNameC = Controller + { drawController = drawPrompt playerNamePrompt + , handleController = \e -> do + promptHandler playerNamePrompt e + return True + } diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index b552b70..f714746 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -31,7 +31,8 @@ module Mtlstats.Prompt ( otherTeamPrompt, homeScorePrompt, awayScorePrompt, - playerNumPrompt + playerNumPrompt, + playerNamePrompt, ) where import Control.Monad (when) @@ -126,5 +127,10 @@ playerNumPrompt :: Prompt playerNumPrompt = numPrompt "Player number: " $ modify . (progMode.createPlayerStateL.cpsNumber ?~) +-- | Prompts for a new player's name +playerNamePrompt :: Prompt +playerNamePrompt = strPrompt "Player name: " $ + modify . (progMode.createPlayerStateL.cpsName .~) + drawSimplePrompt :: String -> ProgState -> C.Update () drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer From 0ee045149634e44f32f76592cdbcea1ce216996b Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 9 Sep 2019 22:57:36 -0400 Subject: [PATCH 7/8] prompt for player's position --- src/Mtlstats/Control.hs | 15 ++++++++++++--- src/Mtlstats/Prompt.hs | 6 ++++++ 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 49b594f..87587c7 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -54,9 +54,10 @@ dispatch s = case s^.progMode of | not $ gs^.dataVerified -> verifyDataC | otherwise -> reportC CreatePlayer cps - | null $ cps^.cpsNumber -> getPlayerNumC - | null $ cps^.cpsName -> getPlayerNameC - | otherwise -> undefined + | null $ cps^.cpsNumber -> getPlayerNumC + | null $ cps^.cpsName -> getPlayerNameC + | null $ cps^.cpsPosition -> getPlayerPosC + | otherwise -> undefined mainMenuC :: Controller mainMenuC = Controller @@ -214,3 +215,11 @@ getPlayerNameC = Controller promptHandler playerNamePrompt e return True } + +getPlayerPosC :: Controller +getPlayerPosC = Controller + { drawController = drawPrompt playerPosPrompt + , handleController = \e -> do + promptHandler playerPosPrompt e + return True + } diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index f714746..3909b11 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -33,6 +33,7 @@ module Mtlstats.Prompt ( awayScorePrompt, playerNumPrompt, playerNamePrompt, + playerPosPrompt ) where import Control.Monad (when) @@ -132,5 +133,10 @@ playerNamePrompt :: Prompt playerNamePrompt = strPrompt "Player name: " $ modify . (progMode.createPlayerStateL.cpsName .~) +-- | Prompts for a new player's position +playerPosPrompt :: Prompt +playerPosPrompt = strPrompt "Player position: " $ + modify . (progMode.createPlayerStateL.cpsPosition .~) + drawSimplePrompt :: String -> ProgState -> C.Update () drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer From 375e87a49e119ae54e9604eff15fac1fdb3fb915 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 9 Sep 2019 23:35:28 -0400 Subject: [PATCH 8/8] implemented player confirmation/addition --- src/Mtlstats/Actions.hs | 13 +++++++++++++ src/Mtlstats/Control.hs | 20 ++++++++++++++++++++ test/ActionsSpec.hs | 25 +++++++++++++++++++++++++ 3 files changed, 58 insertions(+) diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index c20e2da..951e236 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -31,6 +31,7 @@ module Mtlstats.Actions , updateGameStats , validateGameDate , createPlayer + , addPlayer ) where import Data.Maybe (fromMaybe) @@ -116,3 +117,15 @@ validateGameDate s = fromMaybe s $ do -- | Starts player creation mode createPlayer :: ProgState -> ProgState createPlayer = progMode .~ CreatePlayer newCreatePlayerState + +-- | Adds the entered player to the roster +addPlayer :: ProgState -> ProgState +addPlayer s = fromMaybe s $ do + let cps = s^.progMode.createPlayerStateL + num <- cps^.cpsNumber + let + name = cps^.cpsName + pos = cps^.cpsPosition + player = newPlayer num name pos + Just $ s & database.dbPlayers + %~ (player:) diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 87587c7..7fe276b 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -57,6 +57,7 @@ dispatch s = case s^.progMode of | null $ cps^.cpsNumber -> getPlayerNumC | null $ cps^.cpsName -> getPlayerNameC | null $ cps^.cpsPosition -> getPlayerPosC + | not $ cps^.cpsConfirmed -> confirmCreatePlayerC | otherwise -> undefined mainMenuC :: Controller @@ -223,3 +224,22 @@ getPlayerPosC = Controller promptHandler playerPosPrompt e return True } + +confirmCreatePlayerC :: Controller +confirmCreatePlayerC = Controller + { drawController = \s -> do + let cps = s^.progMode.createPlayerStateL + C.drawString $ " Player number: " ++ show (fromJust $ cps^.cpsNumber) ++ "\n" + C.drawString $ " Player name: " ++ cps^.cpsName ++ "\n" + C.drawString $ "Player position: " ++ cps^.cpsPosition ++ "\n\n" + C.drawString "Create player: are you sure? (Y/N)" + return C.CursorInvisible + , handleController = \e -> do + case ynHandler e of + Just True -> do + modify addPlayer + modify $ progMode .~ MainMenu + Just False -> modify $ progMode .~ MainMenu + Nothing -> return () + return True + } diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 3af72f5..470492f 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -40,6 +40,7 @@ spec = describe "Mtlstats.Actions" $ do updateGameStatsSpec validateGameDateSpec createPlayerSpec + addPlayerSpec startNewSeasonSpec :: Spec startNewSeasonSpec = describe "startNewSeason" $ do @@ -322,6 +323,30 @@ createPlayerSpec = describe "createPlayer" $ s = createPlayer newProgState in s^.progMode `shouldBe` CreatePlayer newCreatePlayerState +addPlayerSpec :: Spec +addPlayerSpec = describe "addPlayer" $ do + let + p1 = newPlayer 1 "Joe" "centre" + p2 = newPlayer 2 "Bob" "defense" + db = newDatabase + & dbPlayers .~ [p2] + s pm = newProgState + & progMode .~ pm + & database .~ db + + context "data available" $ + it "should create the player" $ let + s' = addPlayer $ s $ CreatePlayer $ newCreatePlayerState + & cpsNumber ?~ 1 + & cpsName .~ "Joe" + & cpsPosition .~ "centre" + in s'^.database.dbPlayers `shouldBe` [p1, p2] + + context "data unavailable" $ + it "should not create the player" $ let + s' = addPlayer $ s MainMenu + in s'^.database.dbPlayers `shouldBe` [p2] + makePlayer :: IO Player makePlayer = Player <$> makeNum