lib: Ensure parsed years have at least 4 digits.

hledger-lib/Hledger/Data/Dates.hs

@@ -71,6 +71,7 @@ module Hledger.Data.Dates (
   fixSmartDateStr,
   fixSmartDateStrEither,
   fixSmartDateStrEither',
+  yearp,
   daysInSpan,
   maybePeriod,
   mkdatespan,
@@ -84,6 +85,7 @@ import Control.Applicative (liftA2)
 import Control.Applicative.Permutations
 import Control.Monad (guard, unless)
 import "base-compat-batteries" Data.List.Compat
+import Data.Char (isDigit)
 import Data.Default
 import Data.Foldable (asum)
 import Data.Function (on)
@@ -763,12 +765,7 @@ Right (SmartYMD (Just 201813012) Nothing Nothing)
 smartdate :: TextParser m SmartDate
 smartdate = choice'
   -- XXX maybe obscures date errors ? see ledgerdate
-    [ yyyymmdd
+    [ yyyymmdd, md, ymd, smartYear, smartDay, month, mon
-    , md
-    , ymd
-    , yd
-    , month
-    , mon
     , SmartRel This Day <$ string' "today"
     , SmartRel Last Day <$ string' "yesterday"
     , SmartRel Next Day <$ string' "tomorrow"
@@ -778,6 +775,11 @@ smartdate = choice'
     seqP = choice [This <$ string' "this", Last <$ string' "last", Next <$ string' "next"]
     intervalP = choice [Day <$ string' "day", Week <$ string' "week", Month <$ string' "month",
                         Quarter <$ string' "quarter", Year <$ string' "year"]
+    smartYear = (\y -> SmartYMD (Just y) Nothing Nothing) <$> yearp
+    smartDay = do
+      d <- SmartYMD Nothing Nothing . Just <$> decimal
+      failIfInvalidDate d
+      return d
 
 -- | Like smartdate, but there must be nothing other than whitespace after the date.
 smartdateonly :: TextParser m SmartDate
@@ -812,7 +814,7 @@ yyyymmdd = do
 
 ymd :: TextParser m SmartDate
 ymd = do
-  y <- decimal
+  y <- yearp
   sep <- datesepchar
   m <- decimal
   d <- optional $ char sep *> decimal
@@ -829,12 +831,13 @@ md = do
   failIfInvalidDate date
   return date
 
-yd :: TextParser m SmartDate
+-- | Parse a year number from a Text, making sure that at least four digits are
-yd = do
+-- used.
-  n <- decimal
+yearp :: TextParser m Integer
-  if n >= 1 && n <= 31
+yearp = do
-     then return $ SmartYMD Nothing Nothing (Just $ fromInteger n)
+  year <- takeWhile1P (Just "year") isDigit
-     else return $ SmartYMD (Just n) Nothing Nothing
+  unless (T.length year >= 4) . Fail.fail $ "Year must contain at least 4 digits: " <> T.unpack year
+  return $ readDecimal year
 
 -- These are compared case insensitively, and should all be kept lower case.
 months         = ["january","february","march","april","may","june",

hledger-lib/Hledger/Read/JournalReader.hs

@@ -98,7 +98,6 @@ import Data.Time.LocalTime
 import Safe
 import Text.Megaparsec hiding (parse)
 import Text.Megaparsec.Char
-import Text.Megaparsec.Char.Lexer (decimal)
 import Text.Megaparsec.Custom
 import Text.Printf
 import System.FilePath
@@ -553,8 +552,7 @@ defaultyeardirectivep :: JournalParser m ()
 defaultyeardirectivep = do
   char 'Y' <?> "default year"
   lift skipNonNewlineSpaces
-  y <- decimal
+  setYear =<< lift yearp
-  setYear y
 
 defaultcommoditydirectivep :: JournalParser m ()
 defaultcommoditydirectivep = do

hledger-lib/Hledger/Utils/Text.hs

@@ -50,12 +50,14 @@ module Hledger.Utils.Text
  -- fitStringMulti,
   textPadLeftWide,
   textPadRightWide,
+  -- -- * Reading
+  readDecimal,
   -- -- * tests
   tests_Text
   )
 where
 
--- import Data.Char
+import Data.Char (digitToInt)
 import Data.List
 #if !(MIN_VERSION_base(4,11,0))
 import Data.Monoid
@@ -400,6 +402,13 @@ textWidth s = maximum $ map (T.foldr (\a b -> charWidth a + b) 0) $ T.lines s
 --         | otherwise                        -> 1
 
 
+-- | Read a decimal number from a Text. Assumes the input consists only of digit
+-- characters.
+readDecimal :: Integral a => Text -> a
+readDecimal = foldl' step 0 . T.unpack
+  where step a c = a * 10 + fromIntegral (digitToInt c)
+
+
 tests_Text = tests "Text" [
    test "quoteIfSpaced" $ do
      quoteIfSpaced "a'a" @?= "a'a"