lib: datep now requires years to be at least four digits.
This commit is contained in:
parent
ffb5cf0773
commit
dc41cee2b0
@ -447,15 +447,15 @@ datep = do
|
|||||||
datep' :: Maybe Year -> TextParser m Day
|
datep' :: Maybe Year -> TextParser m Day
|
||||||
datep' mYear = do
|
datep' mYear = do
|
||||||
startOffset <- getOffset
|
startOffset <- getOffset
|
||||||
d1 <- decimal <?> "year or month"
|
d1 <- yearorintp <?> "year or month"
|
||||||
sep <- satisfy isDateSepChar <?> "date separator"
|
sep <- datesepchar <?> "date separator"
|
||||||
d2 <- decimal <?> "month or day"
|
d2 <- decimal <?> "month or day"
|
||||||
fullDate startOffset d1 sep d2 <|> partialDate startOffset mYear d1 sep d2
|
case d1 of
|
||||||
|
Left y -> fullDate startOffset y sep d2
|
||||||
|
Right m -> partialDate startOffset mYear m sep d2
|
||||||
<?> "full or partial date"
|
<?> "full or partial date"
|
||||||
|
|
||||||
where
|
where
|
||||||
|
fullDate :: Int -> Year -> Char -> Month -> TextParser m Day
|
||||||
fullDate :: Int -> Integer -> Char -> Int -> TextParser m Day
|
|
||||||
fullDate startOffset year sep1 month = do
|
fullDate startOffset year sep1 month = do
|
||||||
sep2 <- satisfy isDateSepChar <?> "date separator"
|
sep2 <- satisfy isDateSepChar <?> "date separator"
|
||||||
day <- decimal <?> "day"
|
day <- decimal <?> "day"
|
||||||
@ -470,13 +470,12 @@ datep' mYear = do
|
|||||||
"well-formed but invalid date: " ++ dateStr
|
"well-formed but invalid date: " ++ dateStr
|
||||||
Just date -> pure $! date
|
Just date -> pure $! date
|
||||||
|
|
||||||
partialDate
|
partialDate :: Int -> Maybe Year -> Month -> Char -> MonthDay -> TextParser m Day
|
||||||
:: Int -> Maybe Year -> Integer -> Char -> Int -> TextParser m Day
|
|
||||||
partialDate startOffset mYear month sep day = do
|
partialDate startOffset mYear month sep day = do
|
||||||
endOffset <- getOffset
|
endOffset <- getOffset
|
||||||
case mYear of
|
case mYear of
|
||||||
Just year ->
|
Just year ->
|
||||||
case fromGregorianValid year (fromIntegral month) day of
|
case fromGregorianValid year month day of
|
||||||
Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $
|
Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $
|
||||||
"well-formed but invalid date: " ++ dateStr
|
"well-formed but invalid date: " ++ dateStr
|
||||||
Just date -> pure $! date
|
Just date -> pure $! date
|
||||||
@ -551,6 +550,14 @@ secondarydatep :: Day -> TextParser m Day
|
|||||||
secondarydatep primaryDate = char '=' *> datep' (Just primaryYear)
|
secondarydatep primaryDate = char '=' *> datep' (Just primaryYear)
|
||||||
where primaryYear = first3 $ toGregorian primaryDate
|
where primaryYear = first3 $ toGregorian primaryDate
|
||||||
|
|
||||||
|
-- | Parse a year number or an Int. Years must contain at least four
|
||||||
|
-- digits.
|
||||||
|
yearorintp :: TextParser m (Either Year Int)
|
||||||
|
yearorintp = do
|
||||||
|
yearOrMonth <- takeWhile1P (Just "digit") isDigit
|
||||||
|
let n = readDecimal yearOrMonth
|
||||||
|
return $ if T.length yearOrMonth >= 4 then Left n else Right (fromInteger n)
|
||||||
|
|
||||||
--- *** account names
|
--- *** account names
|
||||||
|
|
||||||
-- | Parse an account name (plus one following space if present),
|
-- | Parse an account name (plus one following space if present),
|
||||||
|
|||||||
@ -50,5 +50,5 @@ end comment
|
|||||||
2000/1/2
|
2000/1/2
|
||||||
b 0 ; [1/1=1/2/3/4] bad second date, should error
|
b 0 ; [1/1=1/2/3/4] bad second date, should error
|
||||||
|
|
||||||
>>>2 /9:23/
|
>>>2 /-:9:21/
|
||||||
>>>=1
|
>>>=1
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user