{- |
-}

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

module Hledger.Reports.BudgetReport
where

import Data.Decimal
import Data.List
import Data.List.Extra (nubSort)
import Data.Maybe
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import Data.Ord
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 Text.Tabular.AsciiWide

import Hledger.Data
--import Hledger.Query
import Hledger.Utils
--import Hledger.Read (mamountp')
import Hledger.Reports.ReportOptions
import Hledger.Reports.ReportTypes
import Hledger.Reports.BalanceReport (sortAccountItemsLike)
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 BudgetReport = PeriodicReport AccountName BudgetCell
type BudgetReportRow = PeriodicReportRow AccountName 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 =
  let
    -- 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 AccountName MixedAmount
actualreport@(PeriodicReport actualspans :: [DateSpan]
actualspans _ _) =
        String
-> PeriodicReport AccountName MixedAmount
-> PeriodicReport AccountName MixedAmount
forall a. Show a => String -> a -> a
dbg1 "actualreport" (PeriodicReport AccountName MixedAmount
 -> PeriodicReport AccountName MixedAmount)
-> PeriodicReport AccountName MixedAmount
-> PeriodicReport AccountName MixedAmount
forall a b. (a -> b) -> a -> b
$ Day
-> ReportOpts -> Journal -> PeriodicReport AccountName MixedAmount
multiBalanceReport Day
d ReportOpts
ropts Journal
actualj
    budgetgoalreport :: PeriodicReport AccountName MixedAmount
budgetgoalreport@(PeriodicReport _ budgetgoalitems :: [PeriodicReportRow AccountName MixedAmount]
budgetgoalitems budgetgoaltotals :: PeriodicReportRow () MixedAmount
budgetgoaltotals) =
        String
-> PeriodicReport AccountName MixedAmount
-> PeriodicReport AccountName MixedAmount
forall a. Show a => String -> a -> a
dbg1 "budgetgoalreport" (PeriodicReport AccountName MixedAmount
 -> PeriodicReport AccountName MixedAmount)
-> PeriodicReport AccountName MixedAmount
-> PeriodicReport AccountName MixedAmount
forall a b. (a -> b) -> a -> b
$ Day
-> ReportOpts -> Journal -> PeriodicReport AccountName MixedAmount
multiBalanceReport Day
d (ReportOpts
ropts{empty_ :: Bool
empty_=Bool
True}) Journal
budgetj
    budgetgoalreport' :: PeriodicReport AccountName 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 AccountName MixedAmount]
-> PeriodicReportRow () MixedAmount
-> PeriodicReport AccountName MixedAmount
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport [DateSpan]
actualspans [PeriodicReportRow AccountName MixedAmount]
budgetgoalitems PeriodicReportRow () MixedAmount
budgetgoaltotals
      | Bool
otherwise = PeriodicReport AccountName MixedAmount
budgetgoalreport
    budgetreport :: BudgetReport
budgetreport = PeriodicReport AccountName MixedAmount
-> PeriodicReport AccountName MixedAmount -> BudgetReport
combineBudgetAndActual PeriodicReport AccountName MixedAmount
budgetgoalreport' PeriodicReport AccountName MixedAmount
actualreport
    sortedbudgetreport :: BudgetReport
sortedbudgetreport = ReportOpts -> Journal -> BudgetReport -> BudgetReport
sortBudgetReport ReportOpts
ropts Journal
j BudgetReport
budgetreport
  in
    String -> BudgetReport -> BudgetReport
forall a. Show a => String -> a -> a
dbg1 "sortedbudgetreport" BudgetReport
sortedbudgetreport

-- | Sort a budget report's rows according to options.
sortBudgetReport :: ReportOpts -> Journal -> BudgetReport -> BudgetReport
sortBudgetReport :: ReportOpts -> Journal -> BudgetReport -> BudgetReport
sortBudgetReport ropts :: ReportOpts
ropts j :: Journal
j (PeriodicReport ps :: [DateSpan]
ps rows :: [PeriodicReportRow AccountName BudgetCell]
rows trow :: PeriodicReportRow () BudgetCell
trow) = [DateSpan]
-> [PeriodicReportRow AccountName BudgetCell]
-> PeriodicReportRow () BudgetCell
-> BudgetReport
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport [DateSpan]
ps [PeriodicReportRow AccountName BudgetCell]
sortedrows PeriodicReportRow () BudgetCell
trow
  where
    sortedrows :: [PeriodicReportRow AccountName BudgetCell]
sortedrows
      | ReportOpts -> Bool
sort_amount_ ReportOpts
ropts Bool -> Bool -> Bool
&& ReportOpts -> Bool
tree_ ReportOpts
ropts = [PeriodicReportRow AccountName BudgetCell]
-> [PeriodicReportRow AccountName BudgetCell]
sortTreeBURByActualAmount [PeriodicReportRow AccountName BudgetCell]
rows
      | ReportOpts -> Bool
sort_amount_ ReportOpts
ropts                = [PeriodicReportRow AccountName BudgetCell]
-> [PeriodicReportRow AccountName BudgetCell]
sortFlatBURByActualAmount [PeriodicReportRow AccountName BudgetCell]
rows
      | Bool
otherwise                         = [PeriodicReportRow AccountName BudgetCell]
-> [PeriodicReportRow AccountName BudgetCell]
forall b.
[PeriodicReportRow AccountName b]
-> [PeriodicReportRow AccountName b]
sortByAccountDeclaration [PeriodicReportRow AccountName BudgetCell]
rows

    -- Sort a tree-mode budget report's rows by total actual amount at each level.
    sortTreeBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow]
    sortTreeBURByActualAmount :: [PeriodicReportRow AccountName BudgetCell]
-> [PeriodicReportRow AccountName BudgetCell]
sortTreeBURByActualAmount rows :: [PeriodicReportRow AccountName BudgetCell]
rows = [PeriodicReportRow AccountName BudgetCell]
sortedrows
      where
        anamesandrows :: [(AccountName, PeriodicReportRow AccountName BudgetCell)]
anamesandrows = [(PeriodicReportRow AccountName BudgetCell -> AccountName
forall a b. PeriodicReportRow a b -> a
prrName PeriodicReportRow AccountName BudgetCell
r, PeriodicReportRow AccountName BudgetCell
r) | PeriodicReportRow AccountName BudgetCell
r <- [PeriodicReportRow AccountName BudgetCell]
rows]
        anames :: [AccountName]
anames = ((AccountName, PeriodicReportRow AccountName BudgetCell)
 -> AccountName)
-> [(AccountName, PeriodicReportRow AccountName BudgetCell)]
-> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, PeriodicReportRow AccountName BudgetCell)
-> AccountName
forall a b. (a, b) -> a
fst [(AccountName, PeriodicReportRow AccountName BudgetCell)]
anamesandrows
        atotals :: [(AccountName, Maybe MixedAmount)]
atotals = [(AccountName
a, Maybe MixedAmount
tot) | PeriodicReportRow a :: AccountName
a _ _ (tot :: Maybe MixedAmount
tot,_) _ <- [PeriodicReportRow AccountName BudgetCell]
rows]
        accounttree :: Account
accounttree = AccountName -> [AccountName] -> Account
accountTree "root" [AccountName]
anames
        accounttreewithbals :: Account
accounttreewithbals = (Account -> Account) -> Account -> Account
mapAccounts Account -> Account
setibalance Account
accounttree
          where
            setibalance :: Account -> Account
setibalance a :: Account
a = Account
a{aibalance :: MixedAmount
aibalance=
              MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe MixedAmount -> MixedAmount)
-> Maybe MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ -- when there's no actual amount, assume 0; will mess up with negative amounts ? TODO
              Maybe MixedAmount -> Maybe (Maybe MixedAmount) -> Maybe MixedAmount
forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe MixedAmount
forall a. HasCallStack => String -> a
error "sortTreeByAmount 1") (Maybe (Maybe MixedAmount) -> Maybe MixedAmount)
-> Maybe (Maybe MixedAmount) -> Maybe MixedAmount
forall a b. (a -> b) -> a -> b
$ -- should not happen, but it's ugly; TODO
              AccountName
-> [(AccountName, Maybe MixedAmount)] -> Maybe (Maybe MixedAmount)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Account -> AccountName
aname Account
a) [(AccountName, Maybe MixedAmount)]
atotals
              }
        sortedaccounttree :: Account
sortedaccounttree = NormalSign -> Account -> Account
sortAccountTreeByAmount (NormalSign -> Maybe NormalSign -> NormalSign
forall a. a -> Maybe a -> a
fromMaybe NormalSign
NormallyPositive (Maybe NormalSign -> NormalSign) -> Maybe NormalSign -> NormalSign
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Maybe NormalSign
normalbalance_ ReportOpts
ropts) Account
accounttreewithbals
        sortedanames :: [AccountName]
sortedanames = (Account -> AccountName) -> [Account] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Account -> AccountName
aname ([Account] -> [AccountName]) -> [Account] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Int -> [Account] -> [Account]
forall a. Int -> [a] -> [a]
drop 1 ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
flattenAccounts Account
sortedaccounttree
        sortedrows :: [PeriodicReportRow AccountName BudgetCell]
sortedrows = [AccountName]
-> [(AccountName, PeriodicReportRow AccountName BudgetCell)]
-> [PeriodicReportRow AccountName BudgetCell]
forall b. [AccountName] -> [(AccountName, b)] -> [b]
sortAccountItemsLike [AccountName]
sortedanames [(AccountName, PeriodicReportRow AccountName BudgetCell)]
anamesandrows

    -- Sort a flat-mode budget report's rows by total actual amount.
    sortFlatBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow]
    sortFlatBURByActualAmount :: [PeriodicReportRow AccountName BudgetCell]
-> [PeriodicReportRow AccountName BudgetCell]
sortFlatBURByActualAmount = case ReportOpts -> Maybe NormalSign
normalbalance_ ReportOpts
ropts of
        Just NormallyNegative -> (PeriodicReportRow AccountName BudgetCell -> Maybe MixedAmount)
-> [PeriodicReportRow AccountName BudgetCell]
-> [PeriodicReportRow AccountName BudgetCell]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (BudgetCell -> Maybe MixedAmount
forall a b. (a, b) -> a
fst (BudgetCell -> Maybe MixedAmount)
-> (PeriodicReportRow AccountName BudgetCell -> BudgetCell)
-> PeriodicReportRow AccountName BudgetCell
-> Maybe MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodicReportRow AccountName BudgetCell -> BudgetCell
forall a b. PeriodicReportRow a b -> b
prrTotal)
        _                     -> (PeriodicReportRow AccountName BudgetCell
 -> Down (Maybe MixedAmount))
-> [PeriodicReportRow AccountName BudgetCell]
-> [PeriodicReportRow AccountName BudgetCell]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Maybe MixedAmount -> Down (Maybe MixedAmount)
forall a. a -> Down a
Down (Maybe MixedAmount -> Down (Maybe MixedAmount))
-> (PeriodicReportRow AccountName BudgetCell -> Maybe MixedAmount)
-> PeriodicReportRow AccountName BudgetCell
-> Down (Maybe MixedAmount)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BudgetCell -> Maybe MixedAmount
forall a b. (a, b) -> a
fst (BudgetCell -> Maybe MixedAmount)
-> (PeriodicReportRow AccountName BudgetCell -> BudgetCell)
-> PeriodicReportRow AccountName BudgetCell
-> Maybe MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodicReportRow AccountName BudgetCell -> BudgetCell
forall a b. PeriodicReportRow a b -> b
prrTotal)

    -- Sort the report rows by account declaration order then account name.
    -- <unbudgeted> remains at the top.
    sortByAccountDeclaration :: [PeriodicReportRow AccountName b]
-> [PeriodicReportRow AccountName b]
sortByAccountDeclaration rows :: [PeriodicReportRow AccountName b]
rows = [PeriodicReportRow AccountName b]
sortedrows
      where
        (unbudgetedrow :: [PeriodicReportRow AccountName b]
unbudgetedrow,rows' :: [PeriodicReportRow AccountName b]
rows') = (PeriodicReportRow AccountName b -> Bool)
-> [PeriodicReportRow AccountName b]
-> ([PeriodicReportRow AccountName b],
    [PeriodicReportRow AccountName b])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
=="<unbudgeted>") (AccountName -> Bool)
-> (PeriodicReportRow AccountName b -> AccountName)
-> PeriodicReportRow AccountName b
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodicReportRow AccountName b -> AccountName
forall a b. PeriodicReportRow a b -> a
prrName) [PeriodicReportRow AccountName b]
rows
        anamesandrows :: [(AccountName, PeriodicReportRow AccountName b)]
anamesandrows = [(PeriodicReportRow AccountName b -> AccountName
forall a b. PeriodicReportRow a b -> a
prrName PeriodicReportRow AccountName b
r, PeriodicReportRow AccountName b
r) | PeriodicReportRow AccountName b
r <- [PeriodicReportRow AccountName b]
rows']
        anames :: [AccountName]
anames = ((AccountName, PeriodicReportRow AccountName b) -> AccountName)
-> [(AccountName, PeriodicReportRow AccountName b)]
-> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, PeriodicReportRow AccountName b) -> AccountName
forall a b. (a, b) -> a
fst [(AccountName, PeriodicReportRow AccountName b)]
anamesandrows
        sortedanames :: [AccountName]
sortedanames = Journal -> Bool -> [AccountName] -> [AccountName]
sortAccountNamesByDeclaration Journal
j (ReportOpts -> Bool
tree_ ReportOpts
ropts) [AccountName]
anames
        sortedrows :: [PeriodicReportRow AccountName b]
sortedrows = [PeriodicReportRow AccountName b]
unbudgetedrow [PeriodicReportRow AccountName b]
-> [PeriodicReportRow AccountName b]
-> [PeriodicReportRow AccountName b]
forall a. [a] -> [a] -> [a]
++ [AccountName]
-> [(AccountName, PeriodicReportRow AccountName b)]
-> [PeriodicReportRow AccountName b]
forall b. [AccountName] -> [(AccountName, b)] -> [b]
sortAccountItemsLike [AccountName]
sortedanames [(AccountName, PeriodicReportRow AccountName b)]
anamesandrows

-- | 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 }
  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 :: MultiBalanceReport -> MultiBalanceReport -> BudgetReport
combineBudgetAndActual :: PeriodicReport AccountName MixedAmount
-> PeriodicReport AccountName MixedAmount -> BudgetReport
combineBudgetAndActual
      (PeriodicReport budgetperiods :: [DateSpan]
budgetperiods budgetrows :: [PeriodicReportRow AccountName MixedAmount]
budgetrows (PeriodicReportRow _ _ budgettots :: [MixedAmount]
budgettots budgetgrandtot :: MixedAmount
budgetgrandtot budgetgrandavg :: MixedAmount
budgetgrandavg))
      (PeriodicReport actualperiods :: [DateSpan]
actualperiods actualrows :: [PeriodicReportRow AccountName MixedAmount]
actualrows (PeriodicReportRow _ _ actualtots :: [MixedAmount]
actualtots actualgrandtot :: MixedAmount
actualgrandtot actualgrandavg :: MixedAmount
actualgrandavg)) =
    [DateSpan]
-> [PeriodicReportRow AccountName BudgetCell]
-> PeriodicReportRow () BudgetCell
-> BudgetReport
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport [DateSpan]
periods [PeriodicReportRow AccountName BudgetCell]
rows 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 AccountName BudgetCell]
rows1 =
      [ AccountName
-> Int
-> [BudgetCell]
-> BudgetCell
-> BudgetCell
-> PeriodicReportRow AccountName BudgetCell
forall a b. a -> Int -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow AccountName
acct Int
treeindent [BudgetCell]
amtandgoals BudgetCell
totamtandgoal BudgetCell
avgamtandgoal
      | PeriodicReportRow acct :: AccountName
acct treeindent :: Int
treeindent actualamts :: [MixedAmount]
actualamts actualtot :: MixedAmount
actualtot actualavg :: MixedAmount
actualavg <- [PeriodicReportRow AccountName MixedAmount]
actualrows
      , let mbudgetgoals :: Maybe ([MixedAmount], MixedAmount, MixedAmount)
mbudgetgoals       = AccountName
-> Map AccountName ([MixedAmount], MixedAmount, MixedAmount)
-> Maybe ([MixedAmount], MixedAmount, MixedAmount)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AccountName
acct Map 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 (Int -> Maybe MixedAmount -> [Maybe MixedAmount]
forall a. Int -> a -> [a]
replicate ([DateSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DateSpan]
periods) Maybe MixedAmount
forall a. Maybe a
Nothing) ((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
        Map AccountName ([MixedAmount], MixedAmount, MixedAmount)
budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) =
          [(AccountName, ([MixedAmount], MixedAmount, MixedAmount))]
-> Map AccountName ([MixedAmount], MixedAmount, MixedAmount)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (AccountName
acct, ([MixedAmount]
amts, MixedAmount
tot, MixedAmount
avg))
                         | PeriodicReportRow acct :: AccountName
acct _ amts :: [MixedAmount]
amts tot :: MixedAmount
tot avg :: MixedAmount
avg <- [PeriodicReportRow AccountName MixedAmount]
budgetrows ]

    -- next, make rows for budget goals with no actual changes
    rows2 :: [PeriodicReportRow AccountName BudgetCell]
rows2 =
      [ AccountName
-> Int
-> [BudgetCell]
-> BudgetCell
-> BudgetCell
-> PeriodicReportRow AccountName BudgetCell
forall a b. a -> Int -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow AccountName
acct Int
treeindent [BudgetCell]
amtandgoals BudgetCell
forall a. (Maybe a, Maybe MixedAmount)
totamtandgoal BudgetCell
forall a. (Maybe a, Maybe MixedAmount)
avgamtandgoal
      | PeriodicReportRow acct :: AccountName
acct treeindent :: Int
treeindent budgetgoals :: [MixedAmount]
budgetgoals budgettot :: MixedAmount
budgettot budgetavg :: MixedAmount
budgetavg <- [PeriodicReportRow AccountName MixedAmount]
budgetrows
      , AccountName
acct AccountName -> [AccountName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (PeriodicReportRow AccountName BudgetCell -> AccountName)
-> [PeriodicReportRow AccountName BudgetCell] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow AccountName BudgetCell -> AccountName
forall a b. PeriodicReportRow a b -> a
prrName [PeriodicReportRow AccountName 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: use MBR code
    -- TODO: respect --sort-amount
    -- TODO: add --sort-budget to sort by budget goal amount
    [PeriodicReportRow AccountName BudgetCell]
rows :: [BudgetReportRow] =
      (PeriodicReportRow AccountName BudgetCell -> AccountName)
-> [PeriodicReportRow AccountName BudgetCell]
-> [PeriodicReportRow AccountName BudgetCell]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn PeriodicReportRow AccountName BudgetCell -> AccountName
forall a b. PeriodicReportRow a b -> a
prrName ([PeriodicReportRow AccountName BudgetCell]
 -> [PeriodicReportRow AccountName BudgetCell])
-> [PeriodicReportRow AccountName BudgetCell]
-> [PeriodicReportRow AccountName BudgetCell]
forall a b. (a -> b) -> a -> b
$ [PeriodicReportRow AccountName BudgetCell]
rows1 [PeriodicReportRow AccountName BudgetCell]
-> [PeriodicReportRow AccountName BudgetCell]
-> [PeriodicReportRow AccountName BudgetCell]
forall a. [a] -> [a] -> [a]
++ [PeriodicReportRow AccountName BudgetCell]
rows2

    -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells
    totalrow :: PeriodicReportRow () BudgetCell
totalrow = ()
-> Int
-> [BudgetCell]
-> BudgetCell
-> BudgetCell
-> PeriodicReportRow () BudgetCell
forall a b. a -> Int -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow () 0
        [ (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  -- TODO
        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
amountLength Maybe MixedAmount
a, Maybe MixedAmount -> Int
amountLength Maybe MixedAmount
g))
                    ([BudgetCell] -> [(Int, Int)])
-> ([PeriodicReportRow AccountName BudgetCell] -> [BudgetCell])
-> [PeriodicReportRow AccountName BudgetCell]
-> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeriodicReportRow AccountName BudgetCell -> [BudgetCell])
-> [PeriodicReportRow AccountName BudgetCell] -> [BudgetCell]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PeriodicReportRow AccountName BudgetCell -> [BudgetCell]
forall a b. PeriodicReportRow a b -> [b]
prrAmounts ([PeriodicReportRow AccountName BudgetCell] -> [(Int, Int)])
-> [PeriodicReportRow AccountName BudgetCell] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ BudgetReport -> [PeriodicReportRow AccountName BudgetCell]
forall a b. PeriodicReport a b -> [PeriodicReportRow a b]
prRows BudgetReport
budgetr
      where amountLength :: Maybe MixedAmount -> Int
amountLength = 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
. MixedAmount -> String
showMixedAmountOneLineWithoutPrice)
    -- 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
showbudgetamt 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
showbudgetamt MixedAmount
budget)

    -- | 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
    showamt :: MixedAmount -> String
    showamt :: MixedAmount -> String
showamt | Bool
color_    = MixedAmount -> String
cshowMixedAmountOneLineWithoutPrice
            | Bool
otherwise = MixedAmount -> String
showMixedAmountOneLineWithoutPrice

    -- don't show the budget amount in color, it messes up alignment
    showbudgetamt :: MixedAmount -> String
showbudgetamt = MixedAmount -> String
showMixedAmountOneLineWithoutPrice

    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
  (PeriodicReport periods :: [DateSpan]
periods rows :: [PeriodicReportRow AccountName 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 AccountName BudgetCell -> [BudgetCell])
-> [PeriodicReportRow AccountName BudgetCell] -> [[BudgetCell]]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow AccountName BudgetCell -> [BudgetCell]
forall a b. PeriodicReportRow a b -> [b]
rowvals [PeriodicReportRow AccountName BudgetCell]
rows)
  where
    colheadings :: [String]
colheadings = (DateSpan -> String) -> [DateSpan] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map DateSpan -> String
showDateSpanMonthAbbrev [DateSpan]
periods
                  [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 AccountName BudgetCell -> String)
-> [PeriodicReportRow AccountName BudgetCell] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow AccountName BudgetCell -> String
forall b. PeriodicReportRow AccountName b -> String
renderacct [PeriodicReportRow AccountName BudgetCell]
rows
    renderacct :: PeriodicReportRow AccountName b -> String
renderacct (PeriodicReportRow a :: AccountName
a i :: Int
i _ _ _)
      | ReportOpts -> Bool
tree_ ReportOpts
ropts = Int -> Char -> String
forall a. Int -> a -> [a]
replicate ((Int
iInt -> 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 (AccountName -> AccountName
accountLeafName AccountName
a)
      | Bool
otherwise   = AccountName -> String
T.unpack (AccountName -> String) -> AccountName -> String
forall a b. (a -> b) -> a -> b
$ ReportOpts -> AccountName -> AccountName
maybeAccountNameDrop ReportOpts
ropts AccountName
a
    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)]
                    ))

-- XXX here for now
-- TODO: does not work for flat-by-default reports with --flat not specified explicitly
-- | Drop leading components of accounts names as specified by --drop, but only in --flat mode.
maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName
maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName
maybeAccountNameDrop opts :: ReportOpts
opts a :: AccountName
a | ReportOpts -> Bool
flat_ ReportOpts
opts = Int -> AccountName -> AccountName
accountNameDrop (ReportOpts -> Int
drop_ ReportOpts
opts) AccountName
a
                            | Bool
otherwise  = AccountName
a

-- tests

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