From 714b346fdd9ce67507355dcf74806dd70f033b5c Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 23 Jun 2025 18:37:08 -0700 Subject: [PATCH] imp: fully support quarter syntax in smart dates and period expressions --- hledger-lib/Hledger/Data/Dates.hs | 112 +++++++++++++++++++-------- hledger/hledger.m4.md | 13 +++- hledger/test/register/intervals.test | 54 +++++++++++++ 3 files changed, 145 insertions(+), 34 deletions(-) diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 163003cdc..96c4cc428 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -89,7 +89,7 @@ import Control.Applicative (Applicative(..)) import Control.Applicative.Permutations import Control.Monad (guard, unless) import qualified Control.Monad.Fail as Fail (MonadFail, fail) -import Data.Char (digitToInt, isDigit, ord) +import Data.Char (digitToInt, isDigit) import Data.Default (def) import Data.Foldable (asum) import Data.Function (on) @@ -910,7 +910,8 @@ smartdate :: TextParser m SmartDate smartdate = choice' -- XXX maybe obscures date errors ? see ledgerdate [ relativeP - , yyyymmdd, ymd + , yyyymmdd + , ymd , (\(m,d) -> SmartFromReference (Just m) d) <$> md , failIfInvalidDate . SmartFromReference Nothing =<< decimal , SmartMonth <$> (month <|> mon) @@ -1141,12 +1142,11 @@ reportingintervalp = choice' ] periodexprdatespanp :: Day -> TextParser m DateSpan -periodexprdatespanp rdate = choice $ map try [ +periodexprdatespanp rdate = choice' [ doubledatespanp rdate, - quarterdatespanp rdate, fromdatespanp rdate, todatespanp rdate, - justdatespanp rdate + indatespanp rdate ] -- | @@ -1162,45 +1162,95 @@ periodexprdatespanp rdate = choice $ map try [ -- Right DateSpan 2017 doubledatespanp :: Day -> TextParser m DateSpan doubledatespanp rdate = liftA2 fromToSpan - (optional ((string' "from" <|> string' "since") *> skipNonNewlineSpaces) *> smartdate) + (optional ((string' "from" <|> string' "since") *> skipNonNewlineSpaces) *> smartdateorquarterstartp rdate) (skipNonNewlineSpaces *> choice [string' "to", string "..", string "-"] - *> skipNonNewlineSpaces *> smartdate) + *> skipNonNewlineSpaces *> smartdateorquarterstartp rdate) where fromToSpan = DateSpan `on` (Just . fixSmartDate rdate) -- | --- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "q1" --- Right DateSpan 2018Q1 --- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "Q1" --- Right DateSpan 2018Q1 --- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "2020q4" --- Right DateSpan 2020Q4 -quarterdatespanp :: Day -> TextParser m DateSpan -quarterdatespanp rdate = do - y <- yearp <|> pure (first3 $ toGregorian rdate) - q <- char' 'q' *> satisfy is4Digit - return . periodAsDateSpan $ QuarterPeriod y (digitToInt q) - where - is4Digit c = (fromIntegral (ord c - ord '1') :: Word) <= 3 - +-- >>> let p = parsewith (fromdatespanp (fromGregorian 2024 02 02) <* eof) +-- >>> p "2025-01-01.." +-- Right DateSpan 2025-01-01.. +-- >>> p "2025Q1.." +-- Right DateSpan 2025-01-01.. +-- >>> p "from q2" +-- Right DateSpan 2024-04-01.. fromdatespanp :: Day -> TextParser m DateSpan fromdatespanp rdate = fromSpan <$> choice - [ (string' "from" <|> string' "since") *> skipNonNewlineSpaces *> smartdate - , smartdate <* choice [string "..", string "-"] - ] + [ (string' "from" <|> string' "since") *> skipNonNewlineSpaces *> smartdateorquarterstartp rdate + , smartdateorquarterstartp rdate <* choice [string "..", string "-"] + ] where fromSpan b = DateSpan (Just $ fixSmartDate rdate b) Nothing +-- | +-- >>> let p = parsewith (todatespanp (fromGregorian 2024 02 02) <* eof) +-- >>> p "..2025-01-01" +-- Right DateSpan ..2024-12-31 +-- >>> p "..2025Q1" +-- Right DateSpan ..2024-12-31 +-- >>> p "to q2" +-- Right DateSpan ..2024-03-31 todatespanp :: Day -> TextParser m DateSpan todatespanp rdate = - choice [string' "to", string' "until", string "..", string "-"] - *> skipNonNewlineSpaces - *> (DateSpan Nothing . Just . fixSmartDate rdate <$> smartdate) + choice [string' "to", string' "until", string "..", string "-"] + *> skipNonNewlineSpaces + *> (DateSpan Nothing . Just . fixSmartDate rdate <$> smartdateorquarterstartp rdate) -justdatespanp :: Day -> TextParser m DateSpan -justdatespanp rdate = - optional (string' "in" *> skipNonNewlineSpaces) - *> (spanFromSmartDate rdate <$> smartdate) +-- |j +-- >>> let p = parsewith (indatespanp (fromGregorian 2024 02 02) <* eof) +-- >>> p "2025-01-01" +-- Right DateSpan 2025-01-01 +-- >>> p "2025q1" +-- Right DateSpan 2025Q1 +-- >>> p "in Q2" +-- Right DateSpan 2024Q2 +indatespanp :: Day -> TextParser m DateSpan +indatespanp rdate = + optional (string' "in" *> skipNonNewlineSpaces) + *> choice' [ + quarterspanp rdate, + spanFromSmartDate rdate <$> smartdate + ] + +-- Helper: parse a quarter number, optionally preceded by a year. +quarterp :: Day -> TextParser m (Year, Int) +quarterp rdate = do + y <- yearp <|> pure (first3 $ toGregorian rdate) + n <- char' 'q' *> satisfy (`elem` ['1' .. '4']) >>= return . digitToInt + return (y, n) + +-- | Parse a single quarter (YYYYqN or qN, case insensitive q) as a date span. +-- +-- >>> parsewith (quarterspanp (fromGregorian 2018 01 01) <* eof) "q1" +-- Right DateSpan 2018Q1 +-- >>> parsewith (quarterspanp (fromGregorian 2018 01 01) <* eof) "Q1" +-- Right DateSpan 2018Q1 +-- >>> parsewith (quarterspanp (fromGregorian 2018 01 01) <* eof) "2020q4" +-- Right DateSpan 2020Q4 +quarterspanp :: Day -> TextParser m DateSpan +quarterspanp rdate = do + (y,q) <- quarterp rdate + return . periodAsDateSpan $ QuarterPeriod y q + +-- | Parse a quarter (YYYYqN or qN, case insensitive q) as its start date. +-- +-- >>> parsewith (quarterstartp (fromGregorian 2025 02 02) <* eof) "q1" +-- Right 2025-01-01 +-- >>> parsewith (quarterstartp (fromGregorian 2025 02 02) <* eof) "Q2" +-- Right 2025-04-01 +-- >>> parsewith (quarterstartp (fromGregorian 2025 02 02) <* eof) "2025q4" +-- Right 2025-10-01 +quarterstartp :: Day -> TextParser m Day +quarterstartp rdate = do + (y,q) <- quarterp rdate + return $ + fromMaybe (error' "Hledger.Data.Dates.quarterstartp: invalid date found") $ -- PARTIAL, shouldn't happen + periodStart $ QuarterPeriod y q + +smartdateorquarterstartp :: Day -> TextParser m SmartDate +smartdateorquarterstartp rdate = choice' [SmartCompleteDate <$> quarterstartp rdate, smartdate] nulldatespan :: DateSpan nulldatespan = DateSpan Nothing Nothing diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index 733c335ca..13d64b108 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -4954,17 +4954,24 @@ during January 2020 (the smallest common period, with the -p overriding -b and - In hledger's user interfaces (though not in the journal file), you can optionally use "smart date" syntax. Smart dates can be written with english words, can be relative, and can have parts omitted. Missing parts are inferred as 1, when needed. -Smart dates can be interpreted as dates or periods depending on context. +Smart dates can be interpreted as dates or periods depending on the context. Examples: -`2004-01-01`, `2004/10/1`, `2004.9.1`, `20240504` +`2004-01-01`, `2004/10/1`, `2004.9.1`, `20240504`, `2024Q1` :\ Exact dates. The year must have at least four digits, the month must be 1-12, the day must be 1-31, the separator can be `-` or `/` or `.` or nothing. +The q can be upper or lower case and the quarter number must be 1-4. `2004-10` : start of month +`2004q3` +: start of third quarter of 2004 + +v`q3` +: start of third quarter of current year + `2004` : start of year @@ -5047,7 +5054,7 @@ For example, if the journal's last transaction is on february 20th, - `hledger register` will end the report on february 20th. - `hledger register --monthly` will end the report at the end of february. -- `hledger register --monthly --end 2/14` also will end the report at the end of february. +- `hledger register --monthly --end 2/14` also will end the report at the end of february (overriding the requested end date). - `hledger register --monthly --begin 1/5 --end 2/14` will end the report on march 4th [1]. [1] Since hledger 1.29. diff --git a/hledger/test/register/intervals.test b/hledger/test/register/intervals.test index bab531ac3..7ddb1d589 100644 --- a/hledger/test/register/intervals.test +++ b/hledger/test/register/intervals.test @@ -247,3 +247,57 @@ $ hledger -f- reg mondays --forecast=2024 2024-01-08 (mondays) 1 1 2024-02-12 (mondays) 1 2 +# ** 20. using quarters as start/end dates +< +2025-06-01 + (a) 1 + +2025-07-01 + (a) 1 + +2025-08-01 + (a) 1 + +2025-09-01 + (a) 1 + +2025-10-01 + (a) 1 + +2025-11-01 + (a) 1 + +2025-12-01 + (a) 1 + +2026-01-01 + (a) 1 + +2026-02-01 + (a) 1 + +2026-03-01 + (a) 1 + +2026-04-01 + (a) 1 + +2026-05-01 + (a) 1 + +2026-06-01 + (a) 1 + +$ hledger -f - reg --today=2025 -p q4-2026q2 +2025-10-01 (a) 1 1 +2025-11-01 (a) 1 2 +2025-12-01 (a) 1 3 +2026-01-01 (a) 1 4 +2026-02-01 (a) 1 5 +2026-03-01 (a) 1 6 + +# ** 21. using a quarter as the period +$ hledger -f - --forecast=2025 reg --today=2025 -p q4 +2025-10-01 (a) 1 1 +2025-11-01 (a) 1 2 +2025-12-01 (a) 1 3