slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: For ymd date parsing, don't consume invalid date components.

Browse Source
This commit is contained in:
Stephen Morgan 2020-10-07 13:45:46 +11:00 committed by Simon Michael
parent 97545018f4
commit 5a6d38fdf2
1 changed files with 25 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
hledger-lib/Hledger/Data/Dates.hs
View File

@ -1,9 +1,10 @@
{-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PackageImports #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-| {-|
Date parsing and utilities for hledger. Date parsing and utilities for hledger.
@ -777,10 +778,17 @@ yyyymmdd = do
failIfInvalidDate date failIfInvalidDate date
ymd :: TextParser m SmartDate ymd :: TextParser m SmartDate
ymd = liftA2 SmartAssumeStart yearp (optional $ try monthday) >>= failIfInvalidDate ymd = do
where monthday = do y <- yearp
sep <- datesepchar fmap (SmartAssumeStart y) . optional . try $ do
liftA2 (,) decimal . optional $ char sep *> decimal sep <- datesepchar
m <- decimal
unless (validMonth m) $ Fail.fail ("Bad month " <> show m)
fmap (m,) . optional . try $ do
_ <- char sep
d <- decimal
failIfInvalidDate $ SmartAssumeStart y (Just (m, Just d))
return d
md :: TextParser m (Month, MonthDay) md :: TextParser m (Month, MonthDay)
md = do md = do
@ -943,6 +951,14 @@ periodexprdatespanp rdate = choice $ map try [
-- | -- |
-- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "20180101-201804" -- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "20180101-201804"
-- Right DateSpan 2018Q1 -- Right DateSpan 2018Q1
-- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "2017..2018"
-- Right DateSpan 2017
-- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "2017-2018"
-- Right DateSpan 2017
-- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "2017-01-2018"
-- Right DateSpan 2017
-- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "2017-01-01-2018"
-- Right DateSpan 2017
doubledatespanp :: Day -> TextParser m DateSpan doubledatespanp :: Day -> TextParser m DateSpan
doubledatespanp rdate = liftA2 fromToSpan doubledatespanp rdate = liftA2 fromToSpan
(optional (string' "from" *> skipNonNewlineSpaces) *> smartdate) (optional (string' "from" *> skipNonNewlineSpaces) *> smartdate)