diff --git a/package.yaml b/package.yaml index dbc50e5..9ee7f03 100644 --- a/package.yaml +++ b/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 diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 32c1c64..982fb79 100644 --- a/src/Mtlstats/Actions.hs +++ b/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 diff --git a/src/Mtlstats/Events.hs b/src/Mtlstats/Events.hs index 154c168..d7d031d 100644 --- a/src/Mtlstats/Events.hs +++ b/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 diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 0ec851c..953db70 100644 --- a/test/ActionsSpec.hs +++ b/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