mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-28 04:46:31 +03:00
this/last/next month/quarter/year
This commit is contained in:
Simon Michael
parent
7858ed1327
commit
b7616562d9
@ -82,35 +82,60 @@ fixSmartDate :: Date -> SmartDate -> Date
|
|||||||
fixSmartDate refdate sdate = mkDate $ fromGregorian y m d
|
fixSmartDate refdate sdate = mkDate $ fromGregorian y m d
|
||||||
where
|
where
|
||||||
(y,m,d) = fix sdate
|
(y,m,d) = fix sdate
|
||||||
|
callondate f d = dateComponents $ mkDate $ f $ utctDay $ dateToUTC d
|
||||||
fix :: SmartDate -> (Integer,Int,Int)
|
fix :: SmartDate -> (Integer,Int,Int)
|
||||||
fix ("","","today") = (ry, rm, rd)
|
fix ("","","today") = (ry, rm, rd)
|
||||||
fix ("","this","day") = (ry, rm, rd)
|
fix ("","this","day") = (ry, rm, rd)
|
||||||
fix ("","","yesterday") = dateComponents $ prevday refdate
|
fix ("","","yesterday") = callondate prevday refdate
|
||||||
fix ("","last","day") = dateComponents $ prevday refdate
|
fix ("","last","day") = callondate prevday refdate
|
||||||
fix ("","","tomorrow") = dateComponents $ nextday refdate
|
fix ("","","tomorrow") = callondate nextday refdate
|
||||||
fix ("","next","day") = dateComponents $ nextday refdate
|
fix ("","next","day") = callondate nextday refdate
|
||||||
fix ("","last","week") = dateComponents $ prevweek refdate
|
fix ("","last","week") = callondate prevweek refdate
|
||||||
fix ("","this","week") = dateComponents $ thisweek refdate
|
fix ("","this","week") = callondate thisweek refdate
|
||||||
fix ("","next","week") = dateComponents $ nextweek refdate
|
fix ("","next","week") = callondate nextweek refdate
|
||||||
fix ("","",d) = (ry, rm, read d)
|
fix ("","last","month") = callondate prevmonth refdate
|
||||||
fix ("",m,d) = (ry, read m, read d)
|
fix ("","this","month") = callondate thismonth refdate
|
||||||
fix (y,m,d) = (read y, read m, read d)
|
fix ("","next","month") = callondate nextmonth refdate
|
||||||
|
fix ("","last","quarter") = callondate prevquarter refdate
|
||||||
|
fix ("","this","quarter") = callondate thisquarter refdate
|
||||||
|
fix ("","next","quarter") = callondate nextquarter refdate
|
||||||
|
fix ("","last","year") = callondate prevyear refdate
|
||||||
|
fix ("","this","year") = callondate thisyear refdate
|
||||||
|
fix ("","next","year") = callondate nextyear refdate
|
||||||
|
fix ("","",d) = (ry, rm, read d)
|
||||||
|
fix ("",m,d) = (ry, read m, read d)
|
||||||
|
fix (y,m,d) = (read y, read m, read d)
|
||||||
(ry,rm,rd) = dateComponents refdate
|
(ry,rm,rd) = dateComponents refdate
|
||||||
|
|
||||||
prevday, nextday :: Date -> Date
|
prevday :: Day -> Day
|
||||||
prevday = mkDate . (addDays (-1)) . utctDay . dateToUTC
|
prevday = addDays (-1)
|
||||||
nextday = mkDate . (addDays 1) . utctDay . dateToUTC
|
nextday = addDays 1
|
||||||
thisweek date = mkDate $ mondayofweekcontaining $ utctDay $ dateToUTC date
|
|
||||||
prevweek date = mkDate $ mondayofweekbefore $ utctDay $ dateToUTC date
|
|
||||||
nextweek date = mkDate $ mondayafter $ utctDay $ dateToUTC date
|
|
||||||
|
|
||||||
mondayafter day = mondayofweekcontaining $ addDays 7 day
|
thisweek = startofweek
|
||||||
mondayofweekbefore day = mondayofweekcontaining $ addDays (-7) day
|
prevweek = startofweek . addDays (-7)
|
||||||
mondayofweekcontaining day = fromMondayStartWeek y w 1
|
nextweek = startofweek . addDays 7
|
||||||
|
startofweek day = fromMondayStartWeek y w 1
|
||||||
where
|
where
|
||||||
(y,m,d) = toGregorian day
|
(y,_,_) = toGregorian day
|
||||||
(w,_) = mondayStartWeek day
|
(w,_) = mondayStartWeek day
|
||||||
|
|
||||||
|
thismonth = startofmonth
|
||||||
|
prevmonth = startofmonth . addGregorianMonthsClip (-1)
|
||||||
|
nextmonth = startofmonth . addGregorianMonthsClip 1
|
||||||
|
startofmonth day = fromGregorian y m 1 where (y,m,_) = toGregorian day
|
||||||
|
|
||||||
|
thisquarter = startofquarter
|
||||||
|
prevquarter = startofquarter . addGregorianMonthsClip (-3)
|
||||||
|
nextquarter = startofquarter . addGregorianMonthsClip 3
|
||||||
|
startofquarter day = fromGregorian y (firstmonthofquarter m) 1
|
||||||
|
where
|
||||||
|
(y,m,_) = toGregorian day
|
||||||
|
firstmonthofquarter m = ((m-1) `div` 3) * 3 + 1
|
||||||
|
|
||||||
|
thisyear = startofyear
|
||||||
|
prevyear = startofyear . addGregorianYearsClip (-1)
|
||||||
|
nextyear = startofyear . addGregorianYearsClip 1
|
||||||
|
startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
-- parsing
|
-- parsing
|
||||||
@ -229,7 +254,7 @@ lastthisnextthing = do
|
|||||||
,string "next"
|
,string "next"
|
||||||
]
|
]
|
||||||
--many1 spacenonewline
|
--many1 spacenonewline
|
||||||
many spacenonewline -- allow lastweek for easier shell scripting
|
many spacenonewline -- allow the space to be omitted for easier scripting
|
||||||
p <- choice [
|
p <- choice [
|
||||||
string "day"
|
string "day"
|
||||||
,string "week"
|
,string "week"
|
||||||
|
|||||||
48
Tests.hs
48
Tests.hs
@ -100,25 +100,35 @@ misc_tests = TestList [
|
|||||||
"smart dates" ~: do
|
"smart dates" ~: do
|
||||||
let todaysdate = parsedate "2008/11/26" -- wednesday
|
let todaysdate = parsedate "2008/11/26" -- wednesday
|
||||||
let str `gives` datestr = assertequal datestr (fixSmartDateStr todaysdate str)
|
let str `gives` datestr = assertequal datestr (fixSmartDateStr todaysdate str)
|
||||||
"1999-12-02" `gives` "1999/12/02"
|
-- for now at least, a fuzzy date always refers to the start of the period
|
||||||
"1999.12.02" `gives` "1999/12/02"
|
"1999-12-02" `gives` "1999/12/02"
|
||||||
"1999/3/2" `gives` "1999/03/02"
|
"1999.12.02" `gives` "1999/12/02"
|
||||||
"2008/2" `gives` "2008/02/01"
|
"1999/3/2" `gives` "1999/03/02"
|
||||||
"20/2" `gives` "0020/02/01"
|
"2008/2" `gives` "2008/02/01"
|
||||||
"1000" `gives` "1000/01/01"
|
"20/2" `gives` "0020/02/01"
|
||||||
"4/2" `gives` "2008/04/02"
|
"1000" `gives` "1000/01/01"
|
||||||
"2" `gives` "2008/11/02"
|
"4/2" `gives` "2008/04/02"
|
||||||
"January" `gives` "2008/01/01"
|
"2" `gives` "2008/11/02"
|
||||||
"feb" `gives` "2008/02/01"
|
"January" `gives` "2008/01/01"
|
||||||
"today" `gives` "2008/11/26"
|
"feb" `gives` "2008/02/01"
|
||||||
"yesterday" `gives` "2008/11/25"
|
"today" `gives` "2008/11/26"
|
||||||
"tomorrow" `gives` "2008/11/27"
|
"yesterday" `gives` "2008/11/25"
|
||||||
"this day" `gives` "2008/11/26"
|
"tomorrow" `gives` "2008/11/27"
|
||||||
"last day" `gives` "2008/11/25"
|
"this day" `gives` "2008/11/26"
|
||||||
"next day" `gives` "2008/11/27"
|
"last day" `gives` "2008/11/25"
|
||||||
"this week" `gives` "2008/11/24" -- last monday
|
"next day" `gives` "2008/11/27"
|
||||||
"last week" `gives` "2008/11/17" -- previous monday
|
"this week" `gives` "2008/11/24" -- last monday
|
||||||
"next week" `gives` "2008/12/01" -- next monday
|
"last week" `gives` "2008/11/17" -- previous monday
|
||||||
|
"next week" `gives` "2008/12/01" -- next monday
|
||||||
|
"this month" `gives` "2008/11/01"
|
||||||
|
"last month" `gives` "2008/10/01"
|
||||||
|
"next month" `gives` "2008/12/01"
|
||||||
|
"this quarter" `gives` "2008/10/01"
|
||||||
|
"last quarter" `gives` "2008/07/01"
|
||||||
|
"next quarter" `gives` "2009/01/01"
|
||||||
|
"this year" `gives` "2008/01/01"
|
||||||
|
"last year" `gives` "2007/01/01"
|
||||||
|
"next year" `gives` "2009/01/01"
|
||||||
]
|
]
|
||||||
|
|
||||||
balancereportacctnames_tests = TestList
|
balancereportacctnames_tests = TestList
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user