{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
module Hledger.Reports.ReportTypes
( PeriodicReport(..)
, PeriodicReportRow(..)
, Percentage
, Change
, Balance
, Total
, Average
, periodicReportSpan
, prNormaliseSign
, prMapName
, prMapMaybeName
, CompoundPeriodicReport(..)
, CBCSubreportSpec(..)
, DisplayName(..)
, flatDisplayName
, treeDisplayName
, prrFullName
, prrDisplayName
, prrDepth
) where
import Data.Aeson
import Data.Decimal
import Data.Maybe (mapMaybe)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import GHC.Generics (Generic)
import Hledger.Data
import Hledger.Query (Query)
type Percentage = Decimal
type Change = MixedAmount
type Balance = MixedAmount
type Total = MixedAmount
type Average = MixedAmount
data PeriodicReport a b =
PeriodicReport
{ prDates :: [DateSpan]
, prRows :: [PeriodicReportRow a b]
, prTotals :: PeriodicReportRow () b
} deriving (Show, Functor, Generic, ToJSON)
data PeriodicReportRow a b =
PeriodicReportRow
{ prrName :: a
, prrAmounts :: [b]
, prrTotal :: b
, prrAverage :: b
} deriving (Show, Functor, Generic, ToJSON)
instance Num 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
periodicReportSpan :: PeriodicReport a b -> DateSpan
periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing
periodicReportSpan (PeriodicReport colspans _ _) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)
prNormaliseSign :: Num b => NormalSign -> PeriodicReport a b -> PeriodicReport a b
prNormaliseSign NormallyNegative = fmap negate
prNormaliseSign NormallyPositive = id
prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c
prMapName f report = report{prRows = map (prrMapName f) $ prRows report}
prMapMaybeName :: (a -> Maybe b) -> PeriodicReport a c -> PeriodicReport b c
prMapMaybeName f report = report{prRows = mapMaybe (prrMapMaybeName f) $ prRows report}
prrMapName :: (a -> b) -> PeriodicReportRow a c -> PeriodicReportRow b c
prrMapName f row = row{prrName = f $ prrName row}
prrMapMaybeName :: (a -> Maybe b) -> PeriodicReportRow a c -> Maybe (PeriodicReportRow b c)
prrMapMaybeName f row = case f $ prrName row of
Nothing -> Nothing
Just a -> Just row{prrName = a}
data CompoundPeriodicReport a b = CompoundPeriodicReport
{ cbrTitle :: String
, cbrDates :: [DateSpan]
, cbrSubreports :: [(String, PeriodicReport a b, Bool)]
, cbrTotals :: PeriodicReportRow () b
} deriving (Show, Generic, ToJSON)
data CBCSubreportSpec = CBCSubreportSpec
{ cbcsubreporttitle :: String
, cbcsubreportquery :: Journal -> Query
, cbcsubreportnormalsign :: NormalSign
, cbcsubreportincreasestotal :: Bool
}
data DisplayName = DisplayName
{ displayFull :: AccountName
, displayName :: AccountName
, displayDepth :: Int
} deriving (Show, Eq, Ord)
instance ToJSON DisplayName where
toJSON = toJSON . displayFull
toEncoding = toEncoding . displayFull
flatDisplayName :: AccountName -> DisplayName
flatDisplayName a = DisplayName a a 1
treeDisplayName :: AccountName -> DisplayName
treeDisplayName a = DisplayName a (accountLeafName a) (accountNameLevel a)
prrFullName :: PeriodicReportRow DisplayName a -> AccountName
prrFullName = displayFull . prrName
prrDisplayName :: PeriodicReportRow DisplayName a -> AccountName
prrDisplayName = displayName . prrName
prrDepth :: PeriodicReportRow DisplayName a -> Int
prrDepth = displayDepth . prrName