parsing: more careful validation of eg leap years in transaction dates (only)

hledger-lib/Hledger/Data/Dates.hs

@@ -18,6 +18,8 @@ quarterly, etc.
 
 -}
 
+-- XXX fromGregorian silently clips bad dates, use fromGregorianValid instead ?
+
 module Hledger.Data.Dates
 where
 

hledger-lib/Hledger/Read/JournalReader.hs

@@ -347,20 +347,15 @@ ledgerdate = do
   -- pos <- getPosition
   datestr <- many1 $ choice' [digit, datesepchar]
   let dateparts = wordsBy (`elem` datesepchars) datestr
-  case dateparts of
+  currentyear <- getYear
-    [y,m,d] -> do
+  let [y,m,d] = case (dateparts,currentyear) of
-               failIfInvalidYear y
+                  ([m,d],Just y)  -> [show y,m,d]
-               failIfInvalidMonth m
+                  ([_,_],Nothing) -> fail $ "partial date "++datestr++" found, but the current year is unknown"
-               failIfInvalidDay d
+                  _               -> dateparts
-               return $ fromGregorian (read y) (read m) (read d)
+      maybedate = fromGregorianValid (read y) (read m) (read d)
-    [m,d]   -> do
+  case maybedate of
-               y <- getYear
+    Nothing   -> fail $ "bad date: " ++ datestr
-               case y of Nothing -> fail "partial date found, but no default year specified"
+    Just date -> return date
-                         Just y' -> do failIfInvalidYear $ show y'
-                                       failIfInvalidMonth m
-                                       failIfInvalidDay d
-                                       return $ fromGregorian y' (read m) (read d)
-    _       -> fail $ "bad date: " ++ datestr
   <?> "full or partial date"
 
 ledgerdatetime :: GenParser Char JournalContext LocalTime

tests/parse-dates.test

@@ -5,7 +5,7 @@ bin/hledger -f- print
 2010/31/12 x
    a  1
    b
->>>2 /bad month number: 31/
+>>>2 /bad date/
 >>>= 1
 # 2. too-large day
 bin/hledger -f- print
@@ -13,7 +13,7 @@ bin/hledger -f- print
 2010/12/32 x
    a  1
    b
->>>2 /bad day number: 32/
+>>>2 /bad date/
 >>>= 1
 # 3. 29th feb on leap year should be ok
 bin/hledger -f- print
@@ -27,11 +27,11 @@ bin/hledger -f- print
     b            -1
 
 >>>= 0
-# 3. 29th feb on non-leap year should fail
+# 4. 29th feb on non-leap year should fail
 bin/hledger -f- print
 <<<
 2001/2/29 x
    a  1
    b
->>>2 /bad day number: 29/
+>>>2 /bad date/
 >>>= 1