From 38e311211d37a99ab1e10d66fc9f2354f3ddc5c0 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Sat, 6 Nov 2021 11:32:55 +1100 Subject: [PATCH] lib!: Semigroup instance of PeriodicReportRow and PeriodicReport now preserves first prrName, rather than the second. Previously the second name would be taken, ignoring the first. --- hledger-lib/Hledger/Reports/ReportTypes.hs | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/hledger-lib/Hledger/Reports/ReportTypes.hs b/hledger-lib/Hledger/Reports/ReportTypes.hs index 07de958c1..6304ea154 100644 --- a/hledger-lib/Hledger/Reports/ReportTypes.hs +++ b/hledger-lib/Hledger/Reports/ReportTypes.hs @@ -29,6 +29,7 @@ module Hledger.Reports.ReportTypes , prrFullName , prrDisplayName , prrDepth +, prrAdd ) where import Data.Aeson (ToJSON(..)) @@ -103,12 +104,18 @@ instance Bifunctor PeriodicReportRow where second = fmap instance Semigroup b => Semigroup (PeriodicReportRow a b) where - (PeriodicReportRow _ amts1 t1 a1) <> (PeriodicReportRow n2 amts2 t2 a2) = - PeriodicReportRow n2 (sumPadded amts1 amts2) (t1 <> t2) (a1 <> a2) - where - sumPadded (a:as) (b:bs) = (a <> b) : sumPadded as bs - sumPadded as [] = as - sumPadded [] bs = bs + (<>) = prrAdd + +-- | Add two 'PeriodicReportRows', preserving the name of the first. +prrAdd :: Semigroup b => PeriodicReportRow a b -> PeriodicReportRow a b -> PeriodicReportRow a b +prrAdd (PeriodicReportRow n1 amts1 t1 a1) (PeriodicReportRow _ amts2 t2 a2) = + PeriodicReportRow n1 (zipWithPadded (<>) amts1 amts2) (t1 <> t2) (a1 <> a2) + +-- | Version of 'zipWith' which will not end on the shortest list, but will copy the rest of the longer list. +zipWithPadded :: (a -> a -> a) -> [a] -> [a] -> [a] +zipWithPadded f (a:as) (b:bs) = f a b : zipWithPadded f as bs +zipWithPadded _ as [] = as +zipWithPadded _ [] bs = bs -- | Figure out the overall date span of a PeriodicReport periodicReportSpan :: PeriodicReport a b -> DateSpan