slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib!: Semigroup instance of PeriodicReportRow and PeriodicReport now

Browse Source 
preserves first prrName, rather than the second.

Previously the second name would be taken, ignoring the first.
This commit is contained in:
Stephen Morgan 2021-11-06 11:32:55 +11:00 committed by Simon Michael
parent 1116846881
commit 38e311211d
1 changed files with 13 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
hledger-lib/Hledger/Reports/ReportTypes.hs
View File

@ -29,6 +29,7 @@ module Hledger.Reports.ReportTypes
, prrFullName , prrFullName
, prrDisplayName , prrDisplayName
, prrDepth , prrDepth
, prrAdd
) where ) where
import Data.Aeson (ToJSON(..)) import Data.Aeson (ToJSON(..))
@ -103,12 +104,18 @@ instance Bifunctor PeriodicReportRow where
second = fmap second = fmap
instance Semigroup b => Semigroup (PeriodicReportRow a b) where instance Semigroup b => Semigroup (PeriodicReportRow a b) where
(PeriodicReportRow _ amts1 t1 a1) <> (PeriodicReportRow n2 amts2 t2 a2) = (<>) = prrAdd
PeriodicReportRow n2 (sumPadded amts1 amts2) (t1 <> t2) (a1 <> a2)
where -- | Add two 'PeriodicReportRows', preserving the name of the first.
sumPadded (a:as) (b:bs) = (a <> b) : sumPadded as bs prrAdd :: Semigroup b => PeriodicReportRow a b -> PeriodicReportRow a b -> PeriodicReportRow a b
sumPadded as [] = as prrAdd (PeriodicReportRow n1 amts1 t1 a1) (PeriodicReportRow _ amts2 t2 a2) =
sumPadded [] bs = bs 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 -- | Figure out the overall date span of a PeriodicReport
periodicReportSpan :: PeriodicReport a b -> DateSpan periodicReportSpan :: PeriodicReport a b -> DateSpan