lib: quarterdatespanp (fixes #1247)

hledger-lib/Hledger/Data/Dates.hs

@@ -868,6 +868,10 @@ weekday = do
 -- Right (NoInterval,DateSpan 2008-08-01..2008-09-30)
 -- >>> p "aug to oct"
 -- Right (NoInterval,DateSpan 2008-08-01..2008-09-30)
+-- >>> p "2009q2"
+-- Right (NoInterval,DateSpan 2009Q2)
+-- >>> p "Q3"
+-- Right (NoInterval,DateSpan 2008Q3)
 -- >>> p "every 3 days in Aug"
 -- Right (Days 3,DateSpan 2008-08)
 -- >>> p "daily from aug"
@@ -973,6 +977,7 @@ reportingintervalp = choice'
 periodexprdatespanp :: Day -> TextParser m DateSpan
 periodexprdatespanp rdate = choice $ map try [
                             doubledatespanp rdate,
+                            quarterdatespanp rdate,
                             fromdatespanp rdate,
                             todatespanp rdate,
                             justdatespanp rdate
@@ -989,6 +994,19 @@ doubledatespanp rdate = liftA2 fromToSpan
   where
     fromToSpan = DateSpan `on` (Just . fixSmartDate rdate)
 
+-- |
+-- >>> parsewith (quarterdatespanp (parsedate "2018/01/01") <* eof) "q1"
+-- Right DateSpan 2018Q1
+-- >>> parsewith (quarterdatespanp (parsedate "2018/01/01") <* eof) "2020q4"
+-- Right DateSpan 2020Q4
+quarterdatespanp :: Day -> TextParser m DateSpan
+quarterdatespanp rdate = do
+  let defaultYear = first3 $ toGregorian rdate
+  y <- maybe defaultYear read <$> optional (count 4 digitChar)
+  char 'q'
+  q <- oneOf ("1234"::[Char])
+  return $ periodAsDateSpan $ QuarterPeriod y $ read [q]
+
 fromdatespanp :: Day -> TextParser m DateSpan
 fromdatespanp rdate = fromSpan <$> choice
     [ string' "from" *> skipNonNewlineSpaces *> smartdate