diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 43a8e72..02efaee 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -24,11 +24,13 @@ module Mtlstats.Control (dispatch) where import Control.Monad (when) import Control.Monad.Trans.State (modify) import Data.Char (toUpper) +import Data.Maybe (fromJust) import Lens.Micro ((^.), (.~)) import qualified UI.NCurses as C import Mtlstats.Actions import Mtlstats.Format +import Mtlstats.Handlers import Mtlstats.Menu import Mtlstats.Prompt import Mtlstats.Report @@ -38,121 +40,157 @@ import Mtlstats.Types -- run dispatch :: ProgState -> Controller dispatch s = case s^.progMode of - - MainMenu -> Controller - { drawController = const $ drawMenu mainMenu - , handleController = menuHandler mainMenu - } - - NewSeason -> Controller - { drawController = const $ drawMenu newSeasonMenu - , handleController = \e -> do - menuHandler newSeasonMenu e - return True - } - + MainMenu -> mainMenuC + NewSeason -> newSeasonC NewGame gs + | null $ gs^.gameYear -> gameYearC + | null $ gs^.gameMonth -> gameMonthC + | null $ gs^.gameDay -> gameDayC + | null $ gs^.gameType -> gameTypeC + | null $ gs^.otherTeam -> otherTeamC + | null $ gs^.homeScore -> homeScoreC + | null $ gs^.awayScore -> awayScoreC + | null $ gs^.overtimeFlag -> overtimeFlagC + | not $ gs^.dataVerified -> verifyDataC + | otherwise -> reportC - | null $ gs^.gameYear -> Controller - { drawController = \s -> do - header s - drawPrompt gameYearPrompt s - , handleController = \e -> do - promptHandler gameYearPrompt e - return True - } +mainMenuC :: Controller +mainMenuC = Controller + { drawController = const $ drawMenu mainMenu + , handleController = menuHandler mainMenu + } - | null $ gs^.gameMonth -> Controller - { drawController = \s -> do - header s - drawMenu gameMonthMenu - , handleController = \e -> do - menuHandler gameMonthMenu e - return True - } +newSeasonC :: Controller +newSeasonC = Controller + { drawController = const $ drawMenu newSeasonMenu + , handleController = \e -> do + menuHandler newSeasonMenu e + return True + } - | null $ gs^.gameDay -> Controller - { drawController = \s -> do - header s - drawPrompt gameDayPrompt s - , handleController = \e -> do - promptHandler gameDayPrompt e - modify validateGameDate - return True - } +gameYearC :: Controller +gameYearC = Controller + { drawController = \s -> do + header s + drawPrompt gameYearPrompt s + , handleController = \e -> do + promptHandler gameYearPrompt e + return True + } - | null $ gs^.gameType -> Controller - { drawController = \s -> do - header s - drawMenu gameTypeMenu - , handleController = \e -> do - menuHandler gameTypeMenu e - return True - } +gameMonthC :: Controller +gameMonthC = Controller + { drawController = \s -> do + header s + drawMenu gameMonthMenu + , handleController = \e -> do + menuHandler gameMonthMenu e + return True + } - | null $ gs^.otherTeam -> Controller - { drawController = \s -> do - header s - drawPrompt otherTeamPrompt s - , handleController = \e -> do - promptHandler otherTeamPrompt e - return True - } +gameDayC :: Controller +gameDayC = Controller + { drawController = \s -> do + header s + drawPrompt gameDayPrompt s + , handleController = \e -> do + promptHandler gameDayPrompt e + modify validateGameDate + return True + } - | null $ gs^.homeScore -> Controller - { drawController = \s -> do - header s - drawPrompt homeScorePrompt s - , handleController = \e -> do - promptHandler homeScorePrompt e - return True - } +gameTypeC :: Controller +gameTypeC = Controller + { drawController = \s -> do + header s + drawMenu gameTypeMenu + , handleController = \e -> do + menuHandler gameTypeMenu e + return True + } - | null $ gs^.awayScore -> Controller - { drawController = \s -> do - header s - drawPrompt awayScorePrompt s - , handleController = \e -> do - promptHandler awayScorePrompt e - modify overtimeCheck +otherTeamC :: Controller +otherTeamC = Controller + { drawController = \s -> do + header s + drawPrompt otherTeamPrompt s + , handleController = \e -> do + promptHandler otherTeamPrompt e + return True + } + +homeScoreC :: Controller +homeScoreC = Controller + { drawController = \s -> do + header s + drawPrompt homeScorePrompt s + , handleController = \e -> do + promptHandler homeScorePrompt e + return True + } + +awayScoreC :: Controller +awayScoreC = Controller + { drawController = \s -> do + header s + drawPrompt awayScorePrompt s + , handleController = \e -> do + promptHandler awayScorePrompt e + modify overtimeCheck + return True + } + +overtimeFlagC :: Controller +overtimeFlagC = Controller + { drawController = \s -> do + header s + C.drawString "Did the game go into overtime? (Y/N)" + return C.CursorInvisible + , handleController = \e -> do + modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e + return True + } + +verifyDataC :: Controller +verifyDataC = Controller + { drawController = \s -> do + let gs = s^.progMode.gameStateL + header s + C.drawString "\n" + C.drawString $ " Date: " ++ gameDate gs ++ "\n" + C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n" + C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n" + C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n" + C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n" + C.drawString $ " Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n" + C.drawString "Is the above information correct? (Y/N)" + return C.CursorInvisible + , handleController = \e -> do + case ynHandler e of + Just True -> do + modify $ progMode.gameStateL.dataVerified .~ True modify updateGameStats - return True - } + Just False -> modify $ progMode.gameStateL .~ newGameState + Nothing -> return () + return True + } - | null $ gs^.overtimeFlag -> Controller - { drawController = \s -> do - header s - C.drawString "Did the game go into overtime? (Y/N)" - return C.CursorInvisible - , handleController = \e -> do - overtimePrompt e - modify updateGameStats - return True - } - - | otherwise -> Controller - { drawController = \s -> do - (_, cols) <- C.windowSize - C.drawString $ report (fromInteger $ pred cols) s - return C.CursorInvisible - , handleController = \e -> do - when - (case e of - C.EventCharacter _ -> True - C.EventSpecialKey _ -> True - _ -> False) $ - modify $ progMode .~ MainMenu - return True - } +reportC :: Controller +reportC = Controller + { drawController = \s -> do + (_, cols) <- C.windowSize + C.drawString $ report (fromInteger $ pred cols) s + return C.CursorInvisible + , handleController = \e -> do + when + (case e of + C.EventCharacter _ -> True + C.EventSpecialKey _ -> True + _ -> False) $ + modify $ progMode .~ MainMenu + return True + } header :: ProgState -> C.Update () header s = C.drawString $ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n" - -overtimePrompt :: C.Event -> Action () -overtimePrompt (C.EventCharacter c) = modify $ - progMode.gameStateL.overtimeFlag .~ case toUpper c of - 'Y' -> Just True - 'N' -> Just False - _ -> Nothing -overtimePrompt _ = return () diff --git a/src/Mtlstats/Handlers.hs b/src/Mtlstats/Handlers.hs new file mode 100644 index 0000000..1c64bf9 --- /dev/null +++ b/src/Mtlstats/Handlers.hs @@ -0,0 +1,33 @@ +{- | + +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.Handlers (ynHandler) where + +import Data.Char (toUpper) +import qualified UI.NCurses as C + +-- | Handler for a yes/no prompt +ynHandler :: C.Event -> Maybe Bool +ynHandler (C.EventCharacter c) = case toUpper c of + 'Y' -> Just True + 'N' -> Just False + _ -> Nothing +ynHandler _ = Nothing diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index cf93da5..518c1b0 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -19,7 +19,7 @@ along with this program. If not, see . -} -module Mtlstats.Report (report) where +module Mtlstats.Report (report, gameDate) where import Data.Maybe (fromMaybe) import Lens.Micro ((^.)) @@ -40,6 +40,7 @@ report width s = unlines $ fromMaybe [] $ do db = s^.database gs = s^.progMode.gameStateL gNum = db^.dbGames + date = gameDate gs hTeam = homeTeam gs aTeam = awayTeam gs hStats = db^.dbHomeGameStats @@ -47,10 +48,6 @@ report width s = unlines $ fromMaybe [] $ do tStats = addGameStats hStats aStats hScore <- gs^.homeScore aScore <- gs^.awayScore - month <- month <$> gs^.gameMonth - day <- padNum 2 <$> gs^.gameDay - year <- show <$> gs^.gameYear - let date = month ++ " " ++ day ++ " " ++ year Just [ overlay ("GAME NUMBER " ++ padNum 2 gNum) @@ -81,6 +78,13 @@ report width s = unlines $ fromMaybe [] $ do ++ showStats tStats ] +gameDate :: GameState -> String +gameDate gs = fromMaybe "" $ do + year <- show <$> gs^.gameYear + month <- month <$> gs^.gameMonth + day <- padNum 2 <$> gs^.gameDay + Just $ month ++ " " ++ day ++ " " ++ year + showStats :: GameStats -> String showStats gs = right 2 (show $ gmsGames gs) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 7e60dc7..9bda181 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -52,6 +52,7 @@ module Mtlstats.Types ( homeScore, awayScore, overtimeFlag, + dataVerified, -- ** Database Lenses dbPlayers, dbGoalies, @@ -169,6 +170,8 @@ data GameState = GameState -- ^ The away team's score , _overtimeFlag :: Maybe Bool -- ^ Indicates whether or not the game went into overtime + , _dataVerified :: Bool + -- ^ Set to 'True' when the user confirms the entered data } deriving (Eq, Show) -- | The program mode @@ -438,6 +441,7 @@ newGameState = GameState , _homeScore = Nothing , _awayScore = Nothing , _overtimeFlag = Nothing + , _dataVerified = False } -- | Constructor for a 'Database' diff --git a/test/HandlersSpec.hs b/test/HandlersSpec.hs new file mode 100644 index 0000000..2c9457d --- /dev/null +++ b/test/HandlersSpec.hs @@ -0,0 +1,46 @@ +{- + +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 HandlersSpec (spec) where + +import Test.Hspec (Spec, context, describe, it, shouldBe) +import qualified UI.NCurses as C + +import Mtlstats.Handlers + +spec :: Spec +spec = describe "Mtlstats.Handlers" + ynHandlerSpec + +ynHandlerSpec :: Spec +ynHandlerSpec = describe "ynHandler" $ mapM_ + (\(desc, event, expected) -> + context desc $ + it ("should be " ++ show expected) $ + ynHandler event `shouldBe` expected) + -- description, event, expected + [ ( "Y pressed", C.EventCharacter 'Y', Just True ) + , ( "y pressed", C.EventCharacter 'y', Just True ) + , ( "N pressed", C.EventCharacter 'N', Just False ) + , ( "n pressed", C.EventCharacter 'n', Just False ) + , ( "x pressed", C.EventCharacter 'x', Nothing ) + , ( "other event", C.EventResized, Nothing ) + ] diff --git a/test/ReportSpec.hs b/test/ReportSpec.hs new file mode 100644 index 0000000..dafe415 --- /dev/null +++ b/test/ReportSpec.hs @@ -0,0 +1,47 @@ +{- + +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 ReportSpec (spec) where + +import Lens.Micro ((&), (?~), (%~)) +import Test.Hspec (Spec, context, describe, it, shouldBe) + +import Mtlstats.Report +import Mtlstats.Types + +spec :: Spec +spec = describe "Mtlstats.Report" + gameDateSpec + +gameDateSpec :: Spec +gameDateSpec = describe "gameDate" $ do + + context "valid gameDate" $ + it "should format the date" $ let + gs = newGameState + & gameYear ?~ 1980 + & gameMonth ?~ 6 + & gameDay ?~ 25 + in gameDate gs `shouldBe` "JUN 25 1980" + + context "invalid date" $ + it "should return an empty string" $ + gameDate newGameState `shouldBe` "" diff --git a/test/Spec.hs b/test/Spec.hs index 8982a05..a3db0ba 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -23,6 +23,8 @@ import Test.Hspec (hspec) import qualified ActionsSpec as Actions import qualified FormatSpec as Format +import qualified HandlersSpec as Handlers +import qualified ReportSpec as Report import qualified TypesSpec as Types main :: IO () @@ -30,3 +32,5 @@ main = hspec $ do Types.spec Actions.spec Format.spec + Handlers.spec + Report.spec