lib: refactor date-time parser, add error messages

- also removed commented-out time-zone code

hledger-lib/Hledger/Read/Common.hs

@@ -399,31 +399,55 @@ datep' mYear = do
 -- Leading zeroes may be omitted (except in a timezone).
 datetimep :: JournalParser m LocalTime
 datetimep = do
-  day <- datep
+  mYear <- getYear
-  lift $ skipSome spacenonewline
+  lift $ datetimep' mYear
-  h <- some digitChar
+
-  let h' = read h
+datetimep' :: Maybe Year -> TextParser m LocalTime
-  guard $ h' >= 0 && h' <= 23
+datetimep' mYear = do
-  char ':'
+  day <- datep' mYear
-  m <- some digitChar
+  skipSome spacenonewline
-  let m' = read m
+  time <- timeOfDay
-  guard $ m' >= 0 && m' <= 59
+  optional timeZone -- ignoring time zones
-  s <- optional $ char ':' >> some digitChar
+  pure $ LocalTime day time
-  let s' = case s of Just sstr -> read sstr
+
-                     Nothing   -> 0
+  where
-  guard $ s' >= 0 && s' <= 59
+    timeOfDay :: TextParser m TimeOfDay
-  {- tz <- -}
+    timeOfDay = do
-  optional $ do
+      pos1 <- getPosition
-                   plusminus <- oneOf ("-+" :: [Char])
+      h' <- twoDigitDecimal <?> "hour"
-                   d1 <- digitChar
+      pos2 <- getPosition
-                   d2 <- digitChar
+      unless (h' >= 0 && h' <= 23) $ parseErrorAtRegion pos1 pos2
-                   d3 <- digitChar
+        "invalid time (bad hour)"
-                   d4 <- digitChar
+
-                   return $ plusminus:d1:d2:d3:d4:""
+      char ':' <?> "':' (hour-minute separator)"
-  -- ltz <- liftIO $ getCurrentTimeZone
+      pos3 <- getPosition
-  -- let tz' = maybe ltz (fromMaybe ltz . parseTime defaultTimeLocale "%z") tz
+      m' <- twoDigitDecimal <?> "minute"
-  -- return $ localTimeToUTC tz' $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
+      pos4 <- getPosition
-  return $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
+      unless (m' >= 0 && m' <= 59) $ parseErrorAtRegion pos3 pos4
+        "invalid time (bad minute)"
+
+      s' <- option 0 $ do
+        char ':' <?> "':' (minute-second separator)"
+        pos5 <- getPosition
+        s' <- twoDigitDecimal <?> "second"
+        pos6 <- getPosition
+        unless (s' >= 0 && s' <= 59) $ parseErrorAtRegion pos5 pos6
+          "invalid time (bad second)" -- we do not support leap seconds
+        pure s'
+
+      pure $ TimeOfDay h' m' (fromIntegral s')
+
+    twoDigitDecimal :: TextParser m Int
+    twoDigitDecimal = do
+      d1 <- digitToInt <$> digitChar
+      d2 <- digitToInt <$> (digitChar <?> "a second digit")
+      pure $ d1*10 + d2
+
+    timeZone :: TextParser m String
+    timeZone = do
+      plusminus <- satisfy $ \c -> c == '-' || c == '+'
+      fourDigits <- count 4 (digitChar <?> "a digit (for a time zone)")
+      pure $ plusminus:fourDigits
 
 secondarydatep :: Day -> TextParser m Day
 secondarydatep primaryDate = char '=' *> datep' (Just primaryYear)