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

lib: Add Bifunctor instances for PeriodicReport and PeriodicReportRow.

Browse Source
This commit is contained in:
Stephen Morgan 2021-11-06 11:42:15 +11:00 committed by Simon Michael
parent 7597e525a3
commit 1116846881
1 changed files with 8 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -32,6 +32,7 @@ module Hledger.Reports.ReportTypes
) where ) where
import Data.Aeson (ToJSON(..)) import Data.Aeson (ToJSON(..))
import Data.Bifunctor (Bifunctor(..))
import Data.Decimal (Decimal) import Data.Decimal (Decimal)
import Data.Maybe (mapMaybe) import Data.Maybe (mapMaybe)
import Data.Text (Text) import Data.Text (Text)
@ -86,6 +87,9 @@ data PeriodicReport a b =
, prTotals :: PeriodicReportRow () b -- The grand totals row. , prTotals :: PeriodicReportRow () b -- The grand totals row.
} deriving (Show, Functor, Generic, ToJSON) } deriving (Show, Functor, Generic, ToJSON)
instance Bifunctor PeriodicReport where
bimap f g pr = pr{prRows = map (bimap f g) $ prRows pr, prTotals = fmap g $ prTotals pr}
data PeriodicReportRow a b = data PeriodicReportRow a b =
PeriodicReportRow PeriodicReportRow
{ prrName :: a -- An account name. { prrName :: a -- An account name.
@ -94,6 +98,10 @@ data PeriodicReportRow a b =
, prrAverage :: b -- The average of this row's values. , prrAverage :: b -- The average of this row's values.
} deriving (Show, Functor, Generic, ToJSON) } deriving (Show, Functor, Generic, ToJSON)
instance Bifunctor PeriodicReportRow where
first f prr = prr{prrName = f $ prrName prr}
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) = (PeriodicReportRow _ amts1 t1 a1) <> (PeriodicReportRow n2 amts2 t2 a2) =
PeriodicReportRow n2 (sumPadded amts1 amts2) (t1 <> t2) (a1 <> a2) PeriodicReportRow n2 (sumPadded amts1 amts2) (t1 <> t2) (a1 <> a2)