lib: refactor date-time parser, add error messages
- also removed commented-out time-zone code
This commit is contained in:
parent
bc9375e4e5
commit
89b1fd7de3
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user