{- |
New common report types, used by the BudgetReport for now, perhaps all reports later.
-}
{-# LANGUAGE CPP            #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor  #-}
{-# LANGUAGE DeriveGeneric  #-}

module Hledger.Reports.ReportTypes
( PeriodicReport(..)
, PeriodicReportRow(..)

, Percentage
, Change
, Balance
, Total
, Average

, periodicReportSpan
, 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)
import Hledger.Reports.ReportOptions (ReportOpts)

type Percentage = Decimal

type Change  = MixedAmount  -- ^ A change in balance during a certain period.
type Balance = MixedAmount  -- ^ An ending balance as of some date.
type Total   = MixedAmount  -- ^ The sum of 'Change's in a report or a report row. Does not make sense for 'Balance's.
type Average = MixedAmount  -- ^ The average of 'Change's or 'Balance's in a report or report row.

-- | A periodic report is a generic tabular report, where each row corresponds
-- to some label (usually an account name) and each column to a date period.
-- The column periods are usually consecutive subperiods formed by splitting
-- the overall report period by some report interval (daily, weekly, etc.).
-- It has:
--
-- 1. a list of each column's period (date span)
--
-- 2. a list of rows, each containing:
--
--   * an account label
--
--   * the account's depth
--
--   * A list of amounts, one for each column. Depending on the value type,
--     these can represent balance changes, ending balances, budget
--     performance, etc. (for example, see 'BalanceType' and
--     "Hledger.Cli.Commands.Balance").
--
--   * the total of the row's amounts for a periodic report,
--     or zero for cumulative/historical reports (since summing
--     end balances generally doesn't make sense).
--
--   * the average of the row's amounts
--
-- 3. the column totals, and the overall grand total (or zero for
-- cumulative/historical reports) and grand average.

data PeriodicReport a b =
  PeriodicReport
  { PeriodicReport a b -> [DateSpan]
prDates  :: [DateSpan]               -- The subperiods formed by splitting the overall
                                         -- report period by the report interval. For
                                         -- ending-balance reports, only the end date is
                                         -- significant. Usually displayed as report columns.
  , PeriodicReport a b -> [PeriodicReportRow a b]
prRows   :: [PeriodicReportRow a b]  -- One row per account in the report.
  , PeriodicReport a b -> PeriodicReportRow () b
prTotals :: PeriodicReportRow () b   -- The grand totals row.
  } deriving (Int -> PeriodicReport a b -> ShowS
[PeriodicReport a b] -> ShowS
PeriodicReport a b -> String
(Int -> PeriodicReport a b -> ShowS)
-> (PeriodicReport a b -> String)
-> ([PeriodicReport a b] -> ShowS)
-> Show (PeriodicReport a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> PeriodicReport a b -> ShowS
forall a b. (Show a, Show b) => [PeriodicReport a b] -> ShowS
forall a b. (Show a, Show b) => PeriodicReport a b -> String
showList :: [PeriodicReport a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [PeriodicReport a b] -> ShowS
show :: PeriodicReport a b -> String
$cshow :: forall a b. (Show a, Show b) => PeriodicReport a b -> String
showsPrec :: Int -> PeriodicReport a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> PeriodicReport a b -> ShowS
Show, a -> PeriodicReport a b -> PeriodicReport a a
(a -> b) -> PeriodicReport a a -> PeriodicReport a b
(forall a b. (a -> b) -> PeriodicReport a a -> PeriodicReport a b)
-> (forall a b. a -> PeriodicReport a b -> PeriodicReport a a)
-> Functor (PeriodicReport a)
forall a b. a -> PeriodicReport a b -> PeriodicReport a a
forall a b. (a -> b) -> PeriodicReport a a -> PeriodicReport a b
forall a a b. a -> PeriodicReport a b -> PeriodicReport a a
forall a a b. (a -> b) -> PeriodicReport a a -> PeriodicReport a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PeriodicReport a b -> PeriodicReport a a
$c<$ :: forall a a b. a -> PeriodicReport a b -> PeriodicReport a a
fmap :: (a -> b) -> PeriodicReport a a -> PeriodicReport a b
$cfmap :: forall a a b. (a -> b) -> PeriodicReport a a -> PeriodicReport a b
Functor, (forall x. PeriodicReport a b -> Rep (PeriodicReport a b) x)
-> (forall x. Rep (PeriodicReport a b) x -> PeriodicReport a b)
-> Generic (PeriodicReport a b)
forall x. Rep (PeriodicReport a b) x -> PeriodicReport a b
forall x. PeriodicReport a b -> Rep (PeriodicReport a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (PeriodicReport a b) x -> PeriodicReport a b
forall a b x. PeriodicReport a b -> Rep (PeriodicReport a b) x
$cto :: forall a b x. Rep (PeriodicReport a b) x -> PeriodicReport a b
$cfrom :: forall a b x. PeriodicReport a b -> Rep (PeriodicReport a b) x
Generic, [PeriodicReport a b] -> Encoding
[PeriodicReport a b] -> Value
PeriodicReport a b -> Encoding
PeriodicReport a b -> Value
(PeriodicReport a b -> Value)
-> (PeriodicReport a b -> Encoding)
-> ([PeriodicReport a b] -> Value)
-> ([PeriodicReport a b] -> Encoding)
-> ToJSON (PeriodicReport a b)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall a b.
(ToJSON a, ToJSON b) =>
[PeriodicReport a b] -> Encoding
forall a b. (ToJSON a, ToJSON b) => [PeriodicReport a b] -> Value
forall a b. (ToJSON a, ToJSON b) => PeriodicReport a b -> Encoding
forall a b. (ToJSON a, ToJSON b) => PeriodicReport a b -> Value
toEncodingList :: [PeriodicReport a b] -> Encoding
$ctoEncodingList :: forall a b.
(ToJSON a, ToJSON b) =>
[PeriodicReport a b] -> Encoding
toJSONList :: [PeriodicReport a b] -> Value
$ctoJSONList :: forall a b. (ToJSON a, ToJSON b) => [PeriodicReport a b] -> Value
toEncoding :: PeriodicReport a b -> Encoding
$ctoEncoding :: forall a b. (ToJSON a, ToJSON b) => PeriodicReport a b -> Encoding
toJSON :: PeriodicReport a b -> Value
$ctoJSON :: forall a b. (ToJSON a, ToJSON b) => PeriodicReport a b -> Value
ToJSON)

data PeriodicReportRow a b =
  PeriodicReportRow
  { PeriodicReportRow a b -> a
prrName    :: a    -- An account name.
  , PeriodicReportRow a b -> [b]
prrAmounts :: [b]  -- The data value for each subperiod.
  , PeriodicReportRow a b -> b
prrTotal   :: b    -- The total of this row's values.
  , PeriodicReportRow a b -> b
prrAverage :: b    -- The average of this row's values.
  } deriving (Int -> PeriodicReportRow a b -> ShowS
[PeriodicReportRow a b] -> ShowS
PeriodicReportRow a b -> String
(Int -> PeriodicReportRow a b -> ShowS)
-> (PeriodicReportRow a b -> String)
-> ([PeriodicReportRow a b] -> ShowS)
-> Show (PeriodicReportRow a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b.
(Show a, Show b) =>
Int -> PeriodicReportRow a b -> ShowS
forall a b. (Show a, Show b) => [PeriodicReportRow a b] -> ShowS
forall a b. (Show a, Show b) => PeriodicReportRow a b -> String
showList :: [PeriodicReportRow a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [PeriodicReportRow a b] -> ShowS
show :: PeriodicReportRow a b -> String
$cshow :: forall a b. (Show a, Show b) => PeriodicReportRow a b -> String
showsPrec :: Int -> PeriodicReportRow a b -> ShowS
$cshowsPrec :: forall a b.
(Show a, Show b) =>
Int -> PeriodicReportRow a b -> ShowS
Show, a -> PeriodicReportRow a b -> PeriodicReportRow a a
(a -> b) -> PeriodicReportRow a a -> PeriodicReportRow a b
(forall a b.
 (a -> b) -> PeriodicReportRow a a -> PeriodicReportRow a b)
-> (forall a b.
    a -> PeriodicReportRow a b -> PeriodicReportRow a a)
-> Functor (PeriodicReportRow a)
forall a b. a -> PeriodicReportRow a b -> PeriodicReportRow a a
forall a b.
(a -> b) -> PeriodicReportRow a a -> PeriodicReportRow a b
forall a a b. a -> PeriodicReportRow a b -> PeriodicReportRow a a
forall a a b.
(a -> b) -> PeriodicReportRow a a -> PeriodicReportRow a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PeriodicReportRow a b -> PeriodicReportRow a a
$c<$ :: forall a a b. a -> PeriodicReportRow a b -> PeriodicReportRow a a
fmap :: (a -> b) -> PeriodicReportRow a a -> PeriodicReportRow a b
$cfmap :: forall a a b.
(a -> b) -> PeriodicReportRow a a -> PeriodicReportRow a b
Functor, (forall x. PeriodicReportRow a b -> Rep (PeriodicReportRow a b) x)
-> (forall x.
    Rep (PeriodicReportRow a b) x -> PeriodicReportRow a b)
-> Generic (PeriodicReportRow a b)
forall x. Rep (PeriodicReportRow a b) x -> PeriodicReportRow a b
forall x. PeriodicReportRow a b -> Rep (PeriodicReportRow a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x.
Rep (PeriodicReportRow a b) x -> PeriodicReportRow a b
forall a b x.
PeriodicReportRow a b -> Rep (PeriodicReportRow a b) x
$cto :: forall a b x.
Rep (PeriodicReportRow a b) x -> PeriodicReportRow a b
$cfrom :: forall a b x.
PeriodicReportRow a b -> Rep (PeriodicReportRow a b) x
Generic, [PeriodicReportRow a b] -> Encoding
[PeriodicReportRow a b] -> Value
PeriodicReportRow a b -> Encoding
PeriodicReportRow a b -> Value
(PeriodicReportRow a b -> Value)
-> (PeriodicReportRow a b -> Encoding)
-> ([PeriodicReportRow a b] -> Value)
-> ([PeriodicReportRow a b] -> Encoding)
-> ToJSON (PeriodicReportRow a b)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall a b.
(ToJSON b, ToJSON a) =>
[PeriodicReportRow a b] -> Encoding
forall a b.
(ToJSON b, ToJSON a) =>
[PeriodicReportRow a b] -> Value
forall a b.
(ToJSON b, ToJSON a) =>
PeriodicReportRow a b -> Encoding
forall a b. (ToJSON b, ToJSON a) => PeriodicReportRow a b -> Value
toEncodingList :: [PeriodicReportRow a b] -> Encoding
$ctoEncodingList :: forall a b.
(ToJSON b, ToJSON a) =>
[PeriodicReportRow a b] -> Encoding
toJSONList :: [PeriodicReportRow a b] -> Value
$ctoJSONList :: forall a b.
(ToJSON b, ToJSON a) =>
[PeriodicReportRow a b] -> Value
toEncoding :: PeriodicReportRow a b -> Encoding
$ctoEncoding :: forall a b.
(ToJSON b, ToJSON a) =>
PeriodicReportRow a b -> Encoding
toJSON :: PeriodicReportRow a b -> Value
$ctoJSON :: forall a b. (ToJSON b, ToJSON a) => PeriodicReportRow a b -> Value
ToJSON)

instance Num b => Semigroup (PeriodicReportRow a b) where
  (PeriodicReportRow a
_ [b]
amts1 b
t1 b
a1) <> :: PeriodicReportRow a b
-> PeriodicReportRow a b -> PeriodicReportRow a b
<> (PeriodicReportRow a
n2 [b]
amts2 b
t2 b
a2) =
      a -> [b] -> b -> b -> PeriodicReportRow a b
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow a
n2 ([b] -> [b] -> [b]
forall a. Num a => [a] -> [a] -> [a]
sumPadded [b]
amts1 [b]
amts2) (b
t1 b -> b -> b
forall a. Num a => a -> a -> a
+ b
t2) (b
a1 b -> b -> b
forall a. Num a => a -> a -> a
+ b
a2)
    where
      sumPadded :: [a] -> [a] -> [a]
sumPadded (a
a:[a]
as) (a
b:[a]
bs) = (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
sumPadded [a]
as [a]
bs
      sumPadded [a]
as     []     = [a]
as
      sumPadded []     [a]
bs     = [a]
bs

-- | Figure out the overall date span of a PeriodicReport
periodicReportSpan :: PeriodicReport a b -> DateSpan
periodicReportSpan :: PeriodicReport a b -> DateSpan
periodicReportSpan (PeriodicReport [] [PeriodicReportRow a b]
_ PeriodicReportRow () b
_)       = Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing Maybe Day
forall a. Maybe a
Nothing
periodicReportSpan (PeriodicReport [DateSpan]
colspans [PeriodicReportRow a b]
_ PeriodicReportRow () b
_) = Maybe Day -> Maybe Day -> DateSpan
DateSpan (DateSpan -> Maybe Day
spanStart (DateSpan -> Maybe Day) -> DateSpan -> Maybe Day
forall a b. (a -> b) -> a -> b
$ [DateSpan] -> DateSpan
forall a. [a] -> a
head [DateSpan]
colspans) (DateSpan -> Maybe Day
spanEnd (DateSpan -> Maybe Day) -> DateSpan -> Maybe Day
forall a b. (a -> b) -> a -> b
$ [DateSpan] -> DateSpan
forall a. [a] -> a
last [DateSpan]
colspans)

-- | Map a function over the row names.
prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c
prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c
prMapName a -> b
f PeriodicReport a c
report = PeriodicReport a c
report{prRows :: [PeriodicReportRow b c]
prRows = (PeriodicReportRow a c -> PeriodicReportRow b c)
-> [PeriodicReportRow a c] -> [PeriodicReportRow b c]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> PeriodicReportRow a c -> PeriodicReportRow b c
forall a b c.
(a -> b) -> PeriodicReportRow a c -> PeriodicReportRow b c
prrMapName a -> b
f) ([PeriodicReportRow a c] -> [PeriodicReportRow b c])
-> [PeriodicReportRow a c] -> [PeriodicReportRow b c]
forall a b. (a -> b) -> a -> b
$ PeriodicReport a c -> [PeriodicReportRow a c]
forall a b. PeriodicReport a b -> [PeriodicReportRow a b]
prRows PeriodicReport a c
report}

-- | Map a function over the row names, possibly discarding some.
prMapMaybeName :: (a -> Maybe b) -> PeriodicReport a c -> PeriodicReport b c
prMapMaybeName :: (a -> Maybe b) -> PeriodicReport a c -> PeriodicReport b c
prMapMaybeName a -> Maybe b
f PeriodicReport a c
report = PeriodicReport a c
report{prRows :: [PeriodicReportRow b c]
prRows = (PeriodicReportRow a c -> Maybe (PeriodicReportRow b c))
-> [PeriodicReportRow a c] -> [PeriodicReportRow b c]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((a -> Maybe b)
-> PeriodicReportRow a c -> Maybe (PeriodicReportRow b c)
forall a b c.
(a -> Maybe b)
-> PeriodicReportRow a c -> Maybe (PeriodicReportRow b c)
prrMapMaybeName a -> Maybe b
f) ([PeriodicReportRow a c] -> [PeriodicReportRow b c])
-> [PeriodicReportRow a c] -> [PeriodicReportRow b c]
forall a b. (a -> b) -> a -> b
$ PeriodicReport a c -> [PeriodicReportRow a c]
forall a b. PeriodicReport a b -> [PeriodicReportRow a b]
prRows PeriodicReport a c
report}

-- | Map a function over the row names of the PeriodicReportRow.
prrMapName :: (a -> b) -> PeriodicReportRow a c -> PeriodicReportRow b c
prrMapName :: (a -> b) -> PeriodicReportRow a c -> PeriodicReportRow b c
prrMapName a -> b
f PeriodicReportRow a c
row = PeriodicReportRow a c
row{prrName :: b
prrName = a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ PeriodicReportRow a c -> a
forall a b. PeriodicReportRow a b -> a
prrName PeriodicReportRow a c
row}

-- | Map maybe a function over the row names of the PeriodicReportRow.
prrMapMaybeName :: (a -> Maybe b) -> PeriodicReportRow a c -> Maybe (PeriodicReportRow b c)
prrMapMaybeName :: (a -> Maybe b)
-> PeriodicReportRow a c -> Maybe (PeriodicReportRow b c)
prrMapMaybeName a -> Maybe b
f PeriodicReportRow a c
row = case a -> Maybe b
f (a -> Maybe b) -> a -> Maybe b
forall a b. (a -> b) -> a -> b
$ PeriodicReportRow a c -> a
forall a b. PeriodicReportRow a b -> a
prrName PeriodicReportRow a c
row of
    Maybe b
Nothing -> Maybe (PeriodicReportRow b c)
forall a. Maybe a
Nothing
    Just b
a  -> PeriodicReportRow b c -> Maybe (PeriodicReportRow b c)
forall a. a -> Maybe a
Just PeriodicReportRow a c
row{prrName :: b
prrName = b
a}


-- | A compound balance report has:
--
-- * an overall title
--
-- * the period (date span) of each column
--
-- * one or more named, normal-positive multi balance reports,
--   with columns corresponding to the above, and a flag indicating
--   whether they increased or decreased the overall totals
--
-- * a list of overall totals for each column, and their grand total and average
--
-- It is used in compound balance report commands like balancesheet,
-- cashflow and incomestatement.
data CompoundPeriodicReport a b = CompoundPeriodicReport
  { CompoundPeriodicReport a b -> String
cbrTitle      :: String
  , CompoundPeriodicReport a b -> [DateSpan]
cbrDates      :: [DateSpan]
  , CompoundPeriodicReport a b -> [(String, PeriodicReport a b, Bool)]
cbrSubreports :: [(String, PeriodicReport a b, Bool)]
  , CompoundPeriodicReport a b -> PeriodicReportRow () b
cbrTotals     :: PeriodicReportRow () b
  } deriving (Int -> CompoundPeriodicReport a b -> ShowS
[CompoundPeriodicReport a b] -> ShowS
CompoundPeriodicReport a b -> String
(Int -> CompoundPeriodicReport a b -> ShowS)
-> (CompoundPeriodicReport a b -> String)
-> ([CompoundPeriodicReport a b] -> ShowS)
-> Show (CompoundPeriodicReport a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b.
(Show a, Show b) =>
Int -> CompoundPeriodicReport a b -> ShowS
forall a b.
(Show a, Show b) =>
[CompoundPeriodicReport a b] -> ShowS
forall a b.
(Show a, Show b) =>
CompoundPeriodicReport a b -> String
showList :: [CompoundPeriodicReport a b] -> ShowS
$cshowList :: forall a b.
(Show a, Show b) =>
[CompoundPeriodicReport a b] -> ShowS
show :: CompoundPeriodicReport a b -> String
$cshow :: forall a b.
(Show a, Show b) =>
CompoundPeriodicReport a b -> String
showsPrec :: Int -> CompoundPeriodicReport a b -> ShowS
$cshowsPrec :: forall a b.
(Show a, Show b) =>
Int -> CompoundPeriodicReport a b -> ShowS
Show, a -> CompoundPeriodicReport a b -> CompoundPeriodicReport a a
(a -> b)
-> CompoundPeriodicReport a a -> CompoundPeriodicReport a b
(forall a b.
 (a -> b)
 -> CompoundPeriodicReport a a -> CompoundPeriodicReport a b)
-> (forall a b.
    a -> CompoundPeriodicReport a b -> CompoundPeriodicReport a a)
-> Functor (CompoundPeriodicReport a)
forall a b.
a -> CompoundPeriodicReport a b -> CompoundPeriodicReport a a
forall a b.
(a -> b)
-> CompoundPeriodicReport a a -> CompoundPeriodicReport a b
forall a a b.
a -> CompoundPeriodicReport a b -> CompoundPeriodicReport a a
forall a a b.
(a -> b)
-> CompoundPeriodicReport a a -> CompoundPeriodicReport a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CompoundPeriodicReport a b -> CompoundPeriodicReport a a
$c<$ :: forall a a b.
a -> CompoundPeriodicReport a b -> CompoundPeriodicReport a a
fmap :: (a -> b)
-> CompoundPeriodicReport a a -> CompoundPeriodicReport a b
$cfmap :: forall a a b.
(a -> b)
-> CompoundPeriodicReport a a -> CompoundPeriodicReport a b
Functor, (forall x.
 CompoundPeriodicReport a b -> Rep (CompoundPeriodicReport a b) x)
-> (forall x.
    Rep (CompoundPeriodicReport a b) x -> CompoundPeriodicReport a b)
-> Generic (CompoundPeriodicReport a b)
forall x.
Rep (CompoundPeriodicReport a b) x -> CompoundPeriodicReport a b
forall x.
CompoundPeriodicReport a b -> Rep (CompoundPeriodicReport a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x.
Rep (CompoundPeriodicReport a b) x -> CompoundPeriodicReport a b
forall a b x.
CompoundPeriodicReport a b -> Rep (CompoundPeriodicReport a b) x
$cto :: forall a b x.
Rep (CompoundPeriodicReport a b) x -> CompoundPeriodicReport a b
$cfrom :: forall a b x.
CompoundPeriodicReport a b -> Rep (CompoundPeriodicReport a b) x
Generic, [CompoundPeriodicReport a b] -> Encoding
[CompoundPeriodicReport a b] -> Value
CompoundPeriodicReport a b -> Encoding
CompoundPeriodicReport a b -> Value
(CompoundPeriodicReport a b -> Value)
-> (CompoundPeriodicReport a b -> Encoding)
-> ([CompoundPeriodicReport a b] -> Value)
-> ([CompoundPeriodicReport a b] -> Encoding)
-> ToJSON (CompoundPeriodicReport a b)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall a b.
(ToJSON b, ToJSON a) =>
[CompoundPeriodicReport a b] -> Encoding
forall a b.
(ToJSON b, ToJSON a) =>
[CompoundPeriodicReport a b] -> Value
forall a b.
(ToJSON b, ToJSON a) =>
CompoundPeriodicReport a b -> Encoding
forall a b.
(ToJSON b, ToJSON a) =>
CompoundPeriodicReport a b -> Value
toEncodingList :: [CompoundPeriodicReport a b] -> Encoding
$ctoEncodingList :: forall a b.
(ToJSON b, ToJSON a) =>
[CompoundPeriodicReport a b] -> Encoding
toJSONList :: [CompoundPeriodicReport a b] -> Value
$ctoJSONList :: forall a b.
(ToJSON b, ToJSON a) =>
[CompoundPeriodicReport a b] -> Value
toEncoding :: CompoundPeriodicReport a b -> Encoding
$ctoEncoding :: forall a b.
(ToJSON b, ToJSON a) =>
CompoundPeriodicReport a b -> Encoding
toJSON :: CompoundPeriodicReport a b -> Value
$ctoJSON :: forall a b.
(ToJSON b, ToJSON a) =>
CompoundPeriodicReport a b -> Value
ToJSON)

-- | Description of one subreport within a compound balance report.
-- Part of a "CompoundBalanceCommandSpec", but also used in hledger-lib.
data CBCSubreportSpec a = CBCSubreportSpec
  { CBCSubreportSpec a -> String
cbcsubreporttitle          :: String                    -- ^ The title to use for the subreport
  , CBCSubreportSpec a -> Journal -> Query
cbcsubreportquery          :: Journal -> Query          -- ^ The Query to use for the subreport
  , CBCSubreportSpec a -> ReportOpts -> ReportOpts
cbcsubreportoptions        :: ReportOpts -> ReportOpts  -- ^ A function to transform the ReportOpts used to produce the subreport
  , CBCSubreportSpec a
-> PeriodicReport DisplayName MixedAmount
-> PeriodicReport a MixedAmount
cbcsubreporttransform      :: PeriodicReport DisplayName MixedAmount -> PeriodicReport a MixedAmount  -- ^ A function to transform the result of the subreport
  , CBCSubreportSpec a -> Bool
cbcsubreportincreasestotal :: Bool                      -- ^ Whether the subreport and overall report total are of the same sign (e.g. Assets are normally
                                                            --   positive in a balance sheet report, as is the overall total. Liabilities are normally of the
                                                            --   opposite sign.)
  }


-- | A full name, display name, and depth for an account.
data DisplayName = DisplayName
    { DisplayName -> AccountName
displayFull :: AccountName
    , DisplayName -> AccountName
displayName :: AccountName
    , DisplayName -> Int
displayDepth :: Int
    } deriving (Int -> DisplayName -> ShowS
[DisplayName] -> ShowS
DisplayName -> String
(Int -> DisplayName -> ShowS)
-> (DisplayName -> String)
-> ([DisplayName] -> ShowS)
-> Show DisplayName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayName] -> ShowS
$cshowList :: [DisplayName] -> ShowS
show :: DisplayName -> String
$cshow :: DisplayName -> String
showsPrec :: Int -> DisplayName -> ShowS
$cshowsPrec :: Int -> DisplayName -> ShowS
Show, DisplayName -> DisplayName -> Bool
(DisplayName -> DisplayName -> Bool)
-> (DisplayName -> DisplayName -> Bool) -> Eq DisplayName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayName -> DisplayName -> Bool
$c/= :: DisplayName -> DisplayName -> Bool
== :: DisplayName -> DisplayName -> Bool
$c== :: DisplayName -> DisplayName -> Bool
Eq, Eq DisplayName
Eq DisplayName
-> (DisplayName -> DisplayName -> Ordering)
-> (DisplayName -> DisplayName -> Bool)
-> (DisplayName -> DisplayName -> Bool)
-> (DisplayName -> DisplayName -> Bool)
-> (DisplayName -> DisplayName -> Bool)
-> (DisplayName -> DisplayName -> DisplayName)
-> (DisplayName -> DisplayName -> DisplayName)
-> Ord DisplayName
DisplayName -> DisplayName -> Bool
DisplayName -> DisplayName -> Ordering
DisplayName -> DisplayName -> DisplayName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DisplayName -> DisplayName -> DisplayName
$cmin :: DisplayName -> DisplayName -> DisplayName
max :: DisplayName -> DisplayName -> DisplayName
$cmax :: DisplayName -> DisplayName -> DisplayName
>= :: DisplayName -> DisplayName -> Bool
$c>= :: DisplayName -> DisplayName -> Bool
> :: DisplayName -> DisplayName -> Bool
$c> :: DisplayName -> DisplayName -> Bool
<= :: DisplayName -> DisplayName -> Bool
$c<= :: DisplayName -> DisplayName -> Bool
< :: DisplayName -> DisplayName -> Bool
$c< :: DisplayName -> DisplayName -> Bool
compare :: DisplayName -> DisplayName -> Ordering
$ccompare :: DisplayName -> DisplayName -> Ordering
$cp1Ord :: Eq DisplayName
Ord)

instance ToJSON DisplayName where
    toJSON :: DisplayName -> Value
toJSON = AccountName -> Value
forall a. ToJSON a => a -> Value
toJSON (AccountName -> Value)
-> (DisplayName -> AccountName) -> DisplayName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayName -> AccountName
displayFull
    toEncoding :: DisplayName -> Encoding
toEncoding = AccountName -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (AccountName -> Encoding)
-> (DisplayName -> AccountName) -> DisplayName -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayName -> AccountName
displayFull

-- | Construct a flat display name, where the full name is also displayed at
-- depth 1
flatDisplayName :: AccountName -> DisplayName
flatDisplayName :: AccountName -> DisplayName
flatDisplayName AccountName
a = AccountName -> AccountName -> Int -> DisplayName
DisplayName AccountName
a AccountName
a Int
1

-- | Construct a tree display name, where only the leaf is displayed at its
-- given depth
treeDisplayName :: AccountName -> DisplayName
treeDisplayName :: AccountName -> DisplayName
treeDisplayName AccountName
a = AccountName -> AccountName -> Int -> DisplayName
DisplayName AccountName
a (AccountName -> AccountName
accountLeafName AccountName
a) (AccountName -> Int
accountNameLevel AccountName
a)

-- | Get the full, canonical, name of a PeriodicReportRow tagged by a
-- DisplayName.
prrFullName :: PeriodicReportRow DisplayName a -> AccountName
prrFullName :: PeriodicReportRow DisplayName a -> AccountName
prrFullName = DisplayName -> AccountName
displayFull (DisplayName -> AccountName)
-> (PeriodicReportRow DisplayName a -> DisplayName)
-> PeriodicReportRow DisplayName a
-> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodicReportRow DisplayName a -> DisplayName
forall a b. PeriodicReportRow a b -> a
prrName

-- | Get the display name of a PeriodicReportRow tagged by a DisplayName.
prrDisplayName :: PeriodicReportRow DisplayName a -> AccountName
prrDisplayName :: PeriodicReportRow DisplayName a -> AccountName
prrDisplayName = DisplayName -> AccountName
displayName (DisplayName -> AccountName)
-> (PeriodicReportRow DisplayName a -> DisplayName)
-> PeriodicReportRow DisplayName a
-> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodicReportRow DisplayName a -> DisplayName
forall a b. PeriodicReportRow a b -> a
prrName

-- | Get the display depth of a PeriodicReportRow tagged by a DisplayName.
prrDepth :: PeriodicReportRow DisplayName a -> Int
prrDepth :: PeriodicReportRow DisplayName a -> Int
prrDepth = DisplayName -> Int
displayDepth (DisplayName -> Int)
-> (PeriodicReportRow DisplayName a -> DisplayName)
-> PeriodicReportRow DisplayName a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodicReportRow DisplayName a -> DisplayName
forall a b. PeriodicReportRow a b -> a
prrName