From 1e7c4d6c1947ac1414e6d930e916845fdc20bcbc Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Fri, 6 Sep 2019 11:21:46 -0400 Subject: [PATCH 1/5] added dataVerified field to GameState --- src/Mtlstats/Types.hs | 4 ++++ 1 file changed, 4 insertions(+) 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' From e0dd80079d6b65c06b6b979fbc894bbe0c298e6f Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Fri, 6 Sep 2019 23:25:13 -0400 Subject: [PATCH 2/5] implemented ynHandler --- src/Mtlstats/Handlers.hs | 33 ++++++++++++++++++++++++++++ test/HandlersSpec.hs | 46 ++++++++++++++++++++++++++++++++++++++++ test/Spec.hs | 2 ++ 3 files changed, 81 insertions(+) create mode 100644 src/Mtlstats/Handlers.hs create mode 100644 test/HandlersSpec.hs 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/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/Spec.hs b/test/Spec.hs index 8982a05..54c9e24 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -23,6 +23,7 @@ import Test.Hspec (hspec) import qualified ActionsSpec as Actions import qualified FormatSpec as Format +import qualified HandlersSpec as Handlers import qualified TypesSpec as Types main :: IO () @@ -30,3 +31,4 @@ main = hspec $ do Types.spec Actions.spec Format.spec + Handlers.spec From 27867ba69d9a75c6d4ad24c0e8e297a4bd28a3ff Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Sat, 7 Sep 2019 00:26:15 -0400 Subject: [PATCH 3/5] implemented Mtlstats.Report.date --- src/Mtlstats/Report.hs | 16 ++++++++------ test/ReportSpec.hs | 47 ++++++++++++++++++++++++++++++++++++++++++ test/Spec.hs | 2 ++ 3 files changed, 59 insertions(+), 6 deletions(-) create mode 100644 test/ReportSpec.hs diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index cf93da5..0121141 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, date) 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 + gDate = date gs hTeam = homeTeam gs aTeam = awayTeam gs hStats = db^.dbHomeGameStats @@ -47,17 +48,13 @@ 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) (centre width $ aTeam ++ " " ++ show aScore ++ " AT " ++ hTeam ++ " " ++ show hScore) - , date + , gDate , centre width "STANDINGS" , "" , centre width @@ -81,6 +78,13 @@ report width s = unlines $ fromMaybe [] $ do ++ showStats tStats ] +date :: GameState -> String +date 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/test/ReportSpec.hs b/test/ReportSpec.hs new file mode 100644 index 0000000..c33dad5 --- /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" + dateSpec + +dateSpec :: Spec +dateSpec = describe "date" $ do + + context "valid date" $ + it "should format the date" $ let + gs = newGameState + & gameYear ?~ 1980 + & gameMonth ?~ 6 + & gameDay ?~ 25 + in date gs `shouldBe` "JUN 25 1980" + + context "invalid date" $ + it "should return an empty string" $ + date newGameState `shouldBe` "" diff --git a/test/Spec.hs b/test/Spec.hs index 54c9e24..a3db0ba 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -24,6 +24,7 @@ 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 () @@ -32,3 +33,4 @@ main = hspec $ do Actions.spec Format.spec Handlers.spec + Report.spec From dc2f632563e1ba1e241114111ca6dbbbd45340bb Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Sat, 7 Sep 2019 00:27:18 -0400 Subject: [PATCH 4/5] prompt for confirmation of game input --- src/Mtlstats/Control.hs | 246 +++++++++++++++++++++++----------------- 1 file changed, 142 insertions(+), 104 deletions(-) diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 43a8e72..dd61c4e 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: " ++ date 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 () From 9c0ebb42d18abd65989935e2c1eedafbcd28c270 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Sat, 7 Sep 2019 09:06:16 -0400 Subject: [PATCH 5/5] renamed date to gameDate --- src/Mtlstats/Control.hs | 2 +- src/Mtlstats/Report.hs | 10 +++++----- test/ReportSpec.hs | 12 ++++++------ 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index dd61c4e..02efaee 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -157,7 +157,7 @@ verifyDataC = Controller let gs = s^.progMode.gameStateL header s C.drawString "\n" - C.drawString $ " Date: " ++ date gs ++ "\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" diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index 0121141..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, date) where +module Mtlstats.Report (report, gameDate) where import Data.Maybe (fromMaybe) import Lens.Micro ((^.)) @@ -40,7 +40,7 @@ report width s = unlines $ fromMaybe [] $ do db = s^.database gs = s^.progMode.gameStateL gNum = db^.dbGames - gDate = date gs + date = gameDate gs hTeam = homeTeam gs aTeam = awayTeam gs hStats = db^.dbHomeGameStats @@ -54,7 +54,7 @@ report width s = unlines $ fromMaybe [] $ do (centre width $ aTeam ++ " " ++ show aScore ++ " AT " ++ hTeam ++ " " ++ show hScore) - , gDate + , date , centre width "STANDINGS" , "" , centre width @@ -78,8 +78,8 @@ report width s = unlines $ fromMaybe [] $ do ++ showStats tStats ] -date :: GameState -> String -date gs = fromMaybe "" $ do +gameDate :: GameState -> String +gameDate gs = fromMaybe "" $ do year <- show <$> gs^.gameYear month <- month <$> gs^.gameMonth day <- padNum 2 <$> gs^.gameDay diff --git a/test/ReportSpec.hs b/test/ReportSpec.hs index c33dad5..dafe415 100644 --- a/test/ReportSpec.hs +++ b/test/ReportSpec.hs @@ -29,19 +29,19 @@ import Mtlstats.Types spec :: Spec spec = describe "Mtlstats.Report" - dateSpec + gameDateSpec -dateSpec :: Spec -dateSpec = describe "date" $ do +gameDateSpec :: Spec +gameDateSpec = describe "gameDate" $ do - context "valid date" $ + context "valid gameDate" $ it "should format the date" $ let gs = newGameState & gameYear ?~ 1980 & gameMonth ?~ 6 & gameDay ?~ 25 - in date gs `shouldBe` "JUN 25 1980" + in gameDate gs `shouldBe` "JUN 25 1980" context "invalid date" $ it "should return an empty string" $ - date newGameState `shouldBe` "" + gameDate newGameState `shouldBe` ""