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

support "biweekly" and "bimonthly" reporting intervals

Browse Source
This commit is contained in:
Simon Michael 2011-01-14 01:22:53 +00:00
parent b2f439eb11
commit 6de45f7d16
2 changed files with 25 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -49,7 +49,9 @@ splitSpan _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]
splitSpan NoInterval s = [s] splitSpan NoInterval s = [s]
splitSpan Daily s = splitspan startofday nextday s splitSpan Daily s = splitspan startofday nextday s
splitSpan Weekly s = splitspan startofweek nextweek s splitSpan Weekly s = splitspan startofweek nextweek s
splitSpan Biweekly s = splitspan startofweek (nextweek.nextweek) s
splitSpan Monthly s = splitspan startofmonth nextmonth s splitSpan Monthly s = splitspan startofmonth nextmonth s
splitSpan Bimonthly s = splitspan startofmonth (nextmonth.nextmonth) s
splitSpan Quarterly s = splitspan startofquarter nextquarter s splitSpan Quarterly s = splitspan startofquarter nextquarter s
splitSpan Yearly s = splitspan startofyear nextyear s splitSpan Yearly s = splitspan startofyear nextyear s
@ -422,13 +424,15 @@ periodexprinterval =
choice $ map try [ choice $ map try [
tryinterval "day" "daily" Daily, tryinterval "day" "daily" Daily,
tryinterval "week" "weekly" Weekly, tryinterval "week" "weekly" Weekly,
tryinterval "" "biweekly" Biweekly,
tryinterval "month" "monthly" Monthly, tryinterval "month" "monthly" Monthly,
tryinterval "" "bimonthly" Bimonthly,
tryinterval "quarter" "quarterly" Quarterly, tryinterval "quarter" "quarterly" Quarterly,
tryinterval "year" "yearly" Yearly tryinterval "year" "yearly" Yearly
] ]
where where
tryinterval s1 s2 v = tryinterval "" s2 v = try (string s2) >> return v
choice [try (string $ "every "++s1), try (string s2)] >> return v tryinterval s1 s2 v = choice [try (string $ "every "++s1), try (string s2)] >> return v
periodexprdatespan :: Day -> GenParser Char st DateSpan periodexprdatespan :: Day -> GenParser Char st DateSpan
periodexprdatespan rdate = choice $ map try [ periodexprdatespan rdate = choice $ map try [
@ -491,6 +495,24 @@ tests_Hledger_Data_Dates = TestList
[mkdatespan "2008/01/01" "2008/01/01"] [mkdatespan "2008/01/01" "2008/01/01"]
(Quarterly,mkdatespan "2008/01/01" "2008/01/01") `gives` (Quarterly,mkdatespan "2008/01/01" "2008/01/01") `gives`
[mkdatespan "2008/01/01" "2008/01/01"] [mkdatespan "2008/01/01" "2008/01/01"]
(Monthly,mkdatespan "2008/01/01" "2008/04/01") `gives`
[mkdatespan "2008/01/01" "2008/02/01"
,mkdatespan "2008/02/01" "2008/03/01"
,mkdatespan "2008/03/01" "2008/04/01"
]
(Bimonthly,mkdatespan "2008/01/01" "2008/04/01") `gives`
[mkdatespan "2008/01/01" "2008/03/01"
,mkdatespan "2008/03/01" "2008/05/01"
]
(Weekly,mkdatespan "2008/01/01" "2008/01/15") `gives`
[mkdatespan "2007/12/31" "2008/01/07"
,mkdatespan "2008/01/07" "2008/01/14"
,mkdatespan "2008/01/14" "2008/01/21"
]
(Biweekly,mkdatespan "2008/01/01" "2008/01/15") `gives`
[mkdatespan "2007/12/31" "2008/01/14"
,mkdatespan "2008/01/14" "2008/01/28"
]
,"parsedate" ~: do ,"parsedate" ~: do
let date1 = parsedate "2008/11/26" let date1 = parsedate "2008/11/26"

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

@ -46,7 +46,7 @@ data WhichDate = ActualDate | EffectiveDate deriving (Eq,Show)
data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Show,Ord) data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Show,Ord)
data Interval = NoInterval | Daily | Weekly | Monthly | Quarterly | Yearly data Interval = NoInterval | Daily | Weekly | Biweekly | Monthly | Bimonthly | Quarterly | Yearly
deriving (Eq,Show,Ord) deriving (Eq,Show,Ord)
type AccountName = String type AccountName = String