lib: datep now requires years to be at least four digits.

hledger-lib/Hledger/Read/Common.hs

@@ -12,20 +12,20 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read.
 -}
 
 --- ** language
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns        #-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase          #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NamedFieldPuns      #-}
-{-# LANGUAGE NoMonoLocalBinds #-}
+{-# LANGUAGE NoMonoLocalBinds    #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE PackageImports      #-}
-{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE Rank2Types          #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections       #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies        #-}
 
 --- ** exports
 module Hledger.Read.Common (
@@ -446,45 +446,44 @@ datep = do
 
 datep' :: Maybe Year -> TextParser m Day
 datep' mYear = do
-  startOffset <- getOffset
+    startOffset <- getOffset
-  d1 <- decimal <?> "year or month"
+    d1 <- yearorintp <?> "year or month"
-  sep <- satisfy isDateSepChar <?> "date separator"
+    sep <- datesepchar <?> "date separator"
-  d2 <- decimal <?> "month or day"
+    d2 <- decimal <?> "month or day"
-  fullDate startOffset d1 sep d2 <|> partialDate startOffset mYear d1 sep d2
+    case d1 of
-  <?> "full or partial date"
+         Left y  -> fullDate startOffset y sep d2
-
+         Right m -> partialDate startOffset mYear m sep d2
+    <?> "full or partial date"
   where
+    fullDate :: Int -> Year -> Char -> Month -> TextParser m Day
+    fullDate startOffset year sep1 month = do
+      sep2 <- satisfy isDateSepChar <?> "date separator"
+      day <- decimal <?> "day"
+      endOffset <- getOffset
+      let dateStr = show year ++ [sep1] ++ show month ++ [sep2] ++ show day
 
-  fullDate :: Int -> Integer -> Char -> Int -> TextParser m Day
+      when (sep1 /= sep2) $ customFailure $ parseErrorAtRegion startOffset endOffset $
-  fullDate startOffset year sep1 month = do
+        "invalid date (mixing date separators is not allowed): " ++ dateStr
-    sep2 <- satisfy isDateSepChar <?> "date separator"
-    day <- decimal <?> "day"
-    endOffset <- getOffset
-    let dateStr = show year ++ [sep1] ++ show month ++ [sep2] ++ show day
 
-    when (sep1 /= sep2) $ customFailure $ parseErrorAtRegion startOffset endOffset $
+      case fromGregorianValid year month day of
-      "invalid date (mixing date separators is not allowed): " ++ dateStr
+        Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $
+                     "well-formed but invalid date: " ++ dateStr
+        Just date -> pure $! date
 
-    case fromGregorianValid year month day of
+    partialDate :: Int -> Maybe Year -> Month -> Char -> MonthDay -> TextParser m Day
-      Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $
+    partialDate startOffset mYear month sep day = do
-                   "well-formed but invalid date: " ++ dateStr
+      endOffset <- getOffset
-      Just date -> pure $! date
+      case mYear of
+        Just year ->
+          case fromGregorianValid year month day of
+            Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $
+                        "well-formed but invalid date: " ++ dateStr
+            Just date -> pure $! date
+          where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day
 
-  partialDate
+        Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $
-    :: Int -> Maybe Year -> Integer -> Char -> Int -> TextParser m Day
+          "partial date "++dateStr++" found, but the current year is unknown"
-  partialDate startOffset mYear month sep day = do
+          where dateStr = show month ++ [sep] ++ show day
-    endOffset <- getOffset
-    case mYear of
-      Just year ->
-        case fromGregorianValid year (fromIntegral month) day of
-          Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $
-                      "well-formed but invalid date: " ++ dateStr
-          Just date -> pure $! date
-        where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day
-
-      Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $
-        "partial date "++dateStr++" found, but the current year is unknown"
-        where dateStr = show month ++ [sep] ++ show day
 
 {-# INLINABLE datep' #-}
 
@@ -551,6 +550,14 @@ secondarydatep :: Day -> TextParser m Day
 secondarydatep primaryDate = char '=' *> datep' (Just primaryYear)
   where primaryYear = first3 $ toGregorian primaryDate
 
+-- | Parse a year number or an Int. Years must contain at least four
+-- digits.
+yearorintp :: TextParser m (Either Year Int)
+yearorintp = do
+    yearOrMonth <- takeWhile1P (Just "digit") isDigit
+    let n = readDecimal yearOrMonth
+    return $ if T.length yearOrMonth >= 4 then Left n else Right (fromInteger n)
+
 --- *** account names
 
 -- | Parse an account name (plus one following space if present),

tests/journal/posting-dates.test

@@ -50,5 +50,5 @@ end comment
 2000/1/2
    b  0   ; [1/1=1/2/3/4] bad second date, should error
 
->>>2 /9:23/
+>>>2 /-:9:21/
 >>>=1