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

hacking in more date parsing.. today/tomorrow/yesterday

Browse Source
This commit is contained in:
Simon Michael 2008-11-26 04:51:15 +00:00
parent 6c88197c6a
commit 4d49177117
3 changed files with 40 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Ledger/Parse.hs
View File

@ -492,8 +492,8 @@ and maybe some others:
> 10/1 > 10/1
> 21 > 21
> october, oct > october, oct
> this/next/last week/day/month/quarter/year
> yesterday, today, tomorrow > yesterday, today, tomorrow
> this/next/last week/day/month/quarter/year
Note: only recognises month names in lowercase. Note: only recognises month names in lowercase.
-} -}
@ -507,9 +507,9 @@ smartdate = do
,try d ,try d
,try month ,try month
,try mon ,try mon
-- ,try today ,try parsetoday
-- ,try yesterday ,try yesterday
-- ,try tomorrow ,try tomorrow
-- ,try thiswhatever -- ,try thiswhatever
-- ,try nextwhatever -- ,try nextwhatever
-- ,try lastwhatever -- ,try lastwhatever
@ -577,6 +577,12 @@ mon = do
let i = maybe 0 (+1) $ (map toLower m) `elemIndex` mons let i = maybe 0 (+1) $ (map toLower m) `elemIndex` mons
return ("",show i,"1") return ("",show i,"1")
parsetoday = string "today" >> return ("","","today")
yesterday = string "yesterday" >> return ("","","yesterday")
tomorrow = string "tomorrow" >> return ("","","tomorrow")
type TransactionMatcher = Transaction -> Bool type TransactionMatcher = Transaction -> Bool
-- | Parse a --display expression which is a simple date predicate, -- | Parse a --display expression which is a simple date predicate,

28
Options.hs
View File

@ -97,26 +97,32 @@ parseArguments = do
-- explicit ones, based on today's date. -- explicit ones, based on today's date.
fixDates :: [Opt] -> IO [Opt] fixDates :: [Opt] -> IO [Opt]
fixDates opts = do fixDates opts = do
ds <- today >>= return . dateComponents t <- today
return $ map (fixopt ds) opts return $ map (fixopt t) opts
where where
fixopt ds (Begin s) = Begin $ fixdate ds s fixopt t (Begin s) = Begin $ fixdate t s
fixopt ds (End s) = End $ fixdate ds s fixopt t (End s) = End $ fixdate t s
fixopt ds (Display s) = -- hacky fixopt t (Display s) = -- hacky
Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddate s Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddate s
where fixbracketeddate s = "[" ++ (fixdate ds $ init $ tail s) ++ "]" where fixbracketeddate s = "[" ++ (fixdate t $ init $ tail s) ++ "]"
fixopt _ o = o fixopt _ o = o
-- | Convert a fuzzy date string to an explicit yyyy/mm/dd date, using the -- | Convert a fuzzy date string to an explicit yyyy/mm/dd date, using the
-- provided today's date for defaults. -- provided today's date for defaults.
fixdate :: (Integer,Int,Int) -> String -> String fixdate :: Date -> String -> String
fixdate (thisy,thism,thisd) s = printf "%04s/%02s/%02s" y' m' d' fixdate t s = printf "%04s/%02s/%02s" y' m' d'
where where
(ty,tm,td) = dateComponents t
(y,m,d) = fromparse $ parsewith smartdate $ map toLower s (y,m,d) = fromparse $ parsewith smartdate $ map toLower s
(y',m',d') = case (y,m,d) of (y',m',d') = case (y,m,d) of
("","",d) -> (show thisy,show thism,d) ("","","today") -> (show ty,show tm,show td)
("",m,d) -> (show thisy,m,d) ("","","yesterday") -> (show y, show m, show d)
otherwise -> (y,m,d) where (y,m,d) = toGregorian $ addDays (-1) $ fromGregorian ty tm td
("","","tomorrow") -> (show y, show m, show d)
where (y,m,d) = toGregorian $ addDays 1 $ fromGregorian ty tm td
("","",d) -> (show ty,show tm,d)
("",m,d) -> (show ty,m,d)
otherwise -> (y,m,d)
-- | Get the ledger file path from options, an environment variable, or a default -- | Get the ledger file path from options, an environment variable, or a default
ledgerFilePathFromOpts :: [Opt] -> IO String ledgerFilePathFromOpts :: [Opt] -> IO String

18
Tests.hs
View File

@ -98,18 +98,24 @@ misc_tests = TestList [
assertparseequal timelog1 (parsewith timelog timelog1_str) assertparseequal timelog1 (parsewith timelog timelog1_str)
, ,
"smartparsedate" ~: do "smartparsedate" ~: do
ds@(y,m,d) <- today >>= return . dateComponents t <- today
let str `gives` datestr = assertequal datestr (fixdate ds str) let (ty,tm,td) = dateComponents t
let str `gives` datestr = assertequal datestr (fixdate t str)
"1999-12-02" `gives` "1999/12/02" "1999-12-02" `gives` "1999/12/02"
"1999.12.02" `gives` "1999/12/02" "1999.12.02" `gives` "1999/12/02"
"1999/3/2" `gives` "1999/03/02" "1999/3/2" `gives` "1999/03/02"
"2008/2" `gives` "2008/02/01" "2008/2" `gives` "2008/02/01"
"20/2" `gives` "0020/02/01" "20/2" `gives` "0020/02/01"
"1000" `gives` "1000/01/01" "1000" `gives` "1000/01/01"
"4/2" `gives` (printf "%04d/04/02" y) "4/2" `gives` (printf "%04d/04/02" ty)
"2" `gives` (printf "%04d/%02d/02" y m) "2" `gives` (printf "%04d/%02d/02" ty tm)
"January" `gives` (printf "%04d/01/01" y) "January" `gives` (printf "%04d/01/01" ty)
"feb" `gives` (printf "%04d/02/01" y) "feb" `gives` (printf "%04d/02/01" ty)
"today" `gives` (printf "%04d/%02d/%02d" ty tm td)
let (y,m,d) = toGregorian $ addDays (-1) $ fromGregorian ty tm td
"yesterday" `gives` (printf "%04d/%02d/%02d" y m d)
let (y,m,d) = toGregorian $ addDays 1 $ fromGregorian ty tm td
"tomorrow" `gives` (printf "%04d/%02d/%02d" y m d)
] ]
balancereportacctnames_tests = TestList balancereportacctnames_tests = TestList