From 35c33f342b98ff68f7f02893fa36f35122b7c2d6 Mon Sep 17 00:00:00 2001
From: Stephen Morgan <morgan.stephen99@gmail.com>
Date: Fri, 17 Sep 2021 16:15:32 +1000
Subject: [PATCH] cln: Move column grouping functions form
 Report.PostingsReport to Data.Dates.

---
 hledger-lib/Hledger/Data/Dates.hs             | 36 ++++++++++++++-----
 hledger-lib/Hledger/Reports/PostingsReport.hs | 16 ++-------
 2 files changed, 31 insertions(+), 21 deletions(-)

diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs
index 426db548e..d494e0d0b 100644
--- a/hledger-lib/Hledger/Data/Dates.hs
+++ b/hledger-lib/Hledger/Data/Dates.hs
@@ -66,6 +66,7 @@ module Hledger.Data.Dates (
   latestSpanContaining,
   smartdate,
   splitSpan,
+  groupByDateSpan,
   fixSmartDate,
   fixSmartDateStr,
   fixSmartDateStrEither,
@@ -86,25 +87,28 @@ import Control.Applicative.Permutations
 import Control.Monad (guard, unless)
 import "base-compat-batteries" Data.List.Compat
 import Data.Char (digitToInt, isDigit, ord)
-import Data.Default
+import Data.Default (def)
 import Data.Foldable (asum)
 import Data.Function (on)
 import Data.Functor (($>))
-import Data.Maybe
+import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe)
+import Data.Ord (comparing)
 import qualified Data.Set as Set
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Format hiding (months)
 import Data.Time.Calendar
-import Data.Time.Calendar.OrdinalDate
-import Data.Time.Clock
-import Data.Time.LocalTime
+    (Day, addDays, addGregorianYearsClip, addGregorianMonthsClip, diffDays,
+     fromGregorian, fromGregorianValid, toGregorian)
+import Data.Time.Calendar.OrdinalDate (fromMondayStartWeek, mondayStartWeek)
+import Data.Time.Clock (UTCTime, diffUTCTime)
+import Data.Time.LocalTime (getZonedTime, localDay, zonedTimeToLocalTime)
 import Safe (headMay, lastMay, maximumMay, minimumMay)
 import Text.Megaparsec
-import Text.Megaparsec.Char
+import Text.Megaparsec.Char (char, char', digitChar, string, string')
 import Text.Megaparsec.Char.Lexer (decimal)
-import Text.Megaparsec.Custom
-import Text.Printf
+import Text.Megaparsec.Custom (customErrorBundlePretty)
+import Text.Printf (printf)
 
 import Hledger.Data.Types
 import Hledger.Data.Period
@@ -273,6 +277,22 @@ spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e
 periodContainsDate :: Period -> Day -> Bool
 periodContainsDate p = spanContainsDate (periodAsDateSpan p)
 
+-- | Group elements based on where they fall in a list of 'DateSpan's without
+-- gaps. The precondition is not checked.
+groupByDateSpan :: Bool -> (a -> Day) -> [DateSpan] -> [a] -> [(DateSpan, [a])]
+groupByDateSpan showempty date colspans =
+      groupByCols colspans
+    . dropWhile (beforeStart . fst)
+    . sortBy (comparing fst)
+    . map (\x -> (date x, x))
+  where
+    groupByCols []     _  = []
+    groupByCols (c:cs) [] = if showempty then (c, []) : groupByCols cs [] else []
+    groupByCols (c:cs) ps = (c, map snd matches) : groupByCols cs later
+      where (matches, later) = span ((spanEnd c >) . Just . fst) ps
+
+    beforeStart = maybe (const True) (>) $ spanStart =<< headMay colspans
+
 -- | Calculate the intersection of a number of datespans.
 spansIntersect [] = nulldatespan
 spansIntersect [d] = d
diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs
index 8e3af8555..f9905b9e5 100644
--- a/hledger-lib/Hledger/Reports/PostingsReport.hs
+++ b/hledger-lib/Hledger/Reports/PostingsReport.hs
@@ -21,10 +21,9 @@ module Hledger.Reports.PostingsReport (
 )
 where
 
-import Data.List (nub, sortBy, sortOn)
+import Data.List (nub, sortOn)
 import Data.List.Extra (nubSort)
 import Data.Maybe (fromMaybe, isJust, isNothing)
-import Data.Ord (comparing)
 import Data.Text (Text)
 import Data.Time.Calendar (Day)
 import Safe (headMay)
@@ -176,22 +175,13 @@ mkpostingsReportItem showdate showdesc wd mperiod p b =
 -- Each summary posting will have a non-Nothing interval end date.
 summarisePostingsByInterval :: Interval -> WhichDate -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting]
 summarisePostingsByInterval interval wd mdepth showempty reportspan =
-    concatMap (\(s,ps) -> summarisePostingsInDateSpan s wd mdepth showempty $ map snd ps)
+    concatMap (\(s,ps) -> summarisePostingsInDateSpan s wd mdepth showempty ps)
     -- Group postings into their columns. We try to be efficient, since
     -- there can possibly be a very large number of intervals (cf #1683)
-    . groupByCols colspans
-    . dropWhile (beforeStart . fst)
-    . sortBy (comparing fst)
-    . map (\p -> (getDate p, p))
+    . groupByDateSpan showempty getDate colspans
   where
-    groupByCols []     _  = []
-    groupByCols (c:cs) [] = if showempty then (c,[]) : groupByCols cs [] else []
-    groupByCols (c:cs) ps = (c, matches) : groupByCols cs later
-      where (matches, later) = span ((spanEnd c >) . Just . fst) ps
-
     -- The date spans to be included as report columns.
     colspans = splitSpan interval reportspan
-    beforeStart = maybe (const True) (>) $ spanStart =<< headMay colspans
     getDate = case wd of
         PrimaryDate   -> postingDate
         SecondaryDate -> postingDate2