{- |
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Hledger.Reports.BudgetReport (
  BudgetGoal,
  BudgetTotal,
  BudgetAverage,
  BudgetCell,
  BudgetReportRow,
  BudgetReport,
  budgetReport,
  budgetReportAsTable,
  budgetReportAsText,
  -- * Helpers
  reportPeriodName,
  -- * Tests
  tests_BudgetReport
)
where

import Data.Decimal
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.List
import Data.List.Extra (nubSort)
import Data.Maybe
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import Data.Time.Calendar
import Safe
--import Data.List
--import Data.Maybe
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Text as T
--import qualified Data.Text.Lazy as TL
--import System.Console.CmdArgs.Explicit as C
--import Lucid as L
import Text.Printf (printf)
import Text.Tabular as T

import Hledger.Data
import Hledger.Utils
import Hledger.Reports.ReportOptions
import Hledger.Reports.ReportTypes
import Hledger.Reports.MultiBalanceReport


type BudgetGoal    = Change
type BudgetTotal   = Total
type BudgetAverage = Average

-- | A budget report tracks expected and actual changes per account and subperiod.
type BudgetCell = (Maybe Change, Maybe BudgetGoal)
type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell
type BudgetReport    = PeriodicReport    DisplayName BudgetCell

-- | Calculate budget goals from all periodic transactions,
-- actual balance changes from the regular transactions,
-- and compare these to get a 'BudgetReport'.
-- Unbudgeted accounts may be hidden or renamed (see budgetRollup).
budgetReport :: ReportOpts -> Bool -> DateSpan -> Day -> Journal -> BudgetReport
budgetReport :: ReportOpts -> Bool -> DateSpan -> Day -> Journal -> BudgetReport
budgetReport ropts' :: ReportOpts
ropts' assrt :: Bool
assrt reportspan :: DateSpan
reportspan d :: Day
d j :: Journal
j = String -> BudgetReport -> BudgetReport
forall a. Show a => String -> a -> a
dbg1 "sortedbudgetreport" BudgetReport
budgetreport
  where
    -- Budget report demands ALTree mode to ensure subaccounts and subaccount budgets are properly handled
    -- and that reports with and without --empty make sense when compared side by side
    ropts :: ReportOpts
ropts = ReportOpts
ropts' { accountlistmode_ :: AccountListMode
accountlistmode_ = AccountListMode
ALTree }
    showunbudgeted :: Bool
showunbudgeted = ReportOpts -> Bool
empty_ ReportOpts
ropts
    budgetedaccts :: [AccountName]
budgetedaccts =
      String -> [AccountName] -> [AccountName]
forall a. Show a => String -> a -> a
dbg2 "budgetedacctsinperiod" ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$
      [AccountName] -> [AccountName]
forall a. Eq a => [a] -> [a]
nub ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$
      (AccountName -> [AccountName]) -> [AccountName] -> [AccountName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AccountName -> [AccountName]
expandAccountName ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$
      [Posting] -> [AccountName]
accountNamesFromPostings ([Posting] -> [AccountName]) -> [Posting] -> [AccountName]
forall a b. (a -> b) -> a -> b
$
      (Transaction -> [Posting]) -> [Transaction] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
tpostings ([Transaction] -> [Posting]) -> [Transaction] -> [Posting]
forall a b. (a -> b) -> a -> b
$
      (PeriodicTransaction -> [Transaction])
-> [PeriodicTransaction] -> [Transaction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PeriodicTransaction -> DateSpan -> [Transaction]
`runPeriodicTransaction` DateSpan
reportspan) ([PeriodicTransaction] -> [Transaction])
-> [PeriodicTransaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$
      Journal -> [PeriodicTransaction]
jperiodictxns Journal
j
    actualj :: Journal
actualj = (Journal -> String) -> Journal -> Journal
forall a. Show a => (a -> String) -> a -> a
dbg1With (("actualj"String -> String -> String
forall a. [a] -> [a] -> [a]
++)(String -> String) -> (Journal -> String) -> Journal -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Transaction] -> String
forall a. Show a => a -> String
show([Transaction] -> String)
-> (Journal -> [Transaction]) -> Journal -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Journal -> [Transaction]
jtxns)  (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$ [AccountName] -> Bool -> Journal -> Journal
budgetRollUp [AccountName]
budgetedaccts Bool
showunbudgeted Journal
j
    budgetj :: Journal
budgetj = (Journal -> String) -> Journal -> Journal
forall a. Show a => (a -> String) -> a -> a
dbg1With (("budgetj"String -> String -> String
forall a. [a] -> [a] -> [a]
++)(String -> String) -> (Journal -> String) -> Journal -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Transaction] -> String
forall a. Show a => a -> String
show([Transaction] -> String)
-> (Journal -> [Transaction]) -> Journal -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Journal -> [Transaction]
jtxns)  (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$ Bool -> ReportOpts -> DateSpan -> Journal -> Journal
budgetJournal Bool
assrt ReportOpts
ropts DateSpan
reportspan Journal
j
    actualreport :: PeriodicReport DisplayName MixedAmount
actualreport@(PeriodicReport actualspans :: [DateSpan]
actualspans _ _) =
        String
-> PeriodicReport DisplayName MixedAmount
-> PeriodicReport DisplayName MixedAmount
forall a. Show a => String -> a -> a
dbg1 "actualreport" (PeriodicReport DisplayName MixedAmount
 -> PeriodicReport DisplayName MixedAmount)
-> PeriodicReport DisplayName MixedAmount
-> PeriodicReport DisplayName MixedAmount
forall a b. (a -> b) -> a -> b
$ Day
-> ReportOpts -> Journal -> PeriodicReport DisplayName MixedAmount
multiBalanceReport Day
d ReportOpts
ropts{empty_ :: Bool
empty_=Bool
True} Journal
actualj
    budgetgoalreport :: PeriodicReport DisplayName MixedAmount
budgetgoalreport@(PeriodicReport _ budgetgoalitems :: [PeriodicReportRow DisplayName MixedAmount]
budgetgoalitems budgetgoaltotals :: PeriodicReportRow () MixedAmount
budgetgoaltotals) =
        String
-> PeriodicReport DisplayName MixedAmount
-> PeriodicReport DisplayName MixedAmount
forall a. Show a => String -> a -> a
dbg1 "budgetgoalreport" (PeriodicReport DisplayName MixedAmount
 -> PeriodicReport DisplayName MixedAmount)
-> PeriodicReport DisplayName MixedAmount
-> PeriodicReport DisplayName MixedAmount
forall a b. (a -> b) -> a -> b
$ Day
-> ReportOpts -> Journal -> PeriodicReport DisplayName MixedAmount
multiBalanceReport Day
d ReportOpts
ropts{empty_ :: Bool
empty_=Bool
True} Journal
budgetj
    budgetgoalreport' :: PeriodicReport DisplayName MixedAmount
budgetgoalreport'
      -- If no interval is specified:
      -- budgetgoalreport's span might be shorter actualreport's due to periodic txns;
      -- it should be safe to replace it with the latter, so they combine well.
      | ReportOpts -> Interval
interval_ ReportOpts
ropts Interval -> Interval -> Bool
forall a. Eq a => a -> a -> Bool
== Interval
NoInterval = [DateSpan]
-> [PeriodicReportRow DisplayName MixedAmount]
-> PeriodicReportRow () MixedAmount
-> PeriodicReport DisplayName MixedAmount
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport [DateSpan]
actualspans [PeriodicReportRow DisplayName MixedAmount]
budgetgoalitems PeriodicReportRow () MixedAmount
budgetgoaltotals
      | Bool
otherwise = PeriodicReport DisplayName MixedAmount
budgetgoalreport
    budgetreport :: BudgetReport
budgetreport = ReportOpts
-> Journal
-> PeriodicReport DisplayName MixedAmount
-> PeriodicReport DisplayName MixedAmount
-> BudgetReport
combineBudgetAndActual ReportOpts
ropts Journal
j PeriodicReport DisplayName MixedAmount
budgetgoalreport' PeriodicReport DisplayName MixedAmount
actualreport

-- | Use all periodic transactions in the journal to generate
-- budget transactions in the specified report period.
-- Budget transactions are similar to forecast transactions except
-- their purpose is to set goal amounts (of change) per account and period.
budgetJournal :: Bool -> ReportOpts -> DateSpan -> Journal -> Journal
budgetJournal :: Bool -> ReportOpts -> DateSpan -> Journal -> Journal
budgetJournal assrt :: Bool
assrt _ropts :: ReportOpts
_ropts reportspan :: DateSpan
reportspan j :: Journal
j =
  (String -> Journal)
-> (Journal -> Journal) -> Either String Journal -> Journal
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Journal
forall a. String -> a
error' Journal -> Journal
forall a. a -> a
id (Either String Journal -> Journal)
-> Either String Journal -> Journal
forall a b. (a -> b) -> a -> b
$ Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
assrt Journal
j{ jtxns :: [Transaction]
jtxns = [Transaction]
budgetts }  -- PARTIAL:
  where
    budgetspan :: DateSpan
budgetspan = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg2 "budgetspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ DateSpan
reportspan
    budgetts :: [Transaction]
budgetts =
      String -> [Transaction] -> [Transaction]
forall a. Show a => String -> a -> a
dbg1 "budgetts" ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$
      [Transaction -> Transaction
makeBudgetTxn Transaction
t
      | PeriodicTransaction
pt <- Journal -> [PeriodicTransaction]
jperiodictxns Journal
j
      , Transaction
t <- PeriodicTransaction -> DateSpan -> [Transaction]
runPeriodicTransaction PeriodicTransaction
pt DateSpan
budgetspan
      ]
    makeBudgetTxn :: Transaction -> Transaction
makeBudgetTxn t :: Transaction
t = Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction
t { tdescription :: AccountName
tdescription = String -> AccountName
T.pack "Budget transaction" }

-- | Adjust a journal's account names for budget reporting, in two ways:
--
-- 1. accounts with no budget goal anywhere in their ancestry are moved
--    under the "unbudgeted" top level account.
--
-- 2. subaccounts with no budget goal are merged with their closest parent account
--    with a budget goal, so that only budgeted accounts are shown.
--    This can be disabled by --empty.
--
budgetRollUp :: [AccountName] -> Bool -> Journal -> Journal
budgetRollUp :: [AccountName] -> Bool -> Journal -> Journal
budgetRollUp budgetedaccts :: [AccountName]
budgetedaccts showunbudgeted :: Bool
showunbudgeted j :: Journal
j = Journal
j { jtxns :: [Transaction]
jtxns = Transaction -> Transaction
remapTxn (Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Journal -> [Transaction]
jtxns Journal
j }
  where
    remapTxn :: Transaction -> Transaction
remapTxn = ([Posting] -> [Posting]) -> Transaction -> Transaction
mapPostings ((Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
remapPosting)
      where
        mapPostings :: ([Posting] -> [Posting]) -> Transaction -> Transaction
mapPostings f :: [Posting] -> [Posting]
f t :: Transaction
t = Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction
t { tpostings :: [Posting]
tpostings = [Posting] -> [Posting]
f ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t }
        remapPosting :: Posting -> Posting
remapPosting p :: Posting
p = Posting
p { paccount :: AccountName
paccount = AccountName -> AccountName
remapAccount (AccountName -> AccountName) -> AccountName -> AccountName
forall a b. (a -> b) -> a -> b
$ Posting -> AccountName
paccount Posting
p, poriginal :: Maybe Posting
poriginal = Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting)
-> (Maybe Posting -> Posting) -> Maybe Posting -> Maybe Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Maybe Posting -> Posting
forall a. a -> Maybe a -> a
fromMaybe Posting
p (Maybe Posting -> Maybe Posting) -> Maybe Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Posting
poriginal Posting
p }
          where
            remapAccount :: AccountName -> AccountName
remapAccount a :: AccountName
a
              | Bool
hasbudget         = AccountName
a
              | Bool
hasbudgetedparent = if Bool
showunbudgeted then AccountName
a else AccountName
budgetedparent
              | Bool
otherwise         = if Bool
showunbudgeted then AccountName
u AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName
acctsep AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName
a else AccountName
u
              where
                hasbudget :: Bool
hasbudget = AccountName
a AccountName -> [AccountName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AccountName]
budgetedaccts
                hasbudgetedparent :: Bool
hasbudgetedparent = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ AccountName -> Bool
T.null AccountName
budgetedparent
                budgetedparent :: AccountName
budgetedparent = AccountName -> [AccountName] -> AccountName
forall a. a -> [a] -> a
headDef "" ([AccountName] -> AccountName) -> [AccountName] -> AccountName
forall a b. (a -> b) -> a -> b
$ (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter (AccountName -> [AccountName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AccountName]
budgetedaccts) ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ AccountName -> [AccountName]
parentAccountNames AccountName
a
                u :: AccountName
u = AccountName
unbudgetedAccountName

-- | Combine a per-account-and-subperiod report of budget goals, and one
-- of actual change amounts, into a budget performance report.
-- The two reports should have the same report interval, but need not
-- have exactly the same account rows or date columns.
-- (Cells in the combined budget report can be missing a budget goal,
-- an actual amount, or both.) The combined report will include:
--
-- - consecutive subperiods at the same interval as the two reports,
--   spanning the period of both reports
--
-- - all accounts mentioned in either report, sorted by account code or
--   account name or amount as appropriate.
--
combineBudgetAndActual :: ReportOpts -> Journal -> MultiBalanceReport -> MultiBalanceReport -> BudgetReport
combineBudgetAndActual :: ReportOpts
-> Journal
-> PeriodicReport DisplayName MixedAmount
-> PeriodicReport DisplayName MixedAmount
-> BudgetReport
combineBudgetAndActual ropts :: ReportOpts
ropts j :: Journal
j
      (PeriodicReport budgetperiods :: [DateSpan]
budgetperiods budgetrows :: [PeriodicReportRow DisplayName MixedAmount]
budgetrows (PeriodicReportRow _ budgettots :: [MixedAmount]
budgettots budgetgrandtot :: MixedAmount
budgetgrandtot budgetgrandavg :: MixedAmount
budgetgrandavg))
      (PeriodicReport actualperiods :: [DateSpan]
actualperiods actualrows :: [PeriodicReportRow DisplayName MixedAmount]
actualrows (PeriodicReportRow _ actualtots :: [MixedAmount]
actualtots actualgrandtot :: MixedAmount
actualgrandtot actualgrandavg :: MixedAmount
actualgrandavg)) =
    [DateSpan]
-> [PeriodicReportRow DisplayName BudgetCell]
-> PeriodicReportRow () BudgetCell
-> BudgetReport
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport [DateSpan]
periods [PeriodicReportRow DisplayName BudgetCell]
sortedrows PeriodicReportRow () BudgetCell
totalrow
  where
    periods :: [DateSpan]
periods = [DateSpan] -> [DateSpan]
forall a. Ord a => [a] -> [a]
nubSort ([DateSpan] -> [DateSpan])
-> ([DateSpan] -> [DateSpan]) -> [DateSpan] -> [DateSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateSpan -> Bool) -> [DateSpan] -> [DateSpan]
forall a. (a -> Bool) -> [a] -> [a]
filter (DateSpan -> DateSpan -> Bool
forall a. Eq a => a -> a -> Bool
/= DateSpan
nulldatespan) ([DateSpan] -> [DateSpan]) -> [DateSpan] -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ [DateSpan]
budgetperiods [DateSpan] -> [DateSpan] -> [DateSpan]
forall a. [a] -> [a] -> [a]
++ [DateSpan]
actualperiods

    -- first, combine any corresponding budget goals with actual changes
    rows1 :: [PeriodicReportRow DisplayName BudgetCell]
rows1 =
      [ DisplayName
-> [BudgetCell]
-> BudgetCell
-> BudgetCell
-> PeriodicReportRow DisplayName BudgetCell
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow DisplayName
acct [BudgetCell]
amtandgoals BudgetCell
totamtandgoal BudgetCell
avgamtandgoal
      | PeriodicReportRow acct :: DisplayName
acct actualamts :: [MixedAmount]
actualamts actualtot :: MixedAmount
actualtot actualavg :: MixedAmount
actualavg <- [PeriodicReportRow DisplayName MixedAmount]
actualrows
      , let mbudgetgoals :: Maybe ([MixedAmount], MixedAmount, MixedAmount)
mbudgetgoals       = AccountName
-> HashMap AccountName ([MixedAmount], MixedAmount, MixedAmount)
-> Maybe ([MixedAmount], MixedAmount, MixedAmount)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (DisplayName -> AccountName
displayFull DisplayName
acct) HashMap AccountName ([MixedAmount], MixedAmount, MixedAmount)
budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage)
      , let budgetmamts :: [Maybe MixedAmount]
budgetmamts        = [Maybe MixedAmount]
-> (([MixedAmount], MixedAmount, MixedAmount)
    -> [Maybe MixedAmount])
-> Maybe ([MixedAmount], MixedAmount, MixedAmount)
-> [Maybe MixedAmount]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe MixedAmount
forall a. Maybe a
Nothing Maybe MixedAmount -> [DateSpan] -> [Maybe MixedAmount]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [DateSpan]
periods) ((MixedAmount -> Maybe MixedAmount)
-> [MixedAmount] -> [Maybe MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just ([MixedAmount] -> [Maybe MixedAmount])
-> (([MixedAmount], MixedAmount, MixedAmount) -> [MixedAmount])
-> ([MixedAmount], MixedAmount, MixedAmount)
-> [Maybe MixedAmount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MixedAmount], MixedAmount, MixedAmount) -> [MixedAmount]
forall a b c. (a, b, c) -> a
first3) Maybe ([MixedAmount], MixedAmount, MixedAmount)
mbudgetgoals :: [Maybe BudgetGoal]
      , let mbudgettot :: Maybe MixedAmount
mbudgettot         = ([MixedAmount], MixedAmount, MixedAmount) -> MixedAmount
forall a b c. (a, b, c) -> b
second3 (([MixedAmount], MixedAmount, MixedAmount) -> MixedAmount)
-> Maybe ([MixedAmount], MixedAmount, MixedAmount)
-> Maybe MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([MixedAmount], MixedAmount, MixedAmount)
mbudgetgoals :: Maybe BudgetTotal
      , let mbudgetavg :: Maybe MixedAmount
mbudgetavg         = ([MixedAmount], MixedAmount, MixedAmount) -> MixedAmount
forall a b c. (a, b, c) -> c
third3 (([MixedAmount], MixedAmount, MixedAmount) -> MixedAmount)
-> Maybe ([MixedAmount], MixedAmount, MixedAmount)
-> Maybe MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([MixedAmount], MixedAmount, MixedAmount)
mbudgetgoals  :: Maybe BudgetAverage
      , let acctBudgetByPeriod :: Map DateSpan MixedAmount
acctBudgetByPeriod = [(DateSpan, MixedAmount)] -> Map DateSpan MixedAmount
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (DateSpan
p,MixedAmount
budgetamt) | (p :: DateSpan
p, Just budgetamt :: MixedAmount
budgetamt) <- [DateSpan]
-> [Maybe MixedAmount] -> [(DateSpan, Maybe MixedAmount)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DateSpan]
budgetperiods [Maybe MixedAmount]
budgetmamts ] :: Map DateSpan BudgetGoal
      , let acctActualByPeriod :: Map DateSpan MixedAmount
acctActualByPeriod = [(DateSpan, MixedAmount)] -> Map DateSpan MixedAmount
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (DateSpan
p,MixedAmount
actualamt) | (p :: DateSpan
p, Just actualamt :: MixedAmount
actualamt) <- [DateSpan]
-> [Maybe MixedAmount] -> [(DateSpan, Maybe MixedAmount)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DateSpan]
actualperiods ((MixedAmount -> Maybe MixedAmount)
-> [MixedAmount] -> [Maybe MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just [MixedAmount]
actualamts) ] :: Map DateSpan Change
      , let amtandgoals :: [BudgetCell]
amtandgoals        = [ (DateSpan -> Map DateSpan MixedAmount -> Maybe MixedAmount
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DateSpan
p Map DateSpan MixedAmount
acctActualByPeriod, DateSpan -> Map DateSpan MixedAmount -> Maybe MixedAmount
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DateSpan
p Map DateSpan MixedAmount
acctBudgetByPeriod) | DateSpan
p <- [DateSpan]
periods ] :: [BudgetCell]
      , let totamtandgoal :: BudgetCell
totamtandgoal      = (MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
actualtot, Maybe MixedAmount
mbudgettot)
      , let avgamtandgoal :: BudgetCell
avgamtandgoal      = (MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
actualavg, Maybe MixedAmount
mbudgetavg)
      ]
      where
        HashMap AccountName ([MixedAmount], MixedAmount, MixedAmount)
budgetGoalsByAcct :: HashMap AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) =
          [(AccountName, ([MixedAmount], MixedAmount, MixedAmount))]
-> HashMap AccountName ([MixedAmount], MixedAmount, MixedAmount)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [ (DisplayName -> AccountName
displayFull DisplayName
acct, ([MixedAmount]
amts, MixedAmount
tot, MixedAmount
avg))
                         | PeriodicReportRow acct :: DisplayName
acct amts :: [MixedAmount]
amts tot :: MixedAmount
tot avg :: MixedAmount
avg <- [PeriodicReportRow DisplayName MixedAmount]
budgetrows ]

    -- next, make rows for budget goals with no actual changes
    rows2 :: [PeriodicReportRow DisplayName BudgetCell]
rows2 =
      [ DisplayName
-> [BudgetCell]
-> BudgetCell
-> BudgetCell
-> PeriodicReportRow DisplayName BudgetCell
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow DisplayName
acct [BudgetCell]
amtandgoals BudgetCell
forall a. (Maybe a, Maybe MixedAmount)
totamtandgoal BudgetCell
forall a. (Maybe a, Maybe MixedAmount)
avgamtandgoal
      | PeriodicReportRow acct :: DisplayName
acct budgetgoals :: [MixedAmount]
budgetgoals budgettot :: MixedAmount
budgettot budgetavg :: MixedAmount
budgetavg <- [PeriodicReportRow DisplayName MixedAmount]
budgetrows
      , DisplayName -> AccountName
displayFull DisplayName
acct AccountName -> [AccountName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (PeriodicReportRow DisplayName BudgetCell -> AccountName)
-> [PeriodicReportRow DisplayName BudgetCell] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow DisplayName BudgetCell -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName [PeriodicReportRow DisplayName BudgetCell]
rows1
      , let acctBudgetByPeriod :: Map DateSpan MixedAmount
acctBudgetByPeriod = [(DateSpan, MixedAmount)] -> Map DateSpan MixedAmount
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(DateSpan, MixedAmount)] -> Map DateSpan MixedAmount)
-> [(DateSpan, MixedAmount)] -> Map DateSpan MixedAmount
forall a b. (a -> b) -> a -> b
$ [DateSpan] -> [MixedAmount] -> [(DateSpan, MixedAmount)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DateSpan]
budgetperiods [MixedAmount]
budgetgoals :: Map DateSpan BudgetGoal
      , let amtandgoals :: [BudgetCell]
amtandgoals        = [ (Maybe MixedAmount
forall a. Maybe a
Nothing, DateSpan -> Map DateSpan MixedAmount -> Maybe MixedAmount
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DateSpan
p Map DateSpan MixedAmount
acctBudgetByPeriod) | DateSpan
p <- [DateSpan]
periods ] :: [BudgetCell]
      , let totamtandgoal :: (Maybe a, Maybe MixedAmount)
totamtandgoal      = (Maybe a
forall a. Maybe a
Nothing, MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
budgettot)
      , let avgamtandgoal :: (Maybe a, Maybe MixedAmount)
avgamtandgoal      = (Maybe a
forall a. Maybe a
Nothing, MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
budgetavg)
      ]

    -- combine and re-sort rows
    -- TODO: add --sort-budget to sort by budget goal amount
    [PeriodicReportRow DisplayName BudgetCell]
sortedrows :: [BudgetReportRow] = [AccountName]
-> [PeriodicReportRow DisplayName BudgetCell]
-> [PeriodicReportRow DisplayName BudgetCell]
forall b.
[AccountName]
-> [PeriodicReportRow DisplayName b]
-> [PeriodicReportRow DisplayName b]
sortRowsLike ([PeriodicReportRow DisplayName BudgetCell] -> [AccountName]
forall b.
[PeriodicReportRow DisplayName (Maybe MixedAmount, b)]
-> [AccountName]
mbrsorted [PeriodicReportRow DisplayName BudgetCell]
unbudgetedrows [AccountName] -> [AccountName] -> [AccountName]
forall a. [a] -> [a] -> [a]
++ [PeriodicReportRow DisplayName BudgetCell] -> [AccountName]
forall b.
[PeriodicReportRow DisplayName (Maybe MixedAmount, b)]
-> [AccountName]
mbrsorted [PeriodicReportRow DisplayName BudgetCell]
rows') [PeriodicReportRow DisplayName BudgetCell]
rows
      where
        (unbudgetedrows :: [PeriodicReportRow DisplayName BudgetCell]
unbudgetedrows, rows' :: [PeriodicReportRow DisplayName BudgetCell]
rows') = (PeriodicReportRow DisplayName BudgetCell -> Bool)
-> [PeriodicReportRow DisplayName BudgetCell]
-> ([PeriodicReportRow DisplayName BudgetCell],
    [PeriodicReportRow DisplayName BudgetCell])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
==AccountName
unbudgetedAccountName) (AccountName -> Bool)
-> (PeriodicReportRow DisplayName BudgetCell -> AccountName)
-> PeriodicReportRow DisplayName BudgetCell
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodicReportRow DisplayName BudgetCell -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName) [PeriodicReportRow DisplayName BudgetCell]
rows
        mbrsorted :: [PeriodicReportRow DisplayName (Maybe MixedAmount, b)]
-> [AccountName]
mbrsorted = (PeriodicReportRow DisplayName MixedAmount -> AccountName)
-> [PeriodicReportRow DisplayName MixedAmount] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow DisplayName MixedAmount -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName ([PeriodicReportRow DisplayName MixedAmount] -> [AccountName])
-> ([PeriodicReportRow DisplayName (Maybe MixedAmount, b)]
    -> [PeriodicReportRow DisplayName MixedAmount])
-> [PeriodicReportRow DisplayName (Maybe MixedAmount, b)]
-> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts
-> Journal
-> [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
sortRows ReportOpts
ropts Journal
j ([PeriodicReportRow DisplayName MixedAmount]
 -> [PeriodicReportRow DisplayName MixedAmount])
-> ([PeriodicReportRow DisplayName (Maybe MixedAmount, b)]
    -> [PeriodicReportRow DisplayName MixedAmount])
-> [PeriodicReportRow DisplayName (Maybe MixedAmount, b)]
-> [PeriodicReportRow DisplayName MixedAmount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeriodicReportRow DisplayName (Maybe MixedAmount, b)
 -> PeriodicReportRow DisplayName MixedAmount)
-> [PeriodicReportRow DisplayName (Maybe MixedAmount, b)]
-> [PeriodicReportRow DisplayName MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (((Maybe MixedAmount, b) -> MixedAmount)
-> PeriodicReportRow DisplayName (Maybe MixedAmount, b)
-> PeriodicReportRow DisplayName MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Maybe MixedAmount, b) -> MixedAmount)
 -> PeriodicReportRow DisplayName (Maybe MixedAmount, b)
 -> PeriodicReportRow DisplayName MixedAmount)
-> ((Maybe MixedAmount, b) -> MixedAmount)
-> PeriodicReportRow DisplayName (Maybe MixedAmount, b)
-> PeriodicReportRow DisplayName MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe MixedAmount -> MixedAmount)
-> ((Maybe MixedAmount, b) -> Maybe MixedAmount)
-> (Maybe MixedAmount, b)
-> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe MixedAmount, b) -> Maybe MixedAmount
forall a b. (a, b) -> a
fst)
        rows :: [PeriodicReportRow DisplayName BudgetCell]
rows = [PeriodicReportRow DisplayName BudgetCell]
rows1 [PeriodicReportRow DisplayName BudgetCell]
-> [PeriodicReportRow DisplayName BudgetCell]
-> [PeriodicReportRow DisplayName BudgetCell]
forall a. [a] -> [a] -> [a]
++ [PeriodicReportRow DisplayName BudgetCell]
rows2

    -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells
    totalrow :: PeriodicReportRow () BudgetCell
totalrow = ()
-> [BudgetCell]
-> BudgetCell
-> BudgetCell
-> PeriodicReportRow () BudgetCell
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow ()
        [ (DateSpan -> Map DateSpan MixedAmount -> Maybe MixedAmount
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DateSpan
p Map DateSpan MixedAmount
totActualByPeriod, DateSpan -> Map DateSpan MixedAmount -> Maybe MixedAmount
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DateSpan
p Map DateSpan MixedAmount
totBudgetByPeriod) | DateSpan
p <- [DateSpan]
periods ]
        ( MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
actualgrandtot, MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
budgetgrandtot )
        ( MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
actualgrandavg, MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
budgetgrandavg )
      where
        totBudgetByPeriod :: Map DateSpan MixedAmount
totBudgetByPeriod = [(DateSpan, MixedAmount)] -> Map DateSpan MixedAmount
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(DateSpan, MixedAmount)] -> Map DateSpan MixedAmount)
-> [(DateSpan, MixedAmount)] -> Map DateSpan MixedAmount
forall a b. (a -> b) -> a -> b
$ [DateSpan] -> [MixedAmount] -> [(DateSpan, MixedAmount)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DateSpan]
budgetperiods [MixedAmount]
budgettots :: Map DateSpan BudgetTotal
        totActualByPeriod :: Map DateSpan MixedAmount
totActualByPeriod = [(DateSpan, MixedAmount)] -> Map DateSpan MixedAmount
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(DateSpan, MixedAmount)] -> Map DateSpan MixedAmount)
-> [(DateSpan, MixedAmount)] -> Map DateSpan MixedAmount
forall a b. (a -> b) -> a -> b
$ [DateSpan] -> [MixedAmount] -> [(DateSpan, MixedAmount)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DateSpan]
actualperiods [MixedAmount]
actualtots :: Map DateSpan Change

-- | Render a budget report as plain text suitable for console output.
budgetReportAsText :: ReportOpts -> BudgetReport -> String
budgetReportAsText :: ReportOpts -> BudgetReport -> String
budgetReportAsText ropts :: ReportOpts
ropts@ReportOpts{..} budgetr :: BudgetReport
budgetr =
  String
title String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
  ReportOpts
-> (BudgetCell -> String)
-> Table String String BudgetCell
-> String
forall a.
ReportOpts -> (a -> String) -> Table String String a -> String
tableAsText ReportOpts
ropts BudgetCell -> String
showcell (Table String String BudgetCell -> Table String String BudgetCell
forall rh a. Table rh rh a -> Table rh rh a
maybetranspose (Table String String BudgetCell -> Table String String BudgetCell)
-> Table String String BudgetCell -> Table String String BudgetCell
forall a b. (a -> b) -> a -> b
$ ReportOpts -> BudgetReport -> Table String String BudgetCell
budgetReportAsTable ReportOpts
ropts BudgetReport
budgetr)
  where
    multiperiod :: Bool
multiperiod = Interval
interval_ Interval -> Interval -> Bool
forall a. Eq a => a -> a -> Bool
/= Interval
NoInterval
    title :: String
title = String -> String -> String -> String
forall r. PrintfType r => String -> r
printf "Budget performance in %s%s:"
      (DateSpan -> String
showDateSpan (DateSpan -> String) -> DateSpan -> String
forall a b. (a -> b) -> a -> b
$ BudgetReport -> DateSpan
forall a b. PeriodicReport a b -> DateSpan
periodicReportSpan BudgetReport
budgetr)
      (case Maybe ValuationType
value_ of
        Just (AtCost _mc :: Maybe AccountName
_mc)   -> ", valued at cost"
        Just (AtThen _mc :: Maybe AccountName
_mc)   -> String -> String
forall a. String -> a
error' String
unsupportedValueThenError  -- PARTIAL:
        Just (AtEnd _mc :: Maybe AccountName
_mc)    -> ", valued at period ends"
        Just (AtNow _mc :: Maybe AccountName
_mc)    -> ", current value"
        -- XXX duplicates the above
        Just (AtDefault _mc :: Maybe AccountName
_mc) | Bool
multiperiod -> ", valued at period ends"
        Just (AtDefault _mc :: Maybe AccountName
_mc)  -> ", current value"
        Just (AtDate d :: Day
d _mc :: Maybe AccountName
_mc) -> ", valued at "String -> String -> String
forall a. [a] -> [a] -> [a]
++Day -> String
showDate Day
d
        Nothing             -> "")
    actualwidth :: Int
actualwidth = [Int] -> Int
forall a. Integral a => [a] -> a
maximum' ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
amountsAndGoals
    budgetwidth :: Int
budgetwidth = [Int] -> Int
forall a. Integral a => [a] -> a
maximum' ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
amountsAndGoals
    amountsAndGoals :: [(Int, Int)]
amountsAndGoals =
      (BudgetCell -> (Int, Int)) -> [BudgetCell] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Maybe MixedAmount
a,g :: Maybe MixedAmount
g) -> (Maybe MixedAmount -> Int
amountWidth Maybe MixedAmount
a, Maybe MixedAmount -> Int
amountWidth Maybe MixedAmount
g)) ([BudgetCell] -> [(Int, Int)])
-> ([PeriodicReportRow DisplayName BudgetCell] -> [BudgetCell])
-> [PeriodicReportRow DisplayName BudgetCell]
-> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeriodicReportRow DisplayName BudgetCell -> [BudgetCell])
-> [PeriodicReportRow DisplayName BudgetCell] -> [BudgetCell]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PeriodicReportRow DisplayName BudgetCell -> [BudgetCell]
forall a b. PeriodicReportRow a b -> [b]
prrAmounts ([PeriodicReportRow DisplayName BudgetCell] -> [(Int, Int)])
-> [PeriodicReportRow DisplayName BudgetCell] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ BudgetReport -> [PeriodicReportRow DisplayName BudgetCell]
forall a b. PeriodicReport a b -> [PeriodicReportRow a b]
prRows BudgetReport
budgetr
      where
        amountWidth :: Maybe MixedAmount -> Int
amountWidth = Int -> (MixedAmount -> Int) -> Maybe MixedAmount -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 0 (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (MixedAmount -> String) -> MixedAmount -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> MixedAmount -> String
showMixedAmountElided Bool
False)
    -- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells
    showcell :: BudgetCell -> String
    showcell :: BudgetCell -> String
showcell (mactual :: Maybe MixedAmount
mactual, mbudget :: Maybe MixedAmount
mbudget) = String
actualstr String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
budgetstr
      where
        percentwidth :: Int
percentwidth = 4
        actual :: MixedAmount
actual = MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe 0 Maybe MixedAmount
mactual
        actualstr :: String
actualstr = String -> String -> String
forall r. PrintfType r => String -> r
printf ("%"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
actualwidthString -> String -> String
forall a. [a] -> [a] -> [a]
++"s") (MixedAmount -> String
showamt MixedAmount
actual)
        budgetstr :: String
budgetstr = case Maybe MixedAmount
mbudget of
          Nothing     -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
percentwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
budgetwidth) ' '
          Just budget :: MixedAmount
budget ->
            case MixedAmount -> MixedAmount -> Maybe Percentage
percentage MixedAmount
actual MixedAmount
budget of
              Just pct :: Percentage
pct ->
                String -> String -> String -> String
forall r. PrintfType r => String -> r
printf ("[%"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
percentwidthString -> String -> String
forall a. [a] -> [a] -> [a]
++"s%% of %"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
budgetwidthString -> String -> String
forall a. [a] -> [a] -> [a]
++"s]")
                       (Percentage -> String
forall a. Show a => a -> String
show (Percentage -> String) -> Percentage -> String
forall a b. (a -> b) -> a -> b
$ Word8 -> Percentage -> Percentage
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo 0 Percentage
pct) (MixedAmount -> String
showamt' MixedAmount
budget)
              Nothing ->
                String -> String -> String
forall r. PrintfType r => String -> r
printf ("["String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
percentwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
+5) ' 'String -> String -> String
forall a. [a] -> [a] -> [a]
++"%"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
budgetwidthString -> String -> String
forall a. [a] -> [a] -> [a]
++"s]")
                       (MixedAmount -> String
showamt' MixedAmount
budget)
        showamt :: MixedAmount -> String
showamt = Bool -> MixedAmount -> String
showMixedAmountElided Bool
color_
        showamt' :: MixedAmount -> String
showamt' = Bool -> MixedAmount -> String
showMixedAmountElided Bool
False  -- XXX colored budget amounts disrupts layout

    -- | Calculate the percentage of actual change to budget goal to show, if any.
    -- If valuing at cost, both amounts are converted to cost before comparing.
    -- A percentage will not be shown if:
    -- - actual or goal are not the same, single, commodity
    -- - the goal is zero
    percentage :: Change -> BudgetGoal -> Maybe Percentage
    percentage :: MixedAmount -> MixedAmount -> Maybe Percentage
percentage actual :: MixedAmount
actual budget :: MixedAmount
budget =
      case (MixedAmount -> MixedAmount
maybecost (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
normaliseMixedAmount MixedAmount
actual, MixedAmount -> MixedAmount
maybecost (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
normaliseMixedAmount MixedAmount
budget) of
        (Mixed [a :: Amount
a], Mixed [b :: Amount
b]) | (Amount -> AccountName
acommodity Amount
a AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> AccountName
acommodity Amount
b Bool -> Bool -> Bool
|| Amount -> Bool
amountLooksZero Amount
a) Bool -> Bool -> Bool
&& Bool -> Bool
not (Amount -> Bool
amountLooksZero Amount
b)
            -> Percentage -> Maybe Percentage
forall a. a -> Maybe a
Just (Percentage -> Maybe Percentage) -> Percentage -> Maybe Percentage
forall a b. (a -> b) -> a -> b
$ 100 Percentage -> Percentage -> Percentage
forall a. Num a => a -> a -> a
* Amount -> Percentage
aquantity Amount
a Percentage -> Percentage -> Percentage
forall a. Fractional a => a -> a -> a
/ Amount -> Percentage
aquantity Amount
b
        _   -> -- trace (pshow $ (maybecost actual, maybecost budget))  -- debug missing percentage
               Maybe Percentage
forall a. Maybe a
Nothing
      where
        maybecost :: MixedAmount -> MixedAmount
maybecost = if ReportOpts -> Bool
valuationTypeIsCost ReportOpts
ropts then MixedAmount -> MixedAmount
mixedAmountCost else MixedAmount -> MixedAmount
forall a. a -> a
id

    maybetranspose :: Table rh rh a -> Table rh rh a
maybetranspose | Bool
transpose_ = \(Table rh :: Header rh
rh ch :: Header rh
ch vals :: [[a]]
vals) -> Header rh -> Header rh -> [[a]] -> Table rh rh a
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table Header rh
ch Header rh
rh ([[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose [[a]]
vals)
                   | Bool
otherwise  = Table rh rh a -> Table rh rh a
forall a. a -> a
id

-- | Build a 'Table' from a multi-column balance report.
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount)
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String BudgetCell
budgetReportAsTable
  ropts :: ReportOpts
ropts@ReportOpts{BalanceType
balancetype_ :: BalanceType
balancetype_ :: ReportOpts -> BalanceType
balancetype_}
  (PeriodicReport spans :: [DateSpan]
spans rows :: [PeriodicReportRow DisplayName BudgetCell]
rows (PeriodicReportRow _ coltots :: [BudgetCell]
coltots grandtot :: BudgetCell
grandtot grandavg :: BudgetCell
grandavg)) =
    Table String String BudgetCell -> Table String String BudgetCell
forall ch. Table String ch BudgetCell -> Table String ch BudgetCell
addtotalrow (Table String String BudgetCell -> Table String String BudgetCell)
-> Table String String BudgetCell -> Table String String BudgetCell
forall a b. (a -> b) -> a -> b
$
    Header String
-> Header String
-> [[BudgetCell]]
-> Table String String BudgetCell
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table
      (Properties -> [Header String] -> Header String
forall h. Properties -> [Header h] -> Header h
T.Group Properties
NoLine ([Header String] -> Header String)
-> [Header String] -> Header String
forall a b. (a -> b) -> a -> b
$ (String -> Header String) -> [String] -> [Header String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Header String
forall h. h -> Header h
Header [String]
accts)
      (Properties -> [Header String] -> Header String
forall h. Properties -> [Header h] -> Header h
T.Group Properties
NoLine ([Header String] -> Header String)
-> [Header String] -> Header String
forall a b. (a -> b) -> a -> b
$ (String -> Header String) -> [String] -> [Header String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Header String
forall h. h -> Header h
Header [String]
colheadings)
      ((PeriodicReportRow DisplayName BudgetCell -> [BudgetCell])
-> [PeriodicReportRow DisplayName BudgetCell] -> [[BudgetCell]]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow DisplayName BudgetCell -> [BudgetCell]
forall a b. PeriodicReportRow a b -> [b]
rowvals [PeriodicReportRow DisplayName BudgetCell]
rows)
  where
    colheadings :: [String]
colheadings = (DateSpan -> String) -> [DateSpan] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (BalanceType -> [DateSpan] -> DateSpan -> String
reportPeriodName BalanceType
balancetype_ [DateSpan]
spans) [DateSpan]
spans
                  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["  Total" | ReportOpts -> Bool
row_total_ ReportOpts
ropts]
                  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["Average" | ReportOpts -> Bool
average_ ReportOpts
ropts]

    accts :: [String]
accts = (PeriodicReportRow DisplayName BudgetCell -> String)
-> [PeriodicReportRow DisplayName BudgetCell] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow DisplayName BudgetCell -> String
forall a. PeriodicReportRow DisplayName a -> String
renderacct [PeriodicReportRow DisplayName BudgetCell]
rows
    -- FIXME. Have to check explicitly for which to render here, since
    -- budgetReport sets accountlistmode to ALTree. Find a principled way to do
    -- this.
    renderacct :: PeriodicReportRow DisplayName a -> String
renderacct row :: PeriodicReportRow DisplayName a
row = case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of
        ALTree -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate ((PeriodicReportRow DisplayName a -> Int
forall a. PeriodicReportRow DisplayName a -> Int
prrDepth PeriodicReportRow DisplayName a
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*2) ' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ AccountName -> String
T.unpack (PeriodicReportRow DisplayName a -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrDisplayName PeriodicReportRow DisplayName a
row)
        ALFlat -> AccountName -> String
T.unpack (AccountName -> String)
-> (AccountName -> AccountName) -> AccountName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AccountName -> AccountName
accountNameDrop (ReportOpts -> Int
drop_ ReportOpts
ropts) (AccountName -> String) -> AccountName -> String
forall a b. (a -> b) -> a -> b
$ PeriodicReportRow DisplayName a -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName PeriodicReportRow DisplayName a
row
    rowvals :: PeriodicReportRow a a -> [a]
rowvals (PeriodicReportRow _ as :: [a]
as rowtot :: a
rowtot rowavg :: a
rowavg) =
        [a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
rowtot | ReportOpts -> Bool
row_total_ ReportOpts
ropts] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
rowavg | ReportOpts -> Bool
average_ ReportOpts
ropts]
    addtotalrow :: Table String ch BudgetCell -> Table String ch BudgetCell
addtotalrow
      | ReportOpts -> Bool
no_total_ ReportOpts
ropts = Table String ch BudgetCell -> Table String ch BudgetCell
forall a. a -> a
id
      | Bool
otherwise = (Table String ch BudgetCell
-> SemiTable String BudgetCell -> Table String ch BudgetCell
forall rh ch a. Table rh ch a -> SemiTable rh a -> Table rh ch a
+----+ (String -> [BudgetCell] -> SemiTable String BudgetCell
forall rh a. rh -> [a] -> SemiTable rh a
row "" ([BudgetCell] -> SemiTable String BudgetCell)
-> [BudgetCell] -> SemiTable String BudgetCell
forall a b. (a -> b) -> a -> b
$
                       [BudgetCell]
coltots [BudgetCell] -> [BudgetCell] -> [BudgetCell]
forall a. [a] -> [a] -> [a]
++ [BudgetCell
grandtot | ReportOpts -> Bool
row_total_ ReportOpts
ropts Bool -> Bool -> Bool
&& Bool -> Bool
not ([BudgetCell] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BudgetCell]
coltots)]
                               [BudgetCell] -> [BudgetCell] -> [BudgetCell]
forall a. [a] -> [a] -> [a]
++ [BudgetCell
grandavg | ReportOpts -> Bool
average_ ReportOpts
ropts Bool -> Bool -> Bool
&& Bool -> Bool
not ([BudgetCell] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BudgetCell]
coltots)]
                    ))

-- | Make a name for the given period in a multiperiod report, given
-- the type of balance being reported and the full set of report
-- periods. This will be used as a column heading (or row heading, in
-- a register summary report). We try to pick a useful name as follows:
--
-- - ending-balance reports: the period's end date
--
-- - balance change reports where the periods are months and all in the same year:
--   the short month name in the current locale
--
-- - all other balance change reports: a description of the datespan,
--   abbreviated to compact form if possible (see showDateSpan).
--
reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> String
reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> String
reportPeriodName balancetype :: BalanceType
balancetype spans :: [DateSpan]
spans =
  case BalanceType
balancetype of
    PeriodChange -> if Bool
multiyear then DateSpan -> String
showDateSpan else DateSpan -> String
showDateSpanMonthAbbrev
      where
        multiyear :: Bool
multiyear = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>1) (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ [Maybe Year] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Maybe Year] -> Int) -> [Maybe Year] -> Int
forall a b. (a -> b) -> a -> b
$ [Maybe Year] -> [Maybe Year]
forall a. Ord a => [a] -> [a]
nubSort ([Maybe Year] -> [Maybe Year]) -> [Maybe Year] -> [Maybe Year]
forall a b. (a -> b) -> a -> b
$ (DateSpan -> Maybe Year) -> [DateSpan] -> [Maybe Year]
forall a b. (a -> b) -> [a] -> [b]
map DateSpan -> Maybe Year
spanStartYear [DateSpan]
spans
    _ -> String -> (Day -> String) -> Maybe Day -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (Day -> String
showDate (Day -> String) -> (Day -> Day) -> Day -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Day
prevday) (Maybe Day -> String)
-> (DateSpan -> Maybe Day) -> DateSpan -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateSpan -> Maybe Day
spanEnd

-- tests

tests_BudgetReport :: TestTree
tests_BudgetReport = String -> [TestTree] -> TestTree
tests "BudgetReport" [
 ]