{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module Hledger.Reports.ReportTypes
( PeriodicReport(..)
, PeriodicReportRow(..)
, Percentage
, Change
, Balance
, Total
, Average
, periodicReportSpan
, prNegate
, prNormaliseSign
) where
import Data.Aeson
import Data.Decimal
import GHC.Generics (Generic)
import Hledger.Data
type Percentage = Decimal
type Change = MixedAmount
type Balance = MixedAmount
type Total = MixedAmount
type Average = MixedAmount
data PeriodicReport a b =
PeriodicReport
{ PeriodicReport a b -> [DateSpan]
prDates :: [DateSpan]
, PeriodicReport a b -> [PeriodicReportRow a b]
prRows :: [PeriodicReportRow a b]
, PeriodicReport a b -> PeriodicReportRow () b
prTotals :: PeriodicReportRow () b
} 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, (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
, PeriodicReportRow a b -> Int
prrDepth :: Int
, PeriodicReportRow a b -> [b]
prrAmounts :: [b]
, PeriodicReportRow a b -> b
prrTotal :: b
, PeriodicReportRow a b -> b
prrAverage :: b
} 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, (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)
periodicReportSpan :: PeriodicReport a b -> DateSpan
periodicReportSpan :: PeriodicReport a b -> DateSpan
periodicReportSpan (PeriodicReport [] _ _) = Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing Maybe Day
forall a. Maybe a
Nothing
periodicReportSpan (PeriodicReport colspans :: [DateSpan]
colspans _ _) = 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)
prNormaliseSign :: Num b => NormalSign -> PeriodicReport a b -> PeriodicReport a b
prNormaliseSign :: NormalSign -> PeriodicReport a b -> PeriodicReport a b
prNormaliseSign NormallyNegative = PeriodicReport a b -> PeriodicReport a b
forall b a. Num b => PeriodicReport a b -> PeriodicReport a b
prNegate
prNormaliseSign _ = PeriodicReport a b -> PeriodicReport a b
forall a. a -> a
id
prNegate :: Num b => PeriodicReport a b -> PeriodicReport a b
prNegate :: PeriodicReport a b -> PeriodicReport a b
prNegate (PeriodicReport colspans :: [DateSpan]
colspans rows :: [PeriodicReportRow a b]
rows totalsrow :: PeriodicReportRow () b
totalsrow) =
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport [DateSpan]
colspans ((PeriodicReportRow a b -> PeriodicReportRow a b)
-> [PeriodicReportRow a b] -> [PeriodicReportRow a b]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow a b -> PeriodicReportRow a b
forall b a. Num b => PeriodicReportRow a b -> PeriodicReportRow a b
rowNegate [PeriodicReportRow a b]
rows) (PeriodicReportRow () b -> PeriodicReportRow () b
forall b a. Num b => PeriodicReportRow a b -> PeriodicReportRow a b
rowNegate PeriodicReportRow () b
totalsrow)
where
rowNegate :: PeriodicReportRow a b -> PeriodicReportRow a b
rowNegate (PeriodicReportRow name :: a
name indent :: Int
indent amts :: [b]
amts tot :: b
tot avg :: b
avg) =
a -> Int -> [b] -> b -> b -> PeriodicReportRow a b
forall a b. a -> Int -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow a
name Int
indent ((b -> b) -> [b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map b -> b
forall a. Num a => a -> a
negate [b]
amts) (-b
tot) (-b
avg)