From 1c60514973f16c971e9f2e1fd90a0e37837af15f Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 25 Nov 2008 23:52:42 +0000 Subject: [PATCH] tighten up date parsing, make it io-friendly and parse Y, M/D, D --- Ledger/Parse.hs | 43 +++++++++++++++++++++++++++++++++++++------ Options.hs | 16 ++++++++-------- Tests.hs | 12 +++++++++--- hledger.hs | 10 +++++----- 4 files changed, 59 insertions(+), 22 deletions(-) diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index acd234ffc..ccdce4469 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -500,10 +500,14 @@ smartdate = do (y,m,d) <- ( try ymd <|> try ym + <|> try md <|> try y --- <|> try md + <|> try d -- <|> try month -- <|> try mon +-- <|> try today +-- <|> try yesterday +-- <|> try tomorrow -- <|> try thiswhatever -- <|> try nextwhatever -- <|> try lastwhatever @@ -517,27 +521,54 @@ ymd = do y <- many digit datesep m <- many digit + guard (read m <= 12) datesep d <- many digit + guard (read d <= 31) return (y,m,d) ym :: Parser (String,String,String) ym = do y <- many digit + guard (read y > 12) datesep m <- many digit + guard (read m <= 12) return (y,m,"1") y :: Parser (String,String,String) y = do y <- many digit + guard (read y >= 1000) return (y,"1","1") --- | Parse a flexible date string, with awareness of the current time, --- and return a Date or raise an error. -smartparsedate :: String -> Date -smartparsedate s = parsedate $ printf "%04s/%02s/%02s" y m d - where (y,m,d) = fromparse $ parsewith smartdate s +d :: Parser (String,String,String) +d = do + d <- many digit + guard (read d <= 31) + return ("","",d) + +-- | Parse a M/D string as ("",M,D), year will be filled in later +md :: Parser (String,String,String) +md = do + m <- many digit + guard (read m <= 12) + datesep + d <- many digit + guard (read d <= 31) + return ("",m,d) + +-- | Parse a flexible date string to a Date with awareness of the current +-- time, or raise an error. +smartparsedate :: String -> IO Date +smartparsedate s = do + let (y,m,d) = fromparse $ parsewith smartdate s + (thisy,thism,_) <- today >>= return . dateComponents + let (y',m',d') = case (y,m,d) of + ("","",d) -> (show thisy,show thism,d) + ("",m,d) -> (show thisy,m,d) + otherwise -> (y,m,d) + return $ parsedate $ printf "%04s/%02s/%02s" y' m' d' type TransactionMatcher = Transaction -> Bool diff --git a/Options.hs b/Options.hs index a0f1c2fb8..ef193c7d1 100644 --- a/Options.hs +++ b/Options.hs @@ -113,11 +113,11 @@ tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs)) tildeExpand xs = return xs -- | Get the value of the begin date option, if any. -beginDateFromOpts :: [Opt] -> Maybe Date -beginDateFromOpts opts = +beginDateFromOpts :: [Opt] -> IO (Maybe Date) +beginDateFromOpts opts = case beginopts of - (x:_) -> Just $ smartparsedate $ last beginopts - _ -> Nothing + (x:_) -> smartparsedate (last beginopts) >>= return . Just + _ -> return Nothing where beginopts = concatMap getbegindate opts getbegindate (Begin s) = [s] @@ -125,11 +125,11 @@ beginDateFromOpts opts = defaultdate = "" -- | Get the value of the end date option, if any. -endDateFromOpts :: [Opt] -> Maybe Date -endDateFromOpts opts = +endDateFromOpts :: [Opt] -> IO (Maybe Date) +endDateFromOpts opts = do case endopts of - (x:_) -> Just $ smartparsedate $ last endopts - _ -> Nothing + (x:_) -> smartparsedate (last endopts) >>= return . Just + _ -> return Nothing where endopts = concatMap getenddate opts getenddate (End s) = [s] diff --git a/Tests.hs b/Tests.hs index 4e3eac84f..4f5b752c6 100644 --- a/Tests.hs +++ b/Tests.hs @@ -98,9 +98,15 @@ misc_tests = TestList [ assertparseequal timelog1 (parsewith timelog timelog1_str) , "smartparsedate" ~: do - assertequal (1999,12,13) (dateComponents $ smartparsedate "1999/12/13") - assertequal (2008,2,1) (dateComponents $ smartparsedate "2008-2") - assertequal (2008,1,1) (dateComponents $ smartparsedate "2008") + (thisyear,thismonth,thisday) <- today >>= return . dateComponents + d <- smartparsedate "1999-12-02"; assertequal (1999,12,2) (dateComponents d) + d <- smartparsedate "1999.12.02"; assertequal (1999,12,2) (dateComponents d) + d <- smartparsedate "1999/3/2"; assertequal (1999,3,2) (dateComponents d) + d <- smartparsedate "2008/2"; assertequal (2008,2,1) (dateComponents d) + d <- smartparsedate "20/2"; assertequal (20,2,1) (dateComponents d) + d <- smartparsedate "4/2"; assertequal (thisyear,4,2) (dateComponents d) + d <- smartparsedate "1000"; assertequal (1000,1,1) (dateComponents d) + d <- smartparsedate "2"; assertequal (thisyear,thismonth,2) (dateComponents d) ] balancereportacctnames_tests = TestList diff --git a/hledger.hs b/hledger.hs index ab08a7ec6..393fec349 100644 --- a/hledger.hs +++ b/hledger.hs @@ -68,12 +68,12 @@ main = do -- | parse the user's specified ledger file and do some action with it -- (or report a parse error). This function makes the whole thing go. parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO () -parseLedgerAndDo opts args cmd = - ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runcmd +parseLedgerAndDo opts args cmd = do + b <- beginDateFromOpts opts + e <- endDateFromOpts opts + let runcmd = cmd opts args . cacheLedger apats . filterRawLedger b e dpats c r . canonicaliseAmounts costbasis + ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runcmd where - runcmd = cmd opts args . cacheLedger apats . filterRawLedger b e dpats c r . canonicaliseAmounts costbasis - b = beginDateFromOpts opts - e = endDateFromOpts opts (apats,dpats) = parseAccountDescriptionArgs opts args c = Cleared `elem` opts r = Real `elem` opts