imp: fully support quarter syntax in smart dates and period expressions

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

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.

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