diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 25e06983f..28cb9b4f6 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/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) diff --git a/hledger-lib/Hledger/Read/Journal.hs b/hledger-lib/Hledger/Read/Journal.hs index 52227edc7..a3d4783b6 100644 --- a/hledger-lib/Hledger/Read/Journal.hs +++ b/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" - -ledgerfulldate :: GenParser Char JournalContext Day -ledgerfulldate = do - (y,m,d) <- ymd - return $ fromGregorian (read y) (read m) (read d) - --- | Match a partial M/D date in a ledger, and also require that a default --- year directive was previously encountered. -ledgerpartialdate :: GenParser Char JournalContext Day -ledgerpartialdate = do - (_,m,d) <- md - y <- getYear - when (isNothing y) $ fail "partial date found, but no default year specified" - return $ fromGregorian (fromJust y) (read m) (read d) +ledgerdate = do + -- hacky: try to ensure precise errors for invalid dates + -- XXX reported error position is not too good + -- pos <- getPosition + datestr <- many1 $ choice' [digit, datesepchar] + let dateparts = wordsBy (`elem` datesepchars) datestr + case dateparts of + [y,m,d] -> do + failIfInvalidYear y + failIfInvalidMonth m + failIfInvalidDay d + return $ fromGregorian (read y) (read m) (read d) + [m,d] -> do + y <- getYear + 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 diff --git a/hledger.cabal b/hledger.cabal index 4722df0ec..b148f0713 100644 --- a/hledger.cabal +++ b/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