From 89b1fd7de31b8befcedea4efce4268459853053e Mon Sep 17 00:00:00 2001
From: Alex Chen <awchen@ucalgary.ca>
Date: Fri, 15 Jun 2018 12:56:38 -0600
Subject: [PATCH] lib: refactor date-time parser, add error messages

- also removed commented-out time-zone code
---
 hledger-lib/Hledger/Read/Common.hs | 74 ++++++++++++++++++++----------
 1 file changed, 49 insertions(+), 25 deletions(-)

diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs
index bcac13127..9611f4cc5 100644
--- a/hledger-lib/Hledger/Read/Common.hs
+++ b/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
-  lift $ skipSome spacenonewline
-  h <- some digitChar
-  let h' = read h
-  guard $ h' >= 0 && h' <= 23
-  char ':'
-  m <- some digitChar
-  let m' = read m
-  guard $ m' >= 0 && m' <= 59
-  s <- optional $ char ':' >> some digitChar
-  let s' = case s of Just sstr -> read sstr
-                     Nothing   -> 0
-  guard $ s' >= 0 && s' <= 59
-  {- tz <- -}
-  optional $ do
-                   plusminus <- oneOf ("-+" :: [Char])
-                   d1 <- digitChar
-                   d2 <- digitChar
-                   d3 <- digitChar
-                   d4 <- digitChar
-                   return $ plusminus:d1:d2:d3:d4:""
-  -- ltz <- liftIO $ getCurrentTimeZone
-  -- let tz' = maybe ltz (fromMaybe ltz . parseTime defaultTimeLocale "%z") tz
-  -- return $ localTimeToUTC tz' $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
-  return $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
+  mYear <- getYear
+  lift $ datetimep' mYear
+
+datetimep' :: Maybe Year -> TextParser m LocalTime
+datetimep' mYear = do
+  day <- datep' mYear
+  skipSome spacenonewline
+  time <- timeOfDay
+  optional timeZone -- ignoring time zones
+  pure $ LocalTime day time
+
+  where
+    timeOfDay :: TextParser m TimeOfDay
+    timeOfDay = do
+      pos1 <- getPosition
+      h' <- twoDigitDecimal <?> "hour"
+      pos2 <- getPosition
+      unless (h' >= 0 && h' <= 23) $ parseErrorAtRegion pos1 pos2
+        "invalid time (bad hour)"
+
+      char ':' <?> "':' (hour-minute separator)"
+      pos3 <- getPosition
+      m' <- twoDigitDecimal <?> "minute"
+      pos4 <- getPosition
+      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)