diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index fd7f816da..953ad297a 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -492,8 +492,8 @@ and maybe some others: > 10/1 > 21 > october, oct -> this/next/last week/day/month/quarter/year > yesterday, today, tomorrow +> this/next/last week/day/month/quarter/year Note: only recognises month names in lowercase. -} @@ -507,9 +507,9 @@ smartdate = do ,try d ,try month ,try mon --- ,try today --- ,try yesterday --- ,try tomorrow + ,try parsetoday + ,try yesterday + ,try tomorrow -- ,try thiswhatever -- ,try nextwhatever -- ,try lastwhatever @@ -577,6 +577,12 @@ mon = do let i = maybe 0 (+1) $ (map toLower m) `elemIndex` mons return ("",show i,"1") +parsetoday = string "today" >> return ("","","today") +yesterday = string "yesterday" >> return ("","","yesterday") +tomorrow = string "tomorrow" >> return ("","","tomorrow") + + + type TransactionMatcher = Transaction -> Bool -- | Parse a --display expression which is a simple date predicate, diff --git a/Options.hs b/Options.hs index 9b8ea51de..9670d40a0 100644 --- a/Options.hs +++ b/Options.hs @@ -97,26 +97,32 @@ parseArguments = do -- explicit ones, based on today's date. fixDates :: [Opt] -> IO [Opt] fixDates opts = do - ds <- today >>= return . dateComponents - return $ map (fixopt ds) opts + t <- today + return $ map (fixopt t) opts where - fixopt ds (Begin s) = Begin $ fixdate ds s - fixopt ds (End s) = End $ fixdate ds s - fixopt ds (Display s) = -- hacky + fixopt t (Begin s) = Begin $ fixdate t s + fixopt t (End s) = End $ fixdate t s + fixopt t (Display s) = -- hacky Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddate s - where fixbracketeddate s = "[" ++ (fixdate ds $ init $ tail s) ++ "]" + where fixbracketeddate s = "[" ++ (fixdate t $ init $ tail s) ++ "]" fixopt _ o = o -- | Convert a fuzzy date string to an explicit yyyy/mm/dd date, using the -- provided today's date for defaults. -fixdate :: (Integer,Int,Int) -> String -> String -fixdate (thisy,thism,thisd) s = printf "%04s/%02s/%02s" y' m' d' - where +fixdate :: Date -> String -> String +fixdate t s = printf "%04s/%02s/%02s" y' m' d' + where + (ty,tm,td) = dateComponents t (y,m,d) = fromparse $ parsewith smartdate $ map toLower s (y',m',d') = case (y,m,d) of - ("","",d) -> (show thisy,show thism,d) - ("",m,d) -> (show thisy,m,d) - otherwise -> (y,m,d) + ("","","today") -> (show ty,show tm,show td) + ("","","yesterday") -> (show y, show m, show 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 ledgerFilePathFromOpts :: [Opt] -> IO String diff --git a/Tests.hs b/Tests.hs index 130f2b4f9..7962bd69d 100644 --- a/Tests.hs +++ b/Tests.hs @@ -98,18 +98,24 @@ misc_tests = TestList [ assertparseequal timelog1 (parsewith timelog timelog1_str) , "smartparsedate" ~: do - ds@(y,m,d) <- today >>= return . dateComponents - let str `gives` datestr = assertequal datestr (fixdate ds str) + t <- today + 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/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` (printf "%04d/04/02" y) - "2" `gives` (printf "%04d/%02d/02" y m) - "January" `gives` (printf "%04d/01/01" y) - "feb" `gives` (printf "%04d/02/01" y) + "4/2" `gives` (printf "%04d/04/02" ty) + "2" `gives` (printf "%04d/%02d/02" ty tm) + "January" `gives` (printf "%04d/01/01" ty) + "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