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

imp: smartdates: Simplify and generalise the SmartDate constructor and

Browse Source 
parsers to allow for arbitrary numbers of periods in relative dates.

We now accept smart dates like “in 5 days, 5 weeks ahead, in -6 months, 2 quarters ago”.
This commit is contained in:
Stephen Morgan 2021-12-20 14:36:33 +01:00 committed by Simon Michael
parent 5c9436a3ed
commit f13ac2812f
4 changed files with 48 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -12,7 +12,8 @@ Date parsing and utilities for hledger.
For date and time values, we use the standard Day and UTCTime types. For date and time values, we use the standard Day and UTCTime types.
A 'SmartDate' is a date which may be partially-specified or relative. A 'SmartDate' is a date which may be partially-specified or relative.
Eg 2008\/12\/31, but also 2008\/12, 12\/31, tomorrow, last week, next year. Eg 2008\/12\/31, but also 2008\/12, 12\/31, tomorrow, last week, next year,
in 5 days, in -3 quarters.
We represent these as a triple of strings like (\"2008\",\"12\",\"\"), We represent these as a triple of strings like (\"2008\",\"12\",\"\"),
(\"\",\"\",\"tomorrow\"), (\"\",\"last\",\"week\"). (\"\",\"\",\"tomorrow\"), (\"\",\"last\",\"week\").
@ -104,7 +105,7 @@ import Data.Time.LocalTime (getZonedTime, localDay, zonedTimeToLocalTime)
import Safe (headMay, lastMay, maximumMay, minimumMay) import Safe (headMay, lastMay, maximumMay, minimumMay)
import Text.Megaparsec import Text.Megaparsec
import Text.Megaparsec.Char (char, char', digitChar, string, string') import Text.Megaparsec.Char (char, char', digitChar, string, string')
import Text.Megaparsec.Char.Lexer (decimal) import Text.Megaparsec.Char.Lexer (decimal, signed)
import Text.Megaparsec.Custom (customErrorBundlePretty) import Text.Megaparsec.Custom (customErrorBundlePretty)
import Text.Printf (printf) import Text.Printf (printf)
@ -396,21 +397,11 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
(ry,rm,_) = toGregorian refdate (ry,rm,_) = toGregorian refdate
(b,e) = span sdate (b,e) = span sdate
span :: SmartDate -> (Day,Day) span :: SmartDate -> (Day,Day)
span (SmartRelative This Day) = (refdate, nextday refdate) span (SmartRelative n Day) = (addDays n refdate, addDays (n+1) refdate)
span (SmartRelative Last Day) = (prevday refdate, refdate) span (SmartRelative n Week) = let d = thisweek refdate in (addDays (7*n) d, addDays (7*n+7) d)
span (SmartRelative Next Day) = (nextday refdate, addDays 2 refdate) span (SmartRelative n Month) = let d = thismonth refdate in (addGregorianMonthsClip n d, addGregorianMonthsClip (n+1) d)
span (SmartRelative This Week) = (thisweek refdate, nextweek refdate) span (SmartRelative n Quarter) = let d = thisquarter refdate in (addGregorianMonthsClip (3*n) d, addGregorianMonthsClip (3*n+3) d)
span (SmartRelative Last Week) = (prevweek refdate, thisweek refdate) span (SmartRelative n Year) = let d = thisyear refdate in (addGregorianYearsClip n d, addGregorianYearsClip (n+1) d)
span (SmartRelative Next Week) = (nextweek refdate, startofweek $ addDays 14 refdate)
span (SmartRelative This Month) = (thismonth refdate, nextmonth refdate)
span (SmartRelative Last Month) = (prevmonth refdate, thismonth refdate)
span (SmartRelative Next Month) = (nextmonth refdate, startofmonth $ addGregorianMonthsClip 2 refdate)
span (SmartRelative This Quarter) = (thisquarter refdate, nextquarter refdate)
span (SmartRelative Last Quarter) = (prevquarter refdate, thisquarter refdate)
span (SmartRelative Next Quarter) = (nextquarter refdate, startofquarter $ addGregorianMonthsClip 6 refdate)
span (SmartRelative This Year) = (thisyear refdate, nextyear refdate)
span (SmartRelative Last Year) = (prevyear refdate, thisyear refdate)
span (SmartRelative Next Year) = (nextyear refdate, startofyear $ addGregorianYearsClip 2 refdate)
span (SmartAssumeStart y Nothing) = (startofyear day, nextyear day) where day = fromGregorian y 1 1 span (SmartAssumeStart y Nothing) = (startofyear day, nextyear day) where day = fromGregorian y 1 1
span (SmartAssumeStart y (Just (m, Nothing))) = (startofmonth day, nextmonth day) where day = fromGregorian y m 1 span (SmartAssumeStart y (Just (m, Nothing))) = (startofmonth day, nextmonth day) where day = fromGregorian y m 1
span (SmartAssumeStart y (Just (m, Just d))) = (day, nextday day) where day = fromGregorian y m d span (SmartAssumeStart y (Just (m, Just d))) = (day, nextday day) where day = fromGregorian y m d
@ -510,28 +501,28 @@ fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
-- t "next january" -- t "next january"
-- "2009-01-01" -- "2009-01-01"
-- --
-- >>> t "in 5 days"
-- "2008-12-01"
-- >>> t "in 7 months"
-- "2009-06-01"
-- >>> t "in -2 weeks"
-- "2008-11-10"
-- >>> t "1 quarter ago"
-- "2008-07-01"
-- >>> t "1 week ahead"
-- "2008-12-01"
fixSmartDate :: Day -> SmartDate -> Day fixSmartDate :: Day -> SmartDate -> Day
fixSmartDate refdate = fix fixSmartDate refdate = fix
where where
fix :: SmartDate -> Day fix :: SmartDate -> Day
fix (SmartRelative This Day) = refdate fix (SmartRelative n Day) = addDays n refdate
fix (SmartRelative Last Day) = prevday refdate fix (SmartRelative n Week) = addDays (7*n) $ thisweek refdate
fix (SmartRelative Next Day) = nextday refdate fix (SmartRelative n Month) = addGregorianMonthsClip n $ thismonth refdate
fix (SmartRelative This Week) = thisweek refdate fix (SmartRelative n Quarter) = addGregorianMonthsClip (3*n) $ thisquarter refdate
fix (SmartRelative Last Week) = prevweek refdate fix (SmartRelative n Year) = addGregorianYearsClip n $ thisyear refdate
fix (SmartRelative Next Week) = nextweek refdate fix (SmartAssumeStart y md) = fromGregorian y (maybe 1 fst md) (fromMaybe 1 $ snd =<< md)
fix (SmartRelative This Month) = thismonth refdate fix (SmartFromReference m d) = fromGregorian ry (fromMaybe rm m) d
fix (SmartRelative Last Month) = prevmonth refdate fix (SmartMonth m) = fromGregorian ry m 1
fix (SmartRelative Next Month) = nextmonth refdate
fix (SmartRelative This Quarter) = thisquarter refdate
fix (SmartRelative Last Quarter) = prevquarter refdate
fix (SmartRelative Next Quarter) = nextquarter refdate
fix (SmartRelative This Year) = thisyear refdate
fix (SmartRelative Last Year) = prevyear refdate
fix (SmartRelative Next Year) = nextyear refdate
fix (SmartAssumeStart y md) = fromGregorian y (maybe 1 fst md) (fromMaybe 1 $ snd =<< md)
fix (SmartFromReference m d) = fromGregorian ry (fromMaybe rm m) d
fix (SmartMonth m) = fromGregorian ry m 1
(ry, rm, _) = toGregorian refdate (ry, rm, _) = toGregorian refdate
prevday :: Day -> Day prevday :: Day -> Day
@ -554,7 +545,6 @@ startofmonth day = fromGregorian y m 1 where (y,m,_) = toGregorian day
nthdayofmonth d day = fromGregorian y m d where (y,m,_) = toGregorian day nthdayofmonth d day = fromGregorian y m d where (y,m,_) = toGregorian day
thisquarter = startofquarter thisquarter = startofquarter
prevquarter = startofquarter . addGregorianMonthsClip (-3)
nextquarter = startofquarter . addGregorianMonthsClip 3 nextquarter = startofquarter . addGregorianMonthsClip 3
startofquarter day = fromGregorian y (firstmonthofquarter m) 1 startofquarter day = fromGregorian y (firstmonthofquarter m) 1
where where
@ -726,6 +716,8 @@ Examples:
> october, oct (start of month in current year) > october, oct (start of month in current year)
> yesterday, today, tomorrow (-1, 0, 1 days from today) > yesterday, today, tomorrow (-1, 0, 1 days from today)
> last/this/next day/week/month/quarter/year (-1, 0, 1 periods from the current period) > last/this/next day/week/month/quarter/year (-1, 0, 1 periods from the current period)
> in n days/weeks/months/quarters/years (n periods from the current period)
> n days/weeks/months/quarters/years ago (-n periods from the current period)
> 20181201 (8 digit YYYYMMDD with valid year month and day) > 20181201 (8 digit YYYYMMDD with valid year month and day)
> 201812 (6 digit YYYYMM with valid year and month) > 201812 (6 digit YYYYMM with valid year and month)
@ -763,19 +755,26 @@ Right (SmartAssumeStart 201813012 Nothing)
smartdate :: TextParser m SmartDate smartdate :: TextParser m SmartDate
smartdate = choice' smartdate = choice'
-- XXX maybe obscures date errors ? see ledgerdate -- XXX maybe obscures date errors ? see ledgerdate
[ yyyymmdd, ymd [ relativeP
, yyyymmdd, ymd
, (\(m,d) -> SmartFromReference (Just m) d) <$> md , (\(m,d) -> SmartFromReference (Just m) d) <$> md
, failIfInvalidDate . SmartFromReference Nothing =<< decimal , failIfInvalidDate . SmartFromReference Nothing =<< decimal
, SmartMonth <$> (month <|> mon) , SmartMonth <$> (month <|> mon)
, SmartRelative This Day <$ string' "today" , SmartRelative 0 Day <$ string' "today"
, SmartRelative Last Day <$ string' "yesterday" , SmartRelative (-1) Day <$ string' "yesterday"
, SmartRelative Next Day <$ string' "tomorrow" , SmartRelative 1 Day <$ string' "tomorrow"
, liftA2 SmartRelative (seqP <* skipNonNewlineSpaces) intervalP
] ]
where where
seqP = choice [This <$ string' "this", Last <$ string' "last", Next <$ string' "next"] relativeP = do
intervalP = choice [Day <$ string' "day", Week <$ string' "week", Month <$ string' "month", optional $ string' "in" <* skipNonNewlineSpaces
Quarter <$ string' "quarter", Year <$ string' "year"] num <- seqP <* skipNonNewlineSpaces
interval <- intervalP <* skipNonNewlineSpaces
sign <- choice [negate <$ string' "ago", id <$ string' "ahead", pure id]
return $ SmartRelative (sign num) interval
seqP = choice [ 0 <$ string' "this", -1 <$ string' "last", 1 <$ string' "next", signed skipNonNewlineSpaces decimal ]
intervalP = choice [ Day <$ string' "day", Week <$ string' "week", Month <$ string' "month"
, Quarter <$ string' "quarter", Year <$ string' "year" ] <* optional (char' 's')
-- | Like smartdate, but there must be nothing other than whitespace after the date. -- | Like smartdate, but there must be nothing other than whitespace after the date.
smartdateonly :: TextParser m SmartDate smartdateonly :: TextParser m SmartDate

2
hledger-lib/Hledger/Data/PeriodicTransaction.hs
View File

@ -263,7 +263,7 @@ checkPeriodicTransactionStartDate i s periodexpr =
_ -> Nothing _ -> Nothing
where where
checkStart d x = checkStart d x =
let firstDate = fixSmartDate d $ SmartRelative This x let firstDate = fixSmartDate d $ SmartRelative 0 x
in in
if d == firstDate if d == firstDate
then Nothing then Nothing

3
hledger-lib/Hledger/Data/Types.hs
View File

@ -84,10 +84,9 @@ data SmartDate
= SmartAssumeStart Year (Maybe (Month, Maybe MonthDay)) = SmartAssumeStart Year (Maybe (Month, Maybe MonthDay))
| SmartFromReference (Maybe Month) MonthDay | SmartFromReference (Maybe Month) MonthDay
| SmartMonth Month | SmartMonth Month
| SmartRelative SmartSequence SmartInterval | SmartRelative Integer SmartInterval
deriving (Show) deriving (Show)
data SmartSequence = Last | This | Next deriving (Show)
data SmartInterval = Day | Week | Month | Quarter | Year deriving (Show) data SmartInterval = Day | Week | Month | Quarter | Year deriving (Show)
data WhichDate = PrimaryDate | SecondaryDate deriving (Eq,Show) data WhichDate = PrimaryDate | SecondaryDate deriving (Eq,Show)

3
hledger/hledger.m4.md
View File

@ -461,6 +461,9 @@ Examples:
| `october, oct` | start of month in current year | | `october, oct` | start of month in current year |
| `yesterday, today, tomorrow` | -1, 0, 1 days from today | | `yesterday, today, tomorrow` | -1, 0, 1 days from today |
| `last/this/next day/week/month/quarter/year` | -1, 0, 1 periods from the current period | | `last/this/next day/week/month/quarter/year` | -1, 0, 1 periods from the current period |
| `in n days/weeks/months/quarters/years` | n periods from the current period |
| `n days/weeks/months/quarters/years ahead` | n periods from the current period |
| `n days/weeks/months/quarters/years ago` | -n periods from the current period |
| `20181201` | 8 digit YYYYMMDD with valid year month and day | | `20181201` | 8 digit YYYYMMDD with valid year month and day |
| `201812` | 6 digit YYYYMM with valid year and month | | `201812` | 6 digit YYYYMM with valid year and month |