parsing: fix obscured date parse errors with parsec 3; require split

With parsec 3, invalid date errors were not being reported properly.
This should be more robust.

hledger-lib/Hledger/Data/Dates.hs

@@ -265,6 +265,7 @@ Assumes any text in the parse stream has been lowercased.
 -}
 smartdate :: GenParser Char st SmartDate
 smartdate = do
+  -- XXX maybe obscures date errors ? see ledgerdate
   (y,m,d) <- choice' [yyyymmdd, ymd, ym, md, y, d, month, mon, today, yesterday, tomorrow, lastthisnextthing]
   return (y,m,d)
 
@@ -276,7 +277,8 @@ smartdateonly = do
   eof
   return d
 
-datesepchar = oneOf "/-."
+datesepchars = "/-."
+datesepchar = oneOf datesepchars
 
 validYear, validMonth, validDay :: String -> Bool
 validYear s = length s >= 4 && isJust (readMay s :: Maybe Int)

hledger-lib/Hledger/Read/Journal.hs

@@ -117,6 +117,7 @@ module Hledger.Read.Journal (
 )
 where
 import Control.Monad.Error (ErrorT(..), throwError, catchError)
+import Data.List.Split (wordsBy)
 import Text.ParserCombinators.Parsec hiding (parse)
 #if __GLASGOW_HASKELL__ <= 610
 import Prelude hiding (readFile, putStr, putStrLn, print, getContents)
@@ -331,21 +332,27 @@ ledgerTransaction = do
     Left err -> fail err
 
 ledgerdate :: GenParser Char JournalContext Day
-ledgerdate = choice' [ledgerfulldate, ledgerpartialdate] <?> "full or partial date"
+ledgerdate = do
-
+  -- hacky: try to ensure precise errors for invalid dates
-ledgerfulldate :: GenParser Char JournalContext Day
+  -- XXX reported error position is not too good
-ledgerfulldate = do
+  -- pos <- getPosition
-  (y,m,d) <- ymd
+  datestr <- many1 $ choice' [digit, datesepchar]
-  return $ fromGregorian (read y) (read m) (read d)
+  let dateparts = wordsBy (`elem` datesepchars) datestr
-
+  case dateparts of
--- | Match a partial M/D date in a ledger, and also require that a default
+    [y,m,d] -> do
--- year directive was previously encountered.
+               failIfInvalidYear y
-ledgerpartialdate :: GenParser Char JournalContext Day
+               failIfInvalidMonth m
-ledgerpartialdate = do
+               failIfInvalidDay d
-  (_,m,d) <- md
+               return $ fromGregorian (read y) (read m) (read d)
-  y <- getYear
+    [m,d]   -> do
-  when (isNothing y) $ fail "partial date found, but no default year specified"
+               y <- getYear
-  return $ fromGregorian (fromJust y) (read m) (read d)
+               case y of Nothing -> fail "partial date found, but no default year specified"
+                         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
 ledgerdatetime = do 

hledger.cabal

@@ -91,6 +91,7 @@ executable hledger
                  ,process
                  ,regexpr >= 0.5.1
                  ,safe >= 0.2
+                 ,split == 0.1.*
                  ,time
                  ,utf8-string >= 0.3
 
@@ -168,6 +169,7 @@ library
                  ,process
                  ,regexpr >= 0.5.1
                  ,safe >= 0.2
+                 ,split == 0.1.*
                  ,time
                  ,utf8-string >= 0.3