lib: refine date parser error messages

This commit is contained in:
Alex Chen 2018-06-06 11:15:38 -06:00
parent 132f8706d7
commit 39e7ef0311
3 changed files with 24 additions and 17 deletions

View File

@ -352,36 +352,43 @@ datep = do
datep' :: Maybe Year -> TextParser m Day
datep' mYear = do
startPos <- getPosition
d1 <- decimal <?> "year or month"
sep <- satisfy isDateSepChar <?> "date separator"
d2 <- decimal <?> "month or day"
fullDate d1 sep d2 <|> partialDate mYear d1 sep d2
fullDate startPos d1 sep d2 <|> partialDate startPos mYear d1 sep d2
<?> "full or partial date"
where
fullDate :: Integer -> Char -> Int -> TextParser m Day
fullDate year sep1 month = do
fullDate :: SourcePos -> Integer -> Char -> Int -> TextParser m Day
fullDate startPos year sep1 month = do
sep2 <- satisfy isDateSepChar <?> "date separator"
day <- decimal <?> "day"
endPos <- getPosition
let dateStr = show year ++ [sep1] ++ show month ++ [sep2] ++ show day
when (sep1 /= sep2) $ fail $
when (sep1 /= sep2) $ parseErrorAtRegion startPos endPos $
"invalid date (mixing date separators is not allowed): " ++ dateStr
case fromGregorianValid year month day of
Nothing -> fail $ "well-formed but invalid date: " ++ dateStr
Nothing -> parseErrorAtRegion startPos endPos $
"well-formed but invalid date: " ++ dateStr
Just date -> pure $! date
partialDate :: Maybe Year -> Integer -> Char -> Int -> TextParser m Day
partialDate mYear month sep day = case mYear of
partialDate
:: SourcePos -> Maybe Year -> Integer -> Char -> Int -> TextParser m Day
partialDate startPos mYear month sep day = do
endPos <- getPosition
case mYear of
Just year ->
case fromGregorianValid year (fromIntegral month) day of
Nothing -> fail $ "well-formed but invalid date: " ++ dateStr
Nothing -> parseErrorAtRegion startPos endPos $
"well-formed but invalid date: " ++ dateStr
Just date -> pure $! date
where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day
Nothing -> fail $
Nothing -> parseErrorAtRegion startPos endPos $
"partial date "++dateStr++" found, but the current year is unknown"
where dateStr = show month ++ [sep] ++ show day

View File

@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: fbcc49317255a91cf8d9795d99203ce5e9930e4981b2fc246349a6ea8d23af74
-- hash: 86a93717a2fa0b215398b09da43e823e40cbf65bdd62a40ef0473549b2d5900c
name: hledger-lib
version: 1.9.99

View File

@ -23,7 +23,7 @@ end comment
b 0
; date: 3.32
>>>2 /10:19/
>>>2 /10:16/
>>>=1
# 3. Ledger's bracketed date syntax is also supported: `[DATE]`,