Merge pull request #14 from mtlstats/verify-input

Verify input

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  -> mainMenuC
-  MainMenu -> Controller
+  NewSeason -> newSeasonC
-    { drawController   = const $ drawMenu mainMenu
-    , handleController = menuHandler mainMenu
-    }
-
-  NewSeason -> Controller
-    { drawController   = const $ drawMenu newSeasonMenu
-    , handleController = \e -> do
-      menuHandler newSeasonMenu e
-      return True
-    }
-
   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
+mainMenuC :: Controller
-      { drawController = \s -> do
+mainMenuC = Controller
-        header s
+  { drawController   = const $ drawMenu mainMenu
-        drawPrompt gameYearPrompt s
+  , handleController = menuHandler mainMenu
-      , handleController = \e -> do
+  }
-        promptHandler gameYearPrompt e
-        return True
-      }
 
-    | null $ gs^.gameMonth -> Controller
+newSeasonC :: Controller
-      { drawController = \s -> do
+newSeasonC = Controller
-        header s
+  { drawController   = const $ drawMenu newSeasonMenu
-        drawMenu gameMonthMenu
+  , handleController = \e -> do
-      , handleController = \e -> do
+    menuHandler newSeasonMenu e
-        menuHandler gameMonthMenu e
+    return True
-        return True
+  }
-      }
 
-    | null $ gs^.gameDay -> Controller
+gameYearC :: Controller
-      { drawController = \s -> do
+gameYearC = Controller
-        header s
+  { drawController = \s -> do
-        drawPrompt gameDayPrompt s
+    header s
-      , handleController = \e -> do
+    drawPrompt gameYearPrompt s
-        promptHandler gameDayPrompt e
+  , handleController = \e -> do
-        modify validateGameDate
+    promptHandler gameYearPrompt e
-        return True
+    return True
-      }
+  }
 
-    | null $ gs^.gameType -> Controller
+gameMonthC :: Controller
-      { drawController = \s -> do
+gameMonthC = Controller
-        header s
+  { drawController = \s -> do
-        drawMenu gameTypeMenu
+    header s
-      , handleController = \e -> do
+    drawMenu gameMonthMenu
-        menuHandler gameTypeMenu e
+  , handleController = \e -> do
-        return True
+    menuHandler gameMonthMenu e
-      }
+    return True
+  }
 
-    | null $ gs^.otherTeam -> Controller
+gameDayC :: Controller
-      { drawController = \s -> do
+gameDayC = Controller
-        header s
+  { drawController = \s -> do
-        drawPrompt otherTeamPrompt s
+    header s
-      , handleController = \e -> do
+    drawPrompt gameDayPrompt s
-        promptHandler otherTeamPrompt e
+  , handleController = \e -> do
-        return True
+    promptHandler gameDayPrompt e
-      }
+    modify validateGameDate
+    return True
+  }
 
-    | null $ gs^.homeScore -> Controller
+gameTypeC :: Controller
-      { drawController = \s -> do
+gameTypeC = Controller
-        header s
+  { drawController = \s -> do
-        drawPrompt homeScorePrompt s
+    header s
-      , handleController = \e -> do
+    drawMenu gameTypeMenu
-        promptHandler homeScorePrompt e
+  , handleController = \e -> do
-        return True
+    menuHandler gameTypeMenu e
-      }
+    return True
+  }
 
-    | null $ gs^.awayScore -> Controller
+otherTeamC :: Controller
-      { drawController = \s -> do
+otherTeamC = Controller
-        header s
+  { drawController = \s -> do
-        drawPrompt awayScorePrompt s
+    header s
-      , handleController = \e -> do
+    drawPrompt otherTeamPrompt s
-        promptHandler awayScorePrompt e
+  , handleController = \e -> do
-        modify overtimeCheck
+    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
+reportC :: Controller
-      { drawController = \s -> do
+reportC = Controller
-        header s
+  { drawController = \s -> do
-        C.drawString "Did the game go into overtime?  (Y/N)"
+    (_, cols) <- C.windowSize
-        return C.CursorInvisible
+    C.drawString $ report (fromInteger $ pred cols) s
-      , handleController = \e -> do
+    return C.CursorInvisible
-        overtimePrompt e
+  , handleController = \e -> do
-        modify updateGameStats
+    when
-        return True
+      (case e of
-      }
+        C.EventCharacter _  -> True
-
+        C.EventSpecialKey _ -> True
-    | otherwise -> Controller
+        _                   -> False) $
-      { drawController = \s -> do
+      modify $ progMode .~ MainMenu
-        (_, cols) <- C.windowSize
+    return True
-        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 ()

src/Mtlstats/Handlers.hs

@@ -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

src/Mtlstats/Report.hs

@@ -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 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)

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'

test/HandlersSpec.hs

@@ -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    )
+  ]

test/ReportSpec.hs

@@ -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` ""

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