From f1b4618f2da26e8e89db50a769a24123c85bc513 Mon Sep 17 00:00:00 2001 From: Dmitry Astapov Date: Fri, 24 Nov 2017 22:43:53 +0000 Subject: [PATCH] lib: support "every 11th Nov" in period expressions Useful for periodic transactions Without it, once-per-year periodic transactions always occur on 1st Jan. --- hledger-lib/Hledger/Data/AutoTransaction.hs | 13 ++- hledger-lib/Hledger/Data/Dates.hs | 93 +++++++++++++++++---- hledger-lib/Hledger/Data/Types.hs | 1 + 3 files changed, 88 insertions(+), 19 deletions(-) diff --git a/hledger-lib/Hledger/Data/AutoTransaction.hs b/hledger-lib/Hledger/Data/AutoTransaction.hs index d9ed91280..4cc903005 100644 --- a/hledger-lib/Hledger/Data/AutoTransaction.hs +++ b/hledger-lib/Hledger/Data/AutoTransaction.hs @@ -136,7 +136,8 @@ renderPostingCommentDates p = p { pcomment = comment' } -- -- Note that new transactions require 'txnTieKnot' post-processing. -- --- >>> mapM_ (putStr . show) $ runPeriodicTransaction (PeriodicTransaction "monthly from 2017/1 to 2017/4" ["hi" `post` usd 1]) nulldatespan +-- >>> let gen str = mapM_ (putStr . show) $ runPeriodicTransaction (PeriodicTransaction str ["hi" `post` usd 1]) nulldatespan +-- >>> gen "monthly from 2017/1 to 2017/4" -- 2017/01/01 -- hi $1.00 -- @@ -146,6 +147,16 @@ renderPostingCommentDates p = p { pcomment = comment' } -- 2017/03/01 -- hi $1.00 -- +-- >>> gen "every Nov 29th from 2017 to 2019" +-- 2016/11/29 +-- hi $1.00 +-- +-- 2017/11/29 +-- hi $1.00 +-- +-- 2018/11/29 +-- hi $1.00 +-- runPeriodicTransaction :: PeriodicTransaction -> (DateSpan -> [Transaction]) runPeriodicTransaction pt = generate where base = nulltransaction { tpostings = ptpostings pt } diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index c454afd28..517ed15b8 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -88,6 +88,7 @@ import Data.Time.Clock import Data.Time.LocalTime import Safe (headMay, lastMay, readMay) import Text.Megaparsec.Compat +import Text.Megaparsec.Perm import Text.Printf import Hledger.Data.Types @@ -168,6 +169,10 @@ spansSpan spans = DateSpan (maybe Nothing spanStart $ headMay spans) (maybe Noth -- [DateSpan 2007/12/02-2008/01/01,DateSpan 2008/01/02-2008/02/01,DateSpan 2008/02/02-2008/03/01,DateSpan 2008/03/02-2008/04/01] -- >>> t (DayOfWeek 2) "2011/01/01" "2011/01/15" -- [DateSpan 2010/12/28-2011/01/03,DateSpan 2011/01/04-2011/01/10,DateSpan 2011/01/11-2011/01/17] +-- >>> t (DayOfYear 11 29) "2011/10/01" "2011/10/15" +-- [DateSpan 2010/11/29-2011/11/28] +-- >>> t (DayOfYear 11 29) "2011/12/01" "2012/12/15" +-- [DateSpan 2011/11/29-2012/11/28,DateSpan 2012/11/29-2013/11/28] -- splitSpan :: Interval -> DateSpan -> [DateSpan] splitSpan _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing] @@ -179,6 +184,7 @@ splitSpan (Quarters n) s = splitspan startofquarter (applyN n nextquarter) s splitSpan (Years n) s = splitspan startofyear (applyN n nextyear) s splitSpan (DayOfMonth n) s = splitspan (nthdayofmonthcontaining n) (applyN (n-1) nextday . nextmonth) s splitSpan (DayOfWeek n) s = splitspan (nthdayofweekcontaining n) (applyN (n-1) nextday . nextweek) s +splitSpan (DayOfYear m n) s= splitspan (nthdayofyearcontaining m n) (applyN (n-1) nextday . applyN (m-1) nextmonth . nextyear) s -- splitSpan (WeekOfYear n) s = splitspan startofweek (applyN n nextweek) s -- splitSpan (MonthOfYear n) s = splitspan startofmonth (applyN n nextmonth) s -- splitSpan (QuarterOfYear n) s = splitspan startofquarter (applyN n nextquarter) s @@ -461,6 +467,31 @@ prevyear = startofyear . addGregorianYearsClip (-1) nextyear = startofyear . addGregorianYearsClip 1 startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day +-- | For given date d find year-long interval that starts on given MM/DD of year +-- and covers it. +-- +-- Examples: lets take 2017-11-22. Year-long intervals covering it that +-- starts before Nov 22 will start in 2017. However +-- intervals that start after Nov 23rd should start in 2016: +-- >>> let wed22nd = parsedate "2017-11-22" +-- >>> nthdayofyearcontaining 11 21 wed22nd +-- 2017-11-21 +-- >>> nthdayofyearcontaining 11 22 wed22nd +-- 2017-11-22 +-- >>> nthdayofyearcontaining 11 23 wed22nd +-- 2016-11-23 +-- >>> nthdayofyearcontaining 12 02 wed22nd +-- 2016-12-02 +-- >>> nthdayofyearcontaining 12 31 wed22nd +-- 2016-12-31 +-- >>> nthdayofyearcontaining 1 1 wed22nd +-- 2017-01-01 +nthdayofyearcontaining m n d | mmddOfSameYear <= d = mmddOfSameYear + | otherwise = mmddOfPrevYear + where mmddOfSameYear = addDays (fromIntegral n-1) $ applyN (m-1) nextmonth s + mmddOfPrevYear = addDays (fromIntegral n-1) $ applyN (m-1) nextmonth $ prevyear s + s = startofyear d + -- | For given date d find month-long interval that starts on nth day of month -- and covers it. -- @@ -484,7 +515,6 @@ nthdayofmonthcontaining n d | nthOfSameMonth <= d = nthOfSameMonth nthOfPrevMonth = addDays (fromIntegral n-1) $ prevmonth s s = startofmonth d - -- | For given date d find week-long interval that starts on nth day of week -- and covers it. -- @@ -712,7 +742,7 @@ lastthisnextthing = do return ("", T.unpack r, T.unpack p) -- | --- >>> let p s = parsewith (periodexpr (parsedate "2008/11/26")) (T.toLower s) :: Either (ParseError Char MPErr) (Interval, DateSpan) +-- >>> let p s = parsewith (periodexpr (parsedate "2008/11/26") <* eof) (T.toLower s) :: Either (ParseError Char MPErr) (Interval, DateSpan) -- >>> p "from Aug to Oct" -- Right (NoInterval,DateSpan 2008/08/01-2008/09/30) -- >>> p "aug to oct" @@ -723,6 +753,22 @@ lastthisnextthing = do -- Right (Days 1,DateSpan 2008/08/01-) -- >>> p "every week to 2009" -- Right (Weeks 1,DateSpan -2008/12/31) +-- >>> p "every 2nd day of month" +-- Right (DayOfMonth 2,DateSpan -) +-- >>> p "every 2nd day" +-- Right (DayOfMonth 2,DateSpan -) +-- >>> p "every 2nd day 2009-" +-- Right (DayOfMonth 2,DateSpan 2009/01/01-) +-- >>> p "every 29th Nov" +-- Right (DayOfYear 11 29,DateSpan -) +-- >>> p "every 29th nov -2009" +-- Right (DayOfYear 11 29,DateSpan -2008/12/31) +-- >>> p "every nov 29th" +-- Right (DayOfYear 11 29,DateSpan -) +-- >>> p "every Nov 29th 2009-" +-- Right (DayOfYear 11 29,DateSpan 2009/01/01-) +-- >>> p "every 11/29 from 2009" +-- Right (DayOfYear 11 29,DateSpan 2009/01/01-) periodexpr :: Day -> SimpleTextParser (Interval, DateSpan) periodexpr rdate = choice $ map try [ intervalanddateperiodexpr rdate, @@ -765,31 +811,42 @@ reportinginterval = choice' [ return $ Months 2, do string "every" many spacenonewline - n <- fmap read $ some digitChar - thsuffix + n <- nth many spacenonewline string "day" - many spacenonewline - string "of" - many spacenonewline - string "week" + of_ "week" return $ DayOfWeek n, do string "every" many spacenonewline - n <- fmap read $ some digitChar - thsuffix + n <- nth many spacenonewline string "day" - optional $ do - many spacenonewline - string "of" - many spacenonewline - string "month" - return $ DayOfMonth n + optOf_ "month" + return $ DayOfMonth n, + do string "every" + many spacenonewline + let mnth = choice' [month, mon] >>= \(_,m,_) -> return (read m) + d_o_y <- makePermParser $ DayOfYear <$$> (mnth <* many spacenonewline) <||> (nth <* many spacenonewline) + optOf_ "year" + return d_o_y, + do string "every" + many spacenonewline + ("",m,d) <- md + optOf_ "year" + return $ DayOfYear (read m) (read d) ] where - - thsuffix = choice' $ map string ["st","nd","rd","th"] + of_ period = do + many spacenonewline + string "of" + many spacenonewline + string period + + optOf_ period = optional $ try $ of_ period + + nth = do n <- some digitChar + choice' $ map string ["st","nd","rd","th"] + return $ read n -- Parse any of several variants of a basic interval, eg "daily", "every day", "every N days". tryinterval :: String -> String -> (Int -> Interval) -> SimpleTextParser Interval diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 77d22e2ea..cbf6424f2 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -90,6 +90,7 @@ data Interval = | Years Int | DayOfMonth Int | DayOfWeek Int + | DayOfYear Int Int -- Month, Day -- WeekOfYear Int -- MonthOfYear Int -- QuarterOfYear Int