From 16e33b50e6764c3aa57277d9010f8b177fdbc8fe Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Thu, 22 Jan 2009 23:42:34 +0000
Subject: [PATCH] parse Y default year lines in a ledger, so they don't break
 it (ignoring them)

---
 Ledger/Parse.hs | 18 ++++++++++++++++++
 Tests.hs        |  5 +++++
 2 files changed, 23 insertions(+)

diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs
index 0d1a52f57..0435478bc 100644
--- a/Ledger/Parse.hs
+++ b/Ledger/Parse.hs
@@ -61,6 +61,12 @@ popParentAccount = do ctx0 <- getState
 getParentAccount :: GenParser tok LedgerFileCtx String
 getParentAccount = liftM (concat . reverse . ctxAccount) getState
 
+setYear :: Integer -> GenParser tok LedgerFileCtx ()
+setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
+
+getYear :: GenParser tok LedgerFileCtx (Maybe Integer)
+getYear = liftM ctxYear getState
+
 parseLedger :: FilePath -> String -> ErrorT String IO RawLedger
 parseLedger inname intxt = case runParser ledgerFile emptyCtx inname intxt of
                              Right m  -> liftM rawLedgerConvertTimeLog $ m `ap` (return rawLedgerEmpty)
@@ -79,6 +85,7 @@ ledgerFile = do entries <- many1 ledgerAnyEntry
                                   , liftM (return . addModifierEntry) ledgerModifierEntry
                                   , liftM (return . addPeriodicEntry) ledgerPeriodicEntry
                                   , liftM (return . addHistoricalPrice) ledgerHistoricalPrice
+                                  , ledgerDefaultYear
                                   , emptyLine >> return (return id)
                                   , liftM (return . addTimeLogEntry)  timelogentry
                                   ]
@@ -271,6 +278,17 @@ ledgerHistoricalPrice = do
   restofline
   return $ HistoricalPrice date symbol1 (symbol c) price
 
+-- like ledgerAccountBegin, updates the LedgerFileCtx
+ledgerDefaultYear :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
+ledgerDefaultYear = do
+  char 'Y' <?> "default year"
+  many spacenonewline
+  y <- many1 digit
+  let y' = read y
+  guard (y' >= 1000)
+  setYear y'
+  return $ return id
+
 ledgerEntry :: GenParser Char LedgerFileCtx Entry
 ledgerEntry = do
   date <- ledgerdate <?> "entry"
diff --git a/Tests.hs b/Tests.hs
index 07c99df48..6ea1c02a0 100644
--- a/Tests.hs
+++ b/Tests.hs
@@ -227,6 +227,11 @@ misc_tests = TestList [
   ,
   "ledgerentry"        ~: do
     assertparseequal price1 (parseWithCtx ledgerHistoricalPrice price1_str)
+  ,
+  "ledgerDefaultYear" ~: do
+    -- something to check default year parsing doesn't blow up
+    rl <- rawledgerfromstring "Y2009\n"
+
   ]
 
 newparse_tests = TestList [ sameParseTests ]