Merge pull request #14 from mtlstats/verify-input

Verify input
This commit is contained in:
Jonathan Lamothe 2019-09-07 09:15:29 -04:00 committed by GitHub
commit 6cb348a4a8
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 285 additions and 109 deletions

View File

@ -24,11 +24,13 @@ module Mtlstats.Control (dispatch) where
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Trans.State (modify) import Control.Monad.Trans.State (modify)
import Data.Char (toUpper) import Data.Char (toUpper)
import Data.Maybe (fromJust)
import Lens.Micro ((^.), (.~)) import Lens.Micro ((^.), (.~))
import qualified UI.NCurses as C import qualified UI.NCurses as C
import Mtlstats.Actions import Mtlstats.Actions
import Mtlstats.Format import Mtlstats.Format
import Mtlstats.Handlers
import Mtlstats.Menu import Mtlstats.Menu
import Mtlstats.Prompt import Mtlstats.Prompt
import Mtlstats.Report import Mtlstats.Report
@ -38,22 +40,36 @@ import Mtlstats.Types
-- run -- run
dispatch :: ProgState -> Controller dispatch :: ProgState -> Controller
dispatch s = case s^.progMode of dispatch s = case s^.progMode of
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
MainMenu -> Controller mainMenuC :: Controller
mainMenuC = Controller
{ drawController = const $ drawMenu mainMenu { drawController = const $ drawMenu mainMenu
, handleController = menuHandler mainMenu , handleController = menuHandler mainMenu
} }
NewSeason -> Controller newSeasonC :: Controller
newSeasonC = Controller
{ drawController = const $ drawMenu newSeasonMenu { drawController = const $ drawMenu newSeasonMenu
, handleController = \e -> do , handleController = \e -> do
menuHandler newSeasonMenu e menuHandler newSeasonMenu e
return True return True
} }
NewGame gs gameYearC :: Controller
gameYearC = Controller
| null $ gs^.gameYear -> Controller
{ drawController = \s -> do { drawController = \s -> do
header s header s
drawPrompt gameYearPrompt s drawPrompt gameYearPrompt s
@ -62,7 +78,8 @@ dispatch s = case s^.progMode of
return True return True
} }
| null $ gs^.gameMonth -> Controller gameMonthC :: Controller
gameMonthC = Controller
{ drawController = \s -> do { drawController = \s -> do
header s header s
drawMenu gameMonthMenu drawMenu gameMonthMenu
@ -71,7 +88,8 @@ dispatch s = case s^.progMode of
return True return True
} }
| null $ gs^.gameDay -> Controller gameDayC :: Controller
gameDayC = Controller
{ drawController = \s -> do { drawController = \s -> do
header s header s
drawPrompt gameDayPrompt s drawPrompt gameDayPrompt s
@ -81,7 +99,8 @@ dispatch s = case s^.progMode of
return True return True
} }
| null $ gs^.gameType -> Controller gameTypeC :: Controller
gameTypeC = Controller
{ drawController = \s -> do { drawController = \s -> do
header s header s
drawMenu gameTypeMenu drawMenu gameTypeMenu
@ -90,7 +109,8 @@ dispatch s = case s^.progMode of
return True return True
} }
| null $ gs^.otherTeam -> Controller otherTeamC :: Controller
otherTeamC = Controller
{ drawController = \s -> do { drawController = \s -> do
header s header s
drawPrompt otherTeamPrompt s drawPrompt otherTeamPrompt s
@ -99,7 +119,8 @@ dispatch s = case s^.progMode of
return True return True
} }
| null $ gs^.homeScore -> Controller homeScoreC :: Controller
homeScoreC = Controller
{ drawController = \s -> do { drawController = \s -> do
header s header s
drawPrompt homeScorePrompt s drawPrompt homeScorePrompt s
@ -108,29 +129,54 @@ dispatch s = case s^.progMode of
return True return True
} }
| null $ gs^.awayScore -> Controller awayScoreC :: Controller
awayScoreC = Controller
{ drawController = \s -> do { drawController = \s -> do
header s header s
drawPrompt awayScorePrompt s drawPrompt awayScorePrompt s
, handleController = \e -> do , handleController = \e -> do
promptHandler awayScorePrompt e promptHandler awayScorePrompt e
modify overtimeCheck modify overtimeCheck
modify updateGameStats
return True return True
} }
| null $ gs^.overtimeFlag -> Controller overtimeFlagC :: Controller
overtimeFlagC = Controller
{ drawController = \s -> do { drawController = \s -> do
header s header s
C.drawString "Did the game go into overtime? (Y/N)" C.drawString "Did the game go into overtime? (Y/N)"
return C.CursorInvisible return C.CursorInvisible
, handleController = \e -> do , handleController = \e -> do
overtimePrompt e modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
modify updateGameStats
return True return True
} }
| otherwise -> Controller 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
Just False -> modify $ progMode.gameStateL .~ newGameState
Nothing -> return ()
return True
}
reportC :: Controller
reportC = Controller
{ drawController = \s -> do { drawController = \s -> do
(_, cols) <- C.windowSize (_, cols) <- C.windowSize
C.drawString $ report (fromInteger $ pred cols) s C.drawString $ report (fromInteger $ pred cols) s
@ -148,11 +194,3 @@ dispatch s = case s^.progMode of
header :: ProgState -> C.Update () header :: ProgState -> C.Update ()
header s = C.drawString $ header s = C.drawString $
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n" "*** 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 ()

33
src/Mtlstats/Handlers.hs Normal file
View File

@ -0,0 +1,33 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
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 <https://www.gnu.org/licenses/>.
-}
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

View File

@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
module Mtlstats.Report (report) where module Mtlstats.Report (report, gameDate) where
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Lens.Micro ((^.)) import Lens.Micro ((^.))
@ -40,6 +40,7 @@ report width s = unlines $ fromMaybe [] $ do
db = s^.database db = s^.database
gs = s^.progMode.gameStateL gs = s^.progMode.gameStateL
gNum = db^.dbGames gNum = db^.dbGames
date = gameDate gs
hTeam = homeTeam gs hTeam = homeTeam gs
aTeam = awayTeam gs aTeam = awayTeam gs
hStats = db^.dbHomeGameStats hStats = db^.dbHomeGameStats
@ -47,10 +48,6 @@ report width s = unlines $ fromMaybe [] $ do
tStats = addGameStats hStats aStats tStats = addGameStats hStats aStats
hScore <- gs^.homeScore hScore <- gs^.homeScore
aScore <- gs^.awayScore aScore <- gs^.awayScore
month <- month <$> gs^.gameMonth
day <- padNum 2 <$> gs^.gameDay
year <- show <$> gs^.gameYear
let date = month ++ " " ++ day ++ " " ++ year
Just Just
[ overlay [ overlay
("GAME NUMBER " ++ padNum 2 gNum) ("GAME NUMBER " ++ padNum 2 gNum)
@ -81,6 +78,13 @@ report width s = unlines $ fromMaybe [] $ do
++ showStats tStats ++ 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 :: GameStats -> String
showStats gs showStats gs
= right 2 (show $ gmsGames gs) = right 2 (show $ gmsGames gs)

View File

@ -52,6 +52,7 @@ module Mtlstats.Types (
homeScore, homeScore,
awayScore, awayScore,
overtimeFlag, overtimeFlag,
dataVerified,
-- ** Database Lenses -- ** Database Lenses
dbPlayers, dbPlayers,
dbGoalies, dbGoalies,
@ -169,6 +170,8 @@ data GameState = GameState
-- ^ The away team's score -- ^ The away team's score
, _overtimeFlag :: Maybe Bool , _overtimeFlag :: Maybe Bool
-- ^ Indicates whether or not the game went into overtime -- ^ Indicates whether or not the game went into overtime
, _dataVerified :: Bool
-- ^ Set to 'True' when the user confirms the entered data
} deriving (Eq, Show) } deriving (Eq, Show)
-- | The program mode -- | The program mode
@ -438,6 +441,7 @@ newGameState = GameState
, _homeScore = Nothing , _homeScore = Nothing
, _awayScore = Nothing , _awayScore = Nothing
, _overtimeFlag = Nothing , _overtimeFlag = Nothing
, _dataVerified = False
} }
-- | Constructor for a 'Database' -- | Constructor for a 'Database'

46
test/HandlersSpec.hs Normal file
View File

@ -0,0 +1,46 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
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 <https://www.gnu.org/licenses/>.
-}
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 )
]

47
test/ReportSpec.hs Normal file
View File

@ -0,0 +1,47 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
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 <https://www.gnu.org/licenses/>.
-}
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` ""

View File

@ -23,6 +23,8 @@ import Test.Hspec (hspec)
import qualified ActionsSpec as Actions import qualified ActionsSpec as Actions
import qualified FormatSpec as Format import qualified FormatSpec as Format
import qualified HandlersSpec as Handlers
import qualified ReportSpec as Report
import qualified TypesSpec as Types import qualified TypesSpec as Types
main :: IO () main :: IO ()
@ -30,3 +32,5 @@ main = hspec $ do
Types.spec Types.spec
Actions.spec Actions.spec
Format.spec Format.spec
Handlers.spec
Report.spec