fix: fix invalid generation of TimeOfDay

Author: drlkf

src/Text/Megaparsec/Time.hs

@@ -23,19 +23,21 @@ module Text.Megaparsec.Time
   ) where
 
 import           Control.Applicative       (optional, (<|>))
-import           Control.Monad             (replicateM, void)
+import           Control.Monad             (replicateM)
 import           Control.Monad.Combinators (choice, some)
 import           Data.Char                 (toLower)
 import           Data.Functor              (($>))
 import           Data.Maybe                (fromMaybe)
 import           Data.Time                 (Day, DayOfWeek (..),
                                             NominalDiffTime, TimeOfDay (..),
-                                            defaultTimeLocale, parseTimeM,
+                                            defaultTimeLocale,
+                                            makeTimeOfDayValid, parseTimeM,
                                             secondsToNominalDiffTime)
 import           Text.Megaparsec           (Parsec, takeRest, try)
 import           Text.Megaparsec.Char      (char, digitChar, space, space1,
                                             string')
 import           Text.Megaparsec.Utils     (posNumParser)
+import           Text.Printf               (printf)
 
 -- | Representation of a parser result with either a number of days relative to
 -- the current day, or a 'DayOfWeek'.
@@ -125,7 +127,10 @@ timeParser = do
   h <- read <$> replicateM 2 digitChar <* char ':'
   m <- read <$> replicateM 2 digitChar
 
-  return $ TimeOfDay h m 0
+  maybe
+    (fail (printf "invalid hours or minutes %02d:%02d" h m))
+    pure
+    (makeTimeOfDayValid h m 0)
 
 -- | Zero seconds in 'NominalDiffTime'.
 zero :: NominalDiffTime

test/Text/Megaparsec/TimeSpec.hs

@@ -171,6 +171,12 @@ spec = do
         Right d
 
   describe "time" $ do
+    it "invalid hours" . forAll (arbitrary `suchThat` (\h -> h > 23 && h < 100)) $ \h ->
+      parseOrPrettyError timeParser (printf "%02d:00" (h :: Int)) `shouldSatisfy` isLeft
+
+    it "invalid hours" . forAll (arbitrary `suchThat` (\m -> m > 59 && m < 100)) $ \m ->
+      parseOrPrettyError timeParser (printf "00:%02d" (m :: Int)) `shouldSatisfy` isLeft
+
     it "valid" . property $ \t ->
       parseOrPrettyError timeParser (formatTime defaultTimeLocale "%R" t) `shouldBe`
       Right t