lib: support "every 11th Nov" in period expressions
Useful for periodic transactions Without it, once-per-year periodic transactions always occur on 1st Jan.
This commit is contained in:
Dmitry Astapov
parent
7acb5d45aa
commit
f1b4618f2d
@ -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
|
||||
-- <BLANKLINE>
|
||||
@ -146,6 +147,16 @@ renderPostingCommentDates p = p { pcomment = comment' }
|
||||
-- 2017/03/01
|
||||
-- hi $1.00
|
||||
-- <BLANKLINE>
|
||||
-- >>> gen "every Nov 29th from 2017 to 2019"
|
||||
-- 2016/11/29
|
||||
-- hi $1.00
|
||||
-- <BLANKLINE>
|
||||
-- 2017/11/29
|
||||
-- hi $1.00
|
||||
-- <BLANKLINE>
|
||||
-- 2018/11/29
|
||||
-- hi $1.00
|
||||
-- <BLANKLINE>
|
||||
runPeriodicTransaction :: PeriodicTransaction -> (DateSpan -> [Transaction])
|
||||
runPeriodicTransaction pt = generate where
|
||||
base = nulltransaction { tpostings = ptpostings pt }
|
||||
|
||||
@ -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
|
||||
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
|
||||
of_ period = do
|
||||
many spacenonewline
|
||||
string "of"
|
||||
many spacenonewline
|
||||
string "month"
|
||||
return $ DayOfMonth n
|
||||
]
|
||||
where
|
||||
string period
|
||||
|
||||
thsuffix = choice' $ map string ["st","nd","rd","th"]
|
||||
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
|
||||
|
||||
@ -90,6 +90,7 @@ data Interval =
|
||||
| Years Int
|
||||
| DayOfMonth Int
|
||||
| DayOfWeek Int
|
||||
| DayOfYear Int Int -- Month, Day
|
||||
-- WeekOfYear Int
|
||||
-- MonthOfYear Int
|
||||
-- QuarterOfYear Int
|
||||
|
||||
Loading…
Reference in New Issue
Block a user