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

smart dates: work towards next/last monthname/weekdayname

Browse Source
This commit is contained in:
Simon Michael 2009-01-17 20:21:44 +00:00
parent 77098fec7e
commit 5a0156d5ee
2 changed files with 15 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
Ledger/Dates.hs
View File

@ -278,13 +278,14 @@ md = do
guard (read d <= 31) guard (read d <= 31)
return ("",m,d) return ("",m,d)
months = ["january","february","march","april","may","june", months = ["january","february","march","april","may","june",
"july","august","september","october","november","december"] "july","august","september","october","november","december"]
monthabbrevs = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"]
mons = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"] weekdays = ["monday","tuesday","wednesday","thursday","friday","saturday","sunday"]
weekdayabbrevs = ["mon","tue","wed","thu","fri","sat","sun"]
monthIndex s = maybe 0 (+1) $ (lowercase s) `elemIndex` months monthIndex s = maybe 0 (+1) $ (lowercase s) `elemIndex` months
monIndex s = maybe 0 (+1) $ (lowercase s) `elemIndex` mons monIndex s = maybe 0 (+1) $ (lowercase s) `elemIndex` monthabbrevs
month :: Parser SmartDate month :: Parser SmartDate
month = do month = do
@ -294,7 +295,7 @@ month = do
mon :: Parser SmartDate mon :: Parser SmartDate
mon = do mon = do
m <- choice $ map (try . string) mons m <- choice $ map (try . string) monthabbrevs
let i = monIndex m let i = monIndex m
return ("",show i,"") return ("",show i,"")
@ -310,15 +311,17 @@ lastthisnextthing = do
,string "this" ,string "this"
,string "next" ,string "next"
] ]
--many1 spacenonewline many spacenonewline -- make the space optional for easier scripting
many spacenonewline -- allow the space to be omitted for easier scripting p <- choice $ [
p <- choice [
string "day" string "day"
,string "week" ,string "week"
,string "month" ,string "month"
,string "quarter" ,string "quarter"
,string "year" ,string "year"
] ]
-- XXX support these in fixSmartDate
-- ++ (map string $ months ++ monthabbrevs ++ weekdays ++ weekdayabbrevs)
return ("",r,p) return ("",r,p)
periodexpr :: Day -> Parser (Interval, DateSpan) periodexpr :: Day -> Parser (Interval, DateSpan)

3
Tests.hs
View File

@ -129,6 +129,9 @@ misc_tests = TestList [
"this year" `gives` "2008/01/01" "this year" `gives` "2008/01/01"
"last year" `gives` "2007/01/01" "last year" `gives` "2007/01/01"
"next year" `gives` "2009/01/01" "next year" `gives` "2009/01/01"
-- "last wed" `gives` "2008/11/19"
-- "next friday" `gives` "2008/11/28"
-- "next january" `gives` "2009/01/01"
, ,
"dateSpanFromOpts" ~: do "dateSpanFromOpts" ~: do
let todaysdate = parsedate "2008/11/26" let todaysdate = parsedate "2008/11/26"