mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-27 12:24:43 +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
|
||||
where
|
||||
(y,m,d) = fix sdate
|
||||
callondate f d = dateComponents $ mkDate $ f $ utctDay $ dateToUTC d
|
||||
fix :: SmartDate -> (Integer,Int,Int)
|
||||
fix ("","","today") = (ry, rm, rd)
|
||||
fix ("","this","day") = (ry, rm, rd)
|
||||
fix ("","","yesterday") = dateComponents $ prevday refdate
|
||||
fix ("","last","day") = dateComponents $ prevday refdate
|
||||
fix ("","","tomorrow") = dateComponents $ nextday refdate
|
||||
fix ("","next","day") = dateComponents $ nextday refdate
|
||||
fix ("","last","week") = dateComponents $ prevweek refdate
|
||||
fix ("","this","week") = dateComponents $ thisweek refdate
|
||||
fix ("","next","week") = dateComponents $ nextweek 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)
|
||||
fix ("","","today") = (ry, rm, rd)
|
||||
fix ("","this","day") = (ry, rm, rd)
|
||||
fix ("","","yesterday") = callondate prevday refdate
|
||||
fix ("","last","day") = callondate prevday refdate
|
||||
fix ("","","tomorrow") = callondate nextday refdate
|
||||
fix ("","next","day") = callondate nextday refdate
|
||||
fix ("","last","week") = callondate prevweek refdate
|
||||
fix ("","this","week") = callondate thisweek refdate
|
||||
fix ("","next","week") = callondate nextweek refdate
|
||||
fix ("","last","month") = callondate prevmonth refdate
|
||||
fix ("","this","month") = callondate thismonth refdate
|
||||
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
|
||||
|
||||
prevday, nextday :: Date -> Date
|
||||
prevday = mkDate . (addDays (-1)) . utctDay . dateToUTC
|
||||
nextday = mkDate . (addDays 1) . utctDay . dateToUTC
|
||||
thisweek date = mkDate $ mondayofweekcontaining $ utctDay $ dateToUTC date
|
||||
prevweek date = mkDate $ mondayofweekbefore $ utctDay $ dateToUTC date
|
||||
nextweek date = mkDate $ mondayafter $ utctDay $ dateToUTC date
|
||||
prevday :: Day -> Day
|
||||
prevday = addDays (-1)
|
||||
nextday = addDays 1
|
||||
|
||||
mondayafter day = mondayofweekcontaining $ addDays 7 day
|
||||
mondayofweekbefore day = mondayofweekcontaining $ addDays (-7) day
|
||||
mondayofweekcontaining day = fromMondayStartWeek y w 1
|
||||
thisweek = startofweek
|
||||
prevweek = startofweek . addDays (-7)
|
||||
nextweek = startofweek . addDays 7
|
||||
startofweek day = fromMondayStartWeek y w 1
|
||||
where
|
||||
(y,m,d) = toGregorian day
|
||||
(y,_,_) = toGregorian 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
|
||||
@ -229,7 +254,7 @@ lastthisnextthing = do
|
||||
,string "next"
|
||||
]
|
||||
--many1 spacenonewline
|
||||
many spacenonewline -- allow lastweek for easier shell scripting
|
||||
many spacenonewline -- allow the space to be omitted for easier scripting
|
||||
p <- choice [
|
||||
string "day"
|
||||
,string "week"
|
||||
|
||||
48
Tests.hs
48
Tests.hs
@ -100,25 +100,35 @@ misc_tests = TestList [
|
||||
"smart dates" ~: do
|
||||
let todaysdate = parsedate "2008/11/26" -- wednesday
|
||||
let str `gives` datestr = assertequal datestr (fixSmartDateStr todaysdate str)
|
||||
"1999-12-02" `gives` "1999/12/02"
|
||||
"1999.12.02" `gives` "1999/12/02"
|
||||
"1999/3/2" `gives` "1999/03/02"
|
||||
"2008/2" `gives` "2008/02/01"
|
||||
"20/2" `gives` "0020/02/01"
|
||||
"1000" `gives` "1000/01/01"
|
||||
"4/2" `gives` "2008/04/02"
|
||||
"2" `gives` "2008/11/02"
|
||||
"January" `gives` "2008/01/01"
|
||||
"feb" `gives` "2008/02/01"
|
||||
"today" `gives` "2008/11/26"
|
||||
"yesterday" `gives` "2008/11/25"
|
||||
"tomorrow" `gives` "2008/11/27"
|
||||
"this day" `gives` "2008/11/26"
|
||||
"last day" `gives` "2008/11/25"
|
||||
"next day" `gives` "2008/11/27"
|
||||
"this week" `gives` "2008/11/24" -- last monday
|
||||
"last week" `gives` "2008/11/17" -- previous monday
|
||||
"next week" `gives` "2008/12/01" -- next monday
|
||||
-- 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"
|
||||
"2008/2" `gives` "2008/02/01"
|
||||
"20/2" `gives` "0020/02/01"
|
||||
"1000" `gives` "1000/01/01"
|
||||
"4/2" `gives` "2008/04/02"
|
||||
"2" `gives` "2008/11/02"
|
||||
"January" `gives` "2008/01/01"
|
||||
"feb" `gives` "2008/02/01"
|
||||
"today" `gives` "2008/11/26"
|
||||
"yesterday" `gives` "2008/11/25"
|
||||
"tomorrow" `gives` "2008/11/27"
|
||||
"this day" `gives` "2008/11/26"
|
||||
"last day" `gives` "2008/11/25"
|
||||
"next day" `gives` "2008/11/27"
|
||||
"this week" `gives` "2008/11/24" -- last 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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user