diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 460e3fd..951e236 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -30,6 +30,8 @@ module Mtlstats.Actions , overtimeCheck , updateGameStats , validateGameDate + , createPlayer + , addPlayer ) where import Data.Maybe (fromMaybe) @@ -111,3 +113,19 @@ validateGameDate s = fromMaybe s $ do . (gameMonth .~ Nothing) . (gameDay .~ Nothing) else s + +-- | 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 02efaee..7fe276b 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -53,6 +53,12 @@ dispatch s = case s^.progMode of | null $ gs^.overtimeFlag -> overtimeFlagC | not $ gs^.dataVerified -> verifyDataC | otherwise -> reportC + CreatePlayer cps + | null $ cps^.cpsNumber -> getPlayerNumC + | null $ cps^.cpsName -> getPlayerNameC + | null $ cps^.cpsPosition -> getPlayerPosC + | not $ cps^.cpsConfirmed -> confirmCreatePlayerC + | otherwise -> undefined mainMenuC :: Controller mainMenuC = Controller @@ -194,3 +200,46 @@ 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 + } + +getPlayerNameC :: Controller +getPlayerNameC = Controller + { drawController = drawPrompt playerNamePrompt + , handleController = \e -> do + promptHandler playerNamePrompt e + return True + } + +getPlayerPosC :: Controller +getPlayerPosC = Controller + { drawController = drawPrompt playerPosPrompt + , handleController = \e -> do + 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/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/Prompt.hs b/src/Mtlstats/Prompt.hs index e25e2b3..3909b11 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -30,7 +30,10 @@ module Mtlstats.Prompt ( gameDayPrompt, otherTeamPrompt, homeScorePrompt, - awayScorePrompt + awayScorePrompt, + playerNumPrompt, + playerNamePrompt, + playerPosPrompt ) where import Control.Monad (when) @@ -120,5 +123,20 @@ 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 ?~) + +-- | Prompts for a new player's name +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 diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 9bda181..645a11e 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -26,9 +26,10 @@ module Mtlstats.Types ( Controller (..), Action, ProgState (..), - GameState (..), ProgMode (..), + GameState (..), GameType (..), + CreatePlayerState (..), Database (..), Player (..), PlayerStats (..), @@ -43,6 +44,7 @@ module Mtlstats.Types ( inputBuffer, -- ** ProgMode Lenses gameStateL, + createPlayerStateL, -- ** GameState Lenses gameYear, gameMonth, @@ -53,6 +55,11 @@ module Mtlstats.Types ( awayScore, overtimeFlag, dataVerified, + -- ** CreatePlayerState Lenses + cpsNumber, + cpsName, + cpsPosition, + cpsConfirmed, -- ** Database Lenses dbPlayers, dbGoalies, @@ -89,6 +96,7 @@ module Mtlstats.Types ( -- * Constructors newProgState, newGameState, + newCreatePlayerState, newDatabase, newPlayer, newPlayerStats, @@ -152,6 +160,14 @@ data ProgState = ProgState -- ^ Buffer for user input } deriving (Eq, Show) +-- | The program mode +data ProgMode + = MainMenu + | NewSeason + | NewGame GameState + | CreatePlayer CreatePlayerState + deriving (Eq, Show) + -- | The game state data GameState = GameState { _gameYear :: Maybe Int @@ -174,19 +190,24 @@ 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 | 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 +429,7 @@ data Prompt = Prompt makeLenses ''ProgState makeLenses ''GameState +makeLenses ''CreatePlayerState makeLenses ''Database makeLenses ''Player makeLenses ''PlayerStats @@ -422,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 @@ -444,6 +473,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 diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index c023cbb..470492f 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -39,6 +39,8 @@ spec = describe "Mtlstats.Actions" $ do overtimeCheckSpec updateGameStatsSpec validateGameDateSpec + createPlayerSpec + addPlayerSpec startNewSeasonSpec :: Spec startNewSeasonSpec = describe "startNewSeason" $ do @@ -315,6 +317,36 @@ 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 + +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 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