implement default year, allowing m/d dates in ledger

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 :: GenParser Char LedgerFileCtx Day
-ledgerdate = do 
+ledgerdate = try ledgerfulldate <|> ledgerpartialdate
-  y <- many1 digit
+
-  char '/'
+ledgerfulldate :: GenParser Char LedgerFileCtx Day
-  m <- many1 digit
+ledgerfulldate = do
-  char '/'
+  (y,m,d) <- ymd
-  d <- many1 digit
   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 

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 defaultyear_ledger_str
-    rl <- rawledgerfromstring "Y2009\n"
+    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)