validate game date
This commit is contained in:
parent
eef773b7fa
commit
c7c76b60f1
|
@ -26,6 +26,7 @@ dependencies:
|
||||||
- microlens-th >= 0.4.2.3 && < 0.5
|
- microlens-th >= 0.4.2.3 && < 0.5
|
||||||
- ncurses >= 0.2.16 && < 0.3
|
- ncurses >= 0.2.16 && < 0.3
|
||||||
- random >= 1.1 && < 1.2
|
- random >= 1.1 && < 1.2
|
||||||
|
- time >= 1.8.0.2 && < 1.9
|
||||||
- transformers >= 0.5.6.2 && < 0.6
|
- transformers >= 0.5.6.2 && < 0.6
|
||||||
- bytestring
|
- bytestring
|
||||||
- microlens
|
- microlens
|
||||||
|
|
|
@ -29,9 +29,11 @@ module Mtlstats.Actions
|
||||||
, removeChar
|
, removeChar
|
||||||
, overtimeCheck
|
, overtimeCheck
|
||||||
, updateGameStats
|
, updateGameStats
|
||||||
|
, validateGameDate
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.Time.Calendar (fromGregorianValid)
|
||||||
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
|
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
|
||||||
|
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
@ -98,3 +100,18 @@ updateGameStats s = fromMaybe s result
|
||||||
%~ (gmsWins +~ aw)
|
%~ (gmsWins +~ aw)
|
||||||
. (gmsLosses +~ al)
|
. (gmsLosses +~ al)
|
||||||
. (gmsOvertime +~ aot)
|
. (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
|
||||||
|
|
|
@ -51,6 +51,7 @@ handleEvent e = gets (view progMode) >>= \case
|
||||||
return True
|
return True
|
||||||
| null $ gs^.gameDay -> do
|
| null $ gs^.gameDay -> do
|
||||||
promptHandler gameDayPrompt e
|
promptHandler gameDayPrompt e
|
||||||
|
modify validateGameDate
|
||||||
return True
|
return True
|
||||||
| null $ gs^.gameType -> do
|
| null $ gs^.gameType -> do
|
||||||
menuHandler gameTypeMenu e
|
menuHandler gameTypeMenu e
|
||||||
|
|
|
@ -38,6 +38,7 @@ spec = describe "Mtlstats.Actions" $ do
|
||||||
removeCharSpec
|
removeCharSpec
|
||||||
overtimeCheckSpec
|
overtimeCheckSpec
|
||||||
updateGameStatsSpec
|
updateGameStatsSpec
|
||||||
|
validateGameDateSpec
|
||||||
|
|
||||||
startNewSeasonSpec :: Spec
|
startNewSeasonSpec :: Spec
|
||||||
startNewSeasonSpec = describe "startNewSeason" $ do
|
startNewSeasonSpec = describe "startNewSeason" $ do
|
||||||
|
@ -269,6 +270,51 @@ updateGameStatsSpec = describe "updateGameStats" $ do
|
||||||
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
|
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
|
||||||
in updateGameStats s' `shouldBe` s'
|
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 :: IO Player
|
||||||
makePlayer = Player
|
makePlayer = Player
|
||||||
<$> makeNum
|
<$> makeNum
|
||||||
|
|
Loading…
Reference in New Issue
Block a user