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

really support "every N Xs" reporting intervals, also "every N(st|nd|rd|th) day of (month|week)"

Browse Source
This commit is contained in:
Simon Michael 2011-01-14 04:32:08 +00:00
parent e96dfc639e
commit 9bae97821a
4 changed files with 112 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
MANUAL.md
View File

@ -897,8 +897,15 @@ keyword. Examples:
-p "weekly from 2009/1/1 to 2009/4/1" -p "weekly from 2009/1/1 to 2009/4/1"
-p "monthly in 2008" -p "monthly in 2008"
-p "monthly from 2008" -p "bimonthly from 2008"
-p "quarterly" -p "quarterly"
-p "every 2 weeks"
-p "every 5 days from 1/3"
-p "every 15th day of month"
-p "every 4th day of week"
Note the last two give intervals that are one day long, so are not
all that useful currently.
A reporting interval may also be specified with the `-D/--daily`, A reporting interval may also be specified with the `-D/--daily`,
`-W/--weekly`, `-M/--monthly`, `-Q/--quarterly`, and `-Y/--yearly` `-W/--weekly`, `-M/--monthly`, `-Q/--quarterly`, and `-Y/--yearly`
@ -1089,9 +1096,6 @@ entries, and the following c++ ledger options and commands:
- hledger shows start and end dates of the intervals requested, - hledger shows start and end dates of the intervals requested,
not just the span containing data not just the span containing data
- hledger period expressions don't support "biweekly",
"bimonthly", or "every N days/weeks/..."
- hledger always shows timelog balances in hours - hledger always shows timelog balances in hours
- hledger splits multi-day timelog sessions at midnight - hledger splits multi-day timelog sessions at midnight

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

@ -46,30 +46,37 @@ elapsedSeconds t1 = realToFrac . diffUTCTime t1
-- | Split a DateSpan into one or more consecutive spans at the specified interval. -- | Split a DateSpan into one or more consecutive spans at the specified interval.
splitSpan :: Interval -> DateSpan -> [DateSpan] splitSpan :: Interval -> DateSpan -> [DateSpan]
splitSpan _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing] splitSpan _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]
splitSpan NoInterval s = [s] splitSpan NoInterval s = [s]
splitSpan Daily s = splitspan startofday nextday s splitSpan (Days n) s = splitspan startofday (applyN n nextday) Nothing s
splitSpan Weekly s = splitspan startofweek nextweek s splitSpan (Weeks n) s = splitspan startofweek (applyN n nextweek) Nothing s
splitSpan Biweekly s = splitspan startofweek (nextweek.nextweek) s splitSpan (Months n) s = splitspan startofmonth (applyN n nextmonth) Nothing s
splitSpan Monthly s = splitspan startofmonth nextmonth s splitSpan (Quarters n) s = splitspan startofquarter (applyN n nextquarter) Nothing s
splitSpan Bimonthly s = splitspan startofmonth (nextmonth.nextmonth) s splitSpan (Years n) s = splitspan startofyear (applyN n nextyear) Nothing s
splitSpan Quarterly s = splitspan startofquarter nextquarter s splitSpan (DayOfMonth n) s = splitspan (nthdayofmonthcontaining n) (applyN (n-1) nextday . nextmonth) (Just nextday) s
splitSpan Yearly s = splitspan startofyear nextyear s splitSpan (DayOfWeek n) s = splitspan (nthdayofweekcontaining n) (applyN (n-1) nextday . nextweek) (Just nextday) 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
splitspan :: (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan] -- Split the given span using the provided helper functions:
splitspan _ _ (DateSpan Nothing Nothing) = [] -- start is applied to the span's start date to get the first sub-span's start date
splitspan start next (DateSpan Nothing (Just e)) = [DateSpan (Just $ start e) (Just $ next $ start e)] -- next is applied to a sub-span's start date to get the next sub-span's start date
splitspan start next (DateSpan (Just b) Nothing) = [DateSpan (Just $ start b) (Just $ next $ start b)] -- end is applied to a sub-span's start date to get that sub-span's end date, if different from the above.
splitspan start next span@(DateSpan (Just b) (Just e)) splitspan :: (Day -> Day) -> (Day -> Day) -> Maybe (Day -> Day) -> DateSpan -> [DateSpan]
| b == e = [span] splitspan _ _ _ (DateSpan Nothing Nothing) = []
| otherwise = splitspan' start next span splitspan start next end (DateSpan Nothing (Just e)) = splitspan start next end (DateSpan (Just $ start e) (Just $ next $ start e))
splitspan start next end (DateSpan (Just s) Nothing) = splitspan start next end (DateSpan (Just $ start s) (Just $ next $ start s))
splitspan start next end span@(DateSpan (Just s) (Just e))
| s == e = [span]
| otherwise = splitspan' start next end span
where where
splitspan' start next (DateSpan (Just b) (Just e)) splitspan' start next end (DateSpan (Just s) (Just e))
| b >= e = [] | s >= e = []
| otherwise = DateSpan (Just s) (Just n) | otherwise = DateSpan (Just subs) (Just sube) : splitspan' start next end (DateSpan (Just subn) (Just e))
: splitspan' start next (DateSpan (Just n) (Just e)) where subs = start s
where s = start b sube = (fromMaybe next end) subs
n = next s subn = next subs
splitspan' _ _ _ = error' "won't happen, avoids warnings" splitspan' _ _ _ _ = error' "won't happen, avoids warnings"
-- | Count the days in a DateSpan, or if it is open-ended return Nothing. -- | Count the days in a DateSpan, or if it is open-ended return Nothing.
daysInSpan :: DateSpan -> Maybe Integer daysInSpan :: DateSpan -> Maybe Integer
@ -215,6 +222,18 @@ prevyear = startofyear . addGregorianYearsClip (-1)
nextyear = startofyear . addGregorianYearsClip 1 nextyear = startofyear . addGregorianYearsClip 1
startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day
nthdayofmonthcontaining n d | d1 >= d = d1
| otherwise = d2
where d1 = addDays (fromIntegral n-1) s
d2 = addDays (fromIntegral n-1) $ nextmonth s
s = startofmonth d
nthdayofweekcontaining n d | d1 >= d = d1
| otherwise = d2
where d1 = addDays (fromIntegral n-1) s
d2 = addDays (fromIntegral n-1) $ nextweek s
s = startofweek d
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- parsing -- parsing
@ -402,7 +421,7 @@ periodexpr rdate = choice $ map try [
intervalanddateperiodexpr :: Day -> GenParser Char st (Interval, DateSpan) intervalanddateperiodexpr :: Day -> GenParser Char st (Interval, DateSpan)
intervalanddateperiodexpr rdate = do intervalanddateperiodexpr rdate = do
many spacenonewline many spacenonewline
i <- periodexprinterval i <- reportinginterval
many spacenonewline many spacenonewline
s <- periodexprdatespan rdate s <- periodexprdatespan rdate
return (i,s) return (i,s)
@ -410,7 +429,7 @@ intervalanddateperiodexpr rdate = do
intervalperiodexpr :: GenParser Char st (Interval, DateSpan) intervalperiodexpr :: GenParser Char st (Interval, DateSpan)
intervalperiodexpr = do intervalperiodexpr = do
many spacenonewline many spacenonewline
i <- periodexprinterval i <- reportinginterval
return (i, DateSpan Nothing Nothing) return (i, DateSpan Nothing Nothing)
dateperiodexpr :: Day -> GenParser Char st (Interval, DateSpan) dateperiodexpr :: Day -> GenParser Char st (Interval, DateSpan)
@ -419,8 +438,9 @@ dateperiodexpr rdate = do
s <- periodexprdatespan rdate s <- periodexprdatespan rdate
return (NoInterval, s) return (NoInterval, s)
periodexprinterval :: GenParser Char st Interval -- Parse a reporting interval.
periodexprinterval = choice' [ reportinginterval :: GenParser Char st Interval
reportinginterval = choice' [
tryinterval "day" "daily" Days, tryinterval "day" "daily" Days,
tryinterval "week" "weekly" Weeks, tryinterval "week" "weekly" Weeks,
tryinterval "month" "monthly" Months, tryinterval "month" "monthly" Months,
@ -429,9 +449,36 @@ periodexprinterval = choice' [
do string "biweekly" do string "biweekly"
return $ Weeks 2, return $ Weeks 2,
do string "bimonthly" do string "bimonthly"
return $ Months 2 return $ Months 2,
] do string "every"
many spacenonewline
n <- fmap read $ many1 digit
thsuffix
many spacenonewline
string "day"
many spacenonewline
string "of"
many spacenonewline
string "week"
return $ DayOfWeek n,
do string "every"
many spacenonewline
n <- fmap read $ many1 digit
thsuffix
many spacenonewline
string "day"
optional $ do
many spacenonewline
string "of"
many spacenonewline
string "month"
return $ DayOfMonth n
]
where where
thsuffix = choice' $ map string ["st","nd","rd","th"]
-- Parse any of several variants of a basic interval, eg "daily", "every day", "every N days".
tryinterval :: String -> String -> (Int -> Interval) -> GenParser Char st Interval tryinterval :: String -> String -> (Int -> Interval) -> GenParser Char st Interval
tryinterval singular compact intcons = tryinterval singular compact intcons =
choice' [ choice' [
@ -495,7 +542,21 @@ nulldate = parsedate "1900/01/01"
tests_Hledger_Data_Dates = TestList tests_Hledger_Data_Dates = TestList
[ [
"splitSpan" ~: do "parsedate" ~: do
let date1 = parsedate "2008/11/26"
parsedate "2008/02/03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1
parsedate "2008-02-03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1
,"period expressions" ~: do
let todaysdate = parsedate "2008/11/26"
let str `gives` result = show (parsewith (periodexpr todaysdate) str) `is` ("Right " ++ result)
"from aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
"aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
"every 3 days in aug" `gives` "(Days 3,DateSpan (Just 2008-08-01) (Just 2008-09-01))"
"daily from aug" `gives` "(Days 1,DateSpan (Just 2008-08-01) Nothing)"
"every week to 2009" `gives` "(Weeks 1,DateSpan Nothing (Just 2009-01-01))"
,"splitSpan" ~: do
let gives (interval, span) = (splitSpan interval span `is`) let gives (interval, span) = (splitSpan interval span `is`)
(NoInterval,mkdatespan "2008/01/01" "2009/01/01") `gives` (NoInterval,mkdatespan "2008/01/01" "2009/01/01") `gives`
[mkdatespan "2008/01/01" "2009/01/01"] [mkdatespan "2008/01/01" "2009/01/01"]
@ -529,20 +590,15 @@ tests_Hledger_Data_Dates = TestList
[mkdatespan "2007/12/31" "2008/01/14" [mkdatespan "2007/12/31" "2008/01/14"
,mkdatespan "2008/01/14" "2008/01/28" ,mkdatespan "2008/01/14" "2008/01/28"
] ]
(DayOfMonth 2,mkdatespan "2008/01/01" "2008/04/01") `gives`
,"parsedate" ~: do [mkdatespan "2008/01/02" "2008/01/03"
let date1 = parsedate "2008/11/26" ,mkdatespan "2008/02/02" "2008/02/03"
parsedate "2008/02/03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1 ,mkdatespan "2008/03/02" "2008/03/03"
parsedate "2008-02-03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1 ]
(DayOfWeek 2,mkdatespan "2011/01/01" "2011/01/15") `gives`
,"period expressions" ~: do [mkdatespan "2011/01/04" "2011/01/05"
let todaysdate = parsedate "2008/11/26" ,mkdatespan "2011/01/11" "2011/01/12"
let str `gives` result = show (parsewith (periodexpr todaysdate) str) `is` ("Right " ++ result) ]
"from aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
"aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
"every 3 days from aug to oct" `gives` "(Days 3,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
"daily from aug" `gives` "(Days 1,DateSpan (Just 2008-08-01) Nothing)"
"every week to 2009" `gives` "(Weeks 1,DateSpan Nothing (Just 2009-01-01))"
,"fixSmartDateStr" ~: do ,"fixSmartDateStr" ~: do
let gives = is . fixSmartDateStr (parsedate "2008/11/26") let gives = is . fixSmartDateStr (parsedate "2008/11/26")

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

@ -48,6 +48,8 @@ data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Show,Ord)
data Interval = NoInterval data Interval = NoInterval
| Days Int | Weeks Int | Months Int | Quarters Int | Years Int | Days Int | Weeks Int | Months Int | Quarters Int | Years Int
| DayOfMonth Int | DayOfWeek Int
-- | WeekOfYear Int | MonthOfYear Int | QuarterOfYear Int
deriving (Eq,Show,Ord) deriving (Eq,Show,Ord)
type AccountName = String type AccountName = String

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

@ -371,3 +371,6 @@ isRight = not . isLeft
-- -- return (homeDirectory pw ++ path) -- -- return (homeDirectory pw ++ path)
-- tildeExpand xs = return xs -- tildeExpand xs = return xs
-- | Apply a function the specified number of times. Possibly uses O(n) stack ?
applyN :: Int -> (a -> a) -> a -> a
applyN n f = (!! n) . iterate f