diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index 0435478bc..b14b02fbd 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -303,15 +303,24 @@ ledgerEntry = do transactions <- ledgertransactions return $ balanceEntry $ Entry date status code description comment transactions "" -ledgerdate :: GenParser Char st Day -ledgerdate = do - y <- many1 digit - char '/' - m <- many1 digit - char '/' - d <- many1 digit +ledgerdate :: GenParser Char LedgerFileCtx Day +ledgerdate = try ledgerfulldate <|> ledgerpartialdate + +ledgerfulldate :: GenParser Char LedgerFileCtx Day +ledgerfulldate = do + (y,m,d) <- ymd many spacenonewline - return (fromGregorian (read y) (read m) (read d)) + return $ fromGregorian (read y) (read m) (read d) + +-- | Match a partial M/D date in a ledger. Warning, this terminates the +-- program if it finds a match when there is no default year specified. +ledgerpartialdate :: GenParser Char LedgerFileCtx Day +ledgerpartialdate = do + (_,m,d) <- md + many spacenonewline + y <- getYear + when (y==Nothing) $ error "partial date found, but no default year specified" + return $ fromGregorian (fromJust y) (read m) (read d) ledgerdatetime :: GenParser Char st UTCTime ledgerdatetime = do diff --git a/Tests.hs b/Tests.hs index 1a68ce0af..69e9f9c13 100644 --- a/Tests.hs +++ b/Tests.hs @@ -229,12 +229,18 @@ misc_tests = TestList [ assertparseequal price1 (parseWithCtx ledgerHistoricalPrice price1_str) , "ledgerDefaultYear" ~: do - -- something to check default year parsing doesn't blow up - rl <- rawledgerfromstring "Y2009\n" + rl <- rawledgerfromstring defaultyear_ledger_str + assertequal (fromGregorian 2009 1 1) (edate $ head $ entries rl) return () - ] +defaultyear_ledger_str = + "Y2009\n" ++ + "\n" ++ + "01/01 A\n" ++ + " a $1\n" ++ + " b\n" + newparse_tests = TestList [ sameParseTests ] where sameParseTests = TestList $ map sameParse [ account1, account2, account3, account4 ] sameParse (str1, str2)