validate game date

package.yaml

@@ -26,6 +26,7 @@ dependencies:
 - microlens-th >= 0.4.2.3 && < 0.5
 - ncurses >= 0.2.16 && < 0.3
 - random >= 1.1 && < 1.2
+- time >= 1.8.0.2 && < 1.9
 - transformers >= 0.5.6.2 && < 0.6
 - bytestring
 - microlens

src/Mtlstats/Actions.hs

@@ -29,9 +29,11 @@ module Mtlstats.Actions
   , removeChar
   , overtimeCheck
   , updateGameStats
+  , validateGameDate
   ) where
 
 import Data.Maybe (fromMaybe)
+import Data.Time.Calendar (fromGregorianValid)
 import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
 
 import Mtlstats.Types
@@ -98,3 +100,18 @@ updateGameStats s = fromMaybe s result
           %~ (gmsWins +~ aw)
           .  (gmsLosses +~ al)
           .  (gmsOvertime +~ aot)
+
+-- | Validates the game date
+validateGameDate :: ProgState -> ProgState
+validateGameDate s = fromMaybe s result
+  where
+    result = do
+      y <- toInteger <$> s^.progMode.gameStateL.gameYear
+      m <- s^.progMode.gameStateL.gameMonth
+      d <- s^.progMode.gameStateL.gameDay
+      Just $ if null $ fromGregorianValid y m d
+        then s & progMode.gameStateL
+          %~ (gameYear  .~ Nothing)
+          .  (gameMonth .~ Nothing)
+          .  (gameDay   .~ Nothing)
+        else s

src/Mtlstats/Events.hs

@@ -51,6 +51,7 @@ handleEvent e = gets (view progMode) >>= \case
       return True
     | null $ gs^.gameDay -> do
       promptHandler gameDayPrompt e
+      modify validateGameDate
       return True
     | null $ gs^.gameType -> do
       menuHandler gameTypeMenu e

test/ActionsSpec.hs

@@ -38,6 +38,7 @@ spec = describe "Mtlstats.Actions" $ do
   removeCharSpec
   overtimeCheckSpec
   updateGameStatsSpec
+  validateGameDateSpec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -269,6 +270,51 @@ updateGameStatsSpec = describe "updateGameStats" $ do
       s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
       in updateGameStats s' `shouldBe` s'
 
+validateGameDateSpec :: Spec
+validateGameDateSpec = describe "validateGameDate" $ do
+
+  context "valid date" $
+    it "should leave the date unchanged" $ do
+      let
+        s = newProgState
+          & progMode.gameStateL
+            %~ (gameYear  ?~ 2019)
+            .  (gameMonth ?~ 6)
+            .  (gameDay   ?~ 25)
+          & validateGameDate
+      s^.progMode.gameStateL.gameYear  `shouldBe` Just 2019
+      s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
+      s^.progMode.gameStateL.gameDay   `shouldBe` Just 25
+
+  context "invalid date" $
+    it "should clear the date" $ do
+      let
+        s = newProgState
+          & progMode.gameStateL
+            %~ (gameYear  ?~ 2019)
+            .  (gameMonth ?~ 2)
+            .  (gameDay   ?~ 30)
+          & validateGameDate
+      s^.progMode.gameStateL.gameYear  `shouldBe` Nothing
+      s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
+      s^.progMode.gameStateL.gameDay   `shouldBe` Nothing
+
+  context "missing day" $
+    it "should not change anything" $ do
+      let
+
+        gs = newGameState
+          & gameYear  ?~ 2019
+          & gameMonth ?~ 6
+
+        s = newProgState
+          & progMode.gameStateL .~ gs
+          & validateGameDate
+
+      s^.progMode.gameStateL.gameYear  `shouldBe` Just 2019
+      s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
+      s^.progMode.gameStateL.gameDay   `shouldBe` Nothing
+
 makePlayer :: IO Player
 makePlayer = Player
   <$> makeNum