From b6a5a3398e25e56cee3d2c0300c421f2bfebd9a2 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Wed, 25 Nov 2009 21:21:49 +0000
Subject: [PATCH] parsing: tighten up dates, error messages, tests

---
 Ledger/Dates.hs               | 23 ++++++++++++-----------
 Ledger/Parse.hs               | 33 ++++++++++++++-------------------
 tests/add-bad-date-fails.test |  1 +
 tests/effective-day.test      | 13 +++++++++++++
 tests/effective-print.test    |  2 +-
 tests/effective-register.test |  2 +-
 tests/print-long-account.test | 10 ++++++++++
 7 files changed, 52 insertions(+), 32 deletions(-)
 create mode 100644 tests/effective-day.test
 create mode 100644 tests/print-long-account.test

diff --git a/Ledger/Dates.hs b/Ledger/Dates.hs
index 047e4c721..804ebd6a0 100644
--- a/Ledger/Dates.hs
+++ b/Ledger/Dates.hs
@@ -259,20 +259,21 @@ ymd :: GenParser Char st SmartDate
 ymd = do
   y <- many1 digit
   datesepchar
-  m <- many1 digit
-  guard (read m <= 12)
+  m <- try (count 2 digit) <|> count 1 digit
+  guard (read m >= 1 && (read m <= 12))
+  -- when (read m < 1 || (read m > 12)) $ fail "bad month number specified"
   datesepchar
-  d <- many1 digit
-  guard (read d <= 31)
-  return (y,m,d)
+  d <- try (count 2 digit) <|> count 1 digit
+  when (read d < 1 || (read d > 31)) $ fail "bad day number specified"
+  return $ (y,m,d)
 
 ym :: GenParser Char st SmartDate
 ym = do
   y <- many1 digit
   guard (read y > 12)
   datesepchar
-  m <- many1 digit
-  guard (read m <= 12)
+  m <- try (count 2 digit) <|> count 1 digit
+  guard (read m >= 1 && (read m <= 12))
   return (y,m,"")
 
 y :: GenParser Char st SmartDate
@@ -289,11 +290,11 @@ d = do
 
 md :: GenParser Char st SmartDate
 md = do
-  m <- many1 digit
-  guard (read m <= 12)
+  m <- try (count 2 digit) <|> count 1 digit
+  guard (read m >= 1 && (read m <= 12))
   datesepchar
-  d <- many1 digit
-  guard (read d <= 31)
+  d <- try (count 2 digit) <|> count 1 digit
+  when (read d < 1 || (read d > 31)) $ fail "bad day number specified"
   return ("",m,d)
 
 months         = ["january","february","march","april","may","june",
diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs
index fe059a407..abf9304c2 100644
--- a/Ledger/Parse.hs
+++ b/Ledger/Parse.hs
@@ -290,7 +290,7 @@ ledgerHistoricalPrice = do
   char 'P' <?> "historical price"
   many spacenonewline
   date <- ledgerdate
-  many spacenonewline
+  many1 spacenonewline
   symbol1 <- commoditysymbol
   many spacenonewline
   (Mixed [Amount c q _]) <- someamount
@@ -313,11 +313,10 @@ ledgerDefaultYear = do
 ledgerTransaction :: GenParser Char LedgerFileCtx LedgerTransaction
 ledgerTransaction = do
   date <- ledgerdate <?> "transaction"
-  edate <- ledgereffectivedate
-  many1 spacenonewline
+  edate <- try (ledgereffectivedate <?> "effective date") <|> return Nothing
   status <- ledgerstatus
   code <- ledgercode
-  description <- liftM rstrip (many1 (noneOf ";\n") <?> "description")
+  description <- many1 spacenonewline >> liftM rstrip (many1 (noneOf ";\n") <?> "description")
   comment <- ledgercomment
   restofline
   postings <- ledgerpostings
@@ -326,22 +325,12 @@ ledgerTransaction = do
     Right t' -> return t'
     Left err -> fail err
 
-ledgereffectivedate :: GenParser Char LedgerFileCtx (Maybe Day)
-ledgereffectivedate = 
-    try (do
-          string "[="
-          edate <- ledgerdate
-          char ']'
-          return $ Just edate)
-    <|> return Nothing
-
 ledgerdate :: GenParser Char LedgerFileCtx Day
-ledgerdate = try ledgerfulldate <|> ledgerpartialdate
+ledgerdate = (try ledgerfulldate <|> ledgerpartialdate) <?> "full or partial date"
 
 ledgerfulldate :: GenParser Char LedgerFileCtx Day
 ledgerfulldate = do
   (y,m,d) <- ymd
-  many spacenonewline
   return $ fromGregorian (read y) (read m) (read d)
 
 -- | Match a partial M/D date in a ledger. Warning, this terminates the
@@ -349,7 +338,6 @@ ledgerfulldate = do
 ledgerpartialdate :: GenParser Char LedgerFileCtx Day
 ledgerpartialdate = do
   (_,m,d) <- md
-  many spacenonewline
   y <- getYear
   when (y==Nothing) $ fail "partial date found, but no default year specified"
   return $ fromGregorian (fromJust y) (read m) (read d)
@@ -363,15 +351,21 @@ ledgerdatetime = do
   s <- optionMaybe $ do
       char ':'
       many1 digit
-  many spacenonewline
   let tod = TimeOfDay (read h) (read m) (maybe 0 (fromIntegral.read) s)
   return $ LocalTime day tod
 
+ledgereffectivedate :: GenParser Char LedgerFileCtx (Maybe Day)
+ledgereffectivedate = do
+  string "[="
+  edate <- ledgerdate
+  char ']'
+  return $ Just edate
+
 ledgerstatus :: GenParser Char st Bool
-ledgerstatus = try (do { char '*' <?> "status"; many1 spacenonewline; return True } ) <|> return False
+ledgerstatus = try (do { many1 spacenonewline; char '*' <?> "status"; return True } ) <|> return False
 
 ledgercode :: GenParser Char st String
-ledgercode = try (do { char '(' <?> "code"; code <- anyChar `manyTill` char ')'; many1 spacenonewline; return code } ) <|> return ""
+ledgercode = try (do { many1 spacenonewline; char '(' <?> "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""
 
 -- Complicated to handle intermixed comment lines.. please make me better.
 ledgerpostings :: GenParser Char LedgerFileCtx [Posting]
@@ -560,6 +554,7 @@ timelogentry = do
   code <- oneOf "bhioO"
   many1 spacenonewline
   datetime <- ledgerdatetime
+  many1 spacenonewline
   comment <- liftM2 (++) getParentAccount restofline
   return $ TimeLogEntry (read [code]) datetime comment
 
diff --git a/tests/add-bad-date-fails.test b/tests/add-bad-date-fails.test
index 5a67ba506..a416f6ed3 100644
--- a/tests/add-bad-date-fails.test
+++ b/tests/add-bad-date-fails.test
@@ -1,3 +1,4 @@
+# add should prompt again when it gets a bad date
 add
 <<<
 2009/1/32
diff --git a/tests/effective-day.test b/tests/effective-day.test
new file mode 100644
index 000000000..0325e5f9e
--- /dev/null
+++ b/tests/effective-day.test
@@ -0,0 +1,13 @@
+# 
+-f - print --effective
+<<<
+Y 2009
+
+2009/1/1[=1/2] x
+  a  1
+  b
+>>>
+2009/01/02 x
+    a             1
+    b            -1
+
diff --git a/tests/effective-print.test b/tests/effective-print.test
index 99df8db80..0585f81cd 100644
--- a/tests/effective-print.test
+++ b/tests/effective-print.test
@@ -4,7 +4,7 @@
   a  1
   b
 >>>
-2010/01/01  x
+2010/01/01 x
     a                                              1
     b
 
diff --git a/tests/effective-register.test b/tests/effective-register.test
index 154f8fa36..f25a2a033 100644
--- a/tests/effective-register.test
+++ b/tests/effective-register.test
@@ -4,5 +4,5 @@
   a  1
   b
 >>>
-2010/01/01  x                   a                                 1            1
+2010/01/01 x                    a                                 1            1
                                 b                                -1            0
diff --git a/tests/print-long-account.test b/tests/print-long-account.test
new file mode 100644
index 000000000..e1dd1b0c9
--- /dev/null
+++ b/tests/print-long-account.test
@@ -0,0 +1,10 @@
+-f - print
+<<<
+2009/1/1 x
+ aaaaabbbbbcccccdddddeeeeefffffggggghhhhh   1
+ b
+>>>
+2009/01/01 x
+    aaaaabbbbbcccccdddddeeeeefffffggggghhhhh             1
+    b                                                   -1
+