diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 7465c1b6c..119d4b6eb 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/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 - , md - , ymd - , yd - , month - , mon + [ yyyymmdd, md, ymd, smartYear, smartDay, 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 -yd = do - n <- decimal - if n >= 1 && n <= 31 - then return $ SmartYMD Nothing Nothing (Just $ fromInteger n) - else return $ SmartYMD (Just n) Nothing Nothing +-- | Parse a year number from a Text, making sure that at least four digits are +-- used. +yearp :: TextParser m Integer +yearp = do + year <- takeWhile1P (Just "year") isDigit + 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", diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 475d0fc6b..5924ffabb 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/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 y + setYear =<< lift yearp defaultcommoditydirectivep :: JournalParser m () defaultcommoditydirectivep = do diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index f5f6954bd..203dae61c 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/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"