lib: refine date parser error messages
This commit is contained in:
parent
132f8706d7
commit
39e7ef0311
@ -352,36 +352,43 @@ datep = do
|
|||||||
|
|
||||||
datep' :: Maybe Year -> TextParser m Day
|
datep' :: Maybe Year -> TextParser m Day
|
||||||
datep' mYear = do
|
datep' mYear = do
|
||||||
|
startPos <- getPosition
|
||||||
d1 <- decimal <?> "year or month"
|
d1 <- decimal <?> "year or month"
|
||||||
sep <- satisfy isDateSepChar <?> "date separator"
|
sep <- satisfy isDateSepChar <?> "date separator"
|
||||||
d2 <- decimal <?> "month or day"
|
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"
|
<?> "full or partial date"
|
||||||
|
|
||||||
where
|
where
|
||||||
|
|
||||||
fullDate :: Integer -> Char -> Int -> TextParser m Day
|
fullDate :: SourcePos -> Integer -> Char -> Int -> TextParser m Day
|
||||||
fullDate year sep1 month = do
|
fullDate startPos year sep1 month = do
|
||||||
sep2 <- satisfy isDateSepChar <?> "date separator"
|
sep2 <- satisfy isDateSepChar <?> "date separator"
|
||||||
day <- decimal <?> "day"
|
day <- decimal <?> "day"
|
||||||
|
endPos <- getPosition
|
||||||
let dateStr = show year ++ [sep1] ++ show month ++ [sep2] ++ show day
|
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
|
"invalid date (mixing date separators is not allowed): " ++ dateStr
|
||||||
|
|
||||||
case fromGregorianValid year month day of
|
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
|
Just date -> pure $! date
|
||||||
|
|
||||||
partialDate :: Maybe Year -> Integer -> Char -> Int -> TextParser m Day
|
partialDate
|
||||||
partialDate mYear month sep day = case mYear of
|
:: SourcePos -> Maybe Year -> Integer -> Char -> Int -> TextParser m Day
|
||||||
|
partialDate startPos mYear month sep day = do
|
||||||
|
endPos <- getPosition
|
||||||
|
case mYear of
|
||||||
Just year ->
|
Just year ->
|
||||||
case fromGregorianValid year (fromIntegral month) day of
|
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
|
Just date -> pure $! date
|
||||||
where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day
|
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"
|
"partial date "++dateStr++" found, but the current year is unknown"
|
||||||
where dateStr = show month ++ [sep] ++ show day
|
where dateStr = show month ++ [sep] ++ show day
|
||||||
|
|
||||||
|
|||||||
@ -2,7 +2,7 @@
|
|||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: fbcc49317255a91cf8d9795d99203ce5e9930e4981b2fc246349a6ea8d23af74
|
-- hash: 86a93717a2fa0b215398b09da43e823e40cbf65bdd62a40ef0473549b2d5900c
|
||||||
|
|
||||||
name: hledger-lib
|
name: hledger-lib
|
||||||
version: 1.9.99
|
version: 1.9.99
|
||||||
|
|||||||
@ -23,7 +23,7 @@ end comment
|
|||||||
b 0
|
b 0
|
||||||
; date: 3.32
|
; date: 3.32
|
||||||
|
|
||||||
>>>2 /10:19/
|
>>>2 /10:16/
|
||||||
>>>=1
|
>>>=1
|
||||||
|
|
||||||
# 3. Ledger's bracketed date syntax is also supported: `[DATE]`,
|
# 3. Ledger's bracketed date syntax is also supported: `[DATE]`,
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user