{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

import Control.Applicative ((<|>))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.List (find, partition, maximumBy, intercalate)
import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe, isJust)
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as S
import qualified Data.Text as T
import Safe (minimumDef)

import Hledger.Data
import Hledger.Utils
import Hledger.Reports.ReportOptions
import Hledger.Reports.ReportTypes
import Hledger.Reports.MultiBalanceReport
import Data.Ord (comparing)
import Control.Monad ((>=>))

-- All MixedAmounts:
type BudgetGoal    = Change
type BudgetTotal   = Total
type BudgetAverage = Average

-- | A budget report tracks expected and actual changes per account and subperiod.
-- Each table cell has an actual change amount and/or a budget goal amount.
type BudgetCell = (Maybe Change, Maybe BudgetGoal)
-- | A row in a budget report table - account name and data cells.
type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell
-- | A full budget report table.
type BudgetReport    = PeriodicReport    DisplayName BudgetCell

_brrShowDebug :: BudgetReportRow -> String
_brrShowDebug :: BudgetReportRow -> String
_brrShowDebug (PeriodicReportRow DisplayName
dname [(Maybe Change, Maybe Change)]
budgetpairs (Maybe Change, Maybe Change)
_tot (Maybe Change, Maybe Change)
_avg) =
  [String] -> String
unwords [
    AccountName -> String
T.unpack (AccountName -> String) -> AccountName -> String
forall a b. (a -> b) -> a -> b
$ DisplayName -> AccountName
displayFull DisplayName
dname,
    String
"",
    String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" | "
      [ String -> (Change -> String) -> Maybe Change -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"-" Change -> String
showMixedAmount Maybe Change
mactual String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" [" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> (Change -> String) -> Maybe Change -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"-" Change -> String
showMixedAmount Maybe Change
mgoal String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]"
      | (Maybe Change
mactual,Maybe Change
mgoal) <- [(Maybe Change, Maybe Change)]
budgetpairs ]
    ]

-- | Calculate per-account, per-period budget (balance change) goals
-- from all periodic transactions, calculate actual balance changes
-- from the regular transactions, and compare these to get a 'BudgetReport'.
-- Unbudgeted accounts may be hidden or renamed (see journalWithBudgetAccountNames).
budgetReport :: ReportSpec -> BalancingOpts -> DateSpan -> Journal -> BudgetReport
budgetReport :: ReportSpec -> BalancingOpts -> DateSpan -> Journal -> BudgetReport
budgetReport ReportSpec
rspec BalancingOpts
bopts DateSpan
reportspan Journal
j = String -> BudgetReport -> BudgetReport
forall a. Show a => String -> a -> a
dbg4 String
"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 = (ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec){ accountlistmode_ = ALTree }
    showunbudgeted :: Bool
showunbudgeted = ReportOpts -> Bool
empty_ ReportOpts
ropts
    budgetedaccts :: Set AccountName
budgetedaccts =
      String -> Set AccountName -> Set AccountName
forall a. Show a => String -> a -> a
dbg3 String
"budgetedacctsinperiod" (Set AccountName -> Set AccountName)
-> Set AccountName -> Set AccountName
forall a b. (a -> b) -> a -> b
$
      [AccountName] -> Set AccountName
forall a. Ord a => [a] -> Set a
S.fromList ([AccountName] -> Set AccountName)
-> [AccountName] -> Set AccountName
forall a b. (a -> b) -> a -> b
$
      [AccountName] -> [AccountName]
expandAccountNames ([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
pt -> Bool -> PeriodicTransaction -> DateSpan -> [Transaction]
runPeriodicTransaction Bool
False PeriodicTransaction
pt DateSpan
reportspan) ([PeriodicTransaction] -> [Transaction])
-> [PeriodicTransaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$
      Journal -> [PeriodicTransaction]
jperiodictxns Journal
j
    actualj :: Journal
actualj = Set AccountName -> Bool -> Journal -> Journal
journalWithBudgetAccountNames Set AccountName
budgetedaccts Bool
showunbudgeted Journal
j
    budgetj :: Journal
budgetj = BalancingOpts -> ReportOpts -> DateSpan -> Journal -> Journal
journalAddBudgetGoalTransactions BalancingOpts
bopts ReportOpts
ropts DateSpan
reportspan Journal
j
    priceoracle :: PriceOracle
priceoracle = Bool -> Journal -> PriceOracle
journalPriceOracle (ReportOpts -> Bool
infer_prices_ ReportOpts
ropts) Journal
j
    budgetgoalreport :: MultiBalanceReport
budgetgoalreport@(PeriodicReport [DateSpan]
_ [PeriodicReportRow DisplayName Change]
budgetgoalitems PeriodicReportRow () Change
budgetgoaltotals) =
        String -> MultiBalanceReport -> MultiBalanceReport
forall a. Show a => String -> a -> a
dbg5 String
"budgetgoalreport" (MultiBalanceReport -> MultiBalanceReport)
-> MultiBalanceReport -> MultiBalanceReport
forall a b. (a -> b) -> a -> b
$ ReportSpec
-> Journal -> PriceOracle -> Set AccountName -> MultiBalanceReport
multiBalanceReportWith ReportSpec
rspec{_rsReportOpts=ropts{empty_=True}} Journal
budgetj PriceOracle
priceoracle Set AccountName
forall a. Monoid a => a
mempty
    budgetedacctsseen :: Set AccountName
budgetedacctsseen = [AccountName] -> Set AccountName
forall a. Ord a => [a] -> Set a
S.fromList ([AccountName] -> Set AccountName)
-> [AccountName] -> Set AccountName
forall a b. (a -> b) -> a -> b
$ (PeriodicReportRow DisplayName Change -> AccountName)
-> [PeriodicReportRow DisplayName Change] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow DisplayName Change -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName [PeriodicReportRow DisplayName Change]
budgetgoalitems
    actualreport :: MultiBalanceReport
actualreport@(PeriodicReport [DateSpan]
actualspans [PeriodicReportRow DisplayName Change]
_ PeriodicReportRow () Change
_) =
        String -> MultiBalanceReport -> MultiBalanceReport
forall a. Show a => String -> a -> a
dbg5 String
"actualreport"     (MultiBalanceReport -> MultiBalanceReport)
-> MultiBalanceReport -> MultiBalanceReport
forall a b. (a -> b) -> a -> b
$ ReportSpec
-> Journal -> PriceOracle -> Set AccountName -> MultiBalanceReport
multiBalanceReportWith ReportSpec
rspec{_rsReportOpts=ropts{empty_=True}} Journal
actualj PriceOracle
priceoracle Set AccountName
budgetedacctsseen
    budgetgoalreport' :: MultiBalanceReport
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 Change]
-> PeriodicReportRow () Change
-> MultiBalanceReport
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport [DateSpan]
actualspans [PeriodicReportRow DisplayName Change]
budgetgoalitems PeriodicReportRow () Change
budgetgoaltotals
      | Bool
otherwise = MultiBalanceReport
budgetgoalreport
    budgetreport :: BudgetReport
budgetreport = ReportOpts
-> Journal
-> MultiBalanceReport
-> MultiBalanceReport
-> BudgetReport
combineBudgetAndActual ReportOpts
ropts Journal
j MultiBalanceReport
budgetgoalreport' MultiBalanceReport
actualreport

-- | Use all (or all matched by --budget's argument) periodic transactions in the journal 
-- to generate budget goal transactions in the specified date span (and before, to support
-- --historical. The precise start date is the natural start date of the largest interval
-- of the active periodic transaction rules that is on or before the earlier of journal start date,
-- report start date.)
-- Budget goal transactions are similar to forecast transactions except their purpose 
-- and effect is to define balance change goals, per account and period, for BudgetReport.
--
journalAddBudgetGoalTransactions :: BalancingOpts -> ReportOpts -> DateSpan -> Journal -> Journal
journalAddBudgetGoalTransactions :: BalancingOpts -> ReportOpts -> DateSpan -> Journal -> Journal
journalAddBudgetGoalTransactions BalancingOpts
bopts ReportOpts
ropts DateSpan
reportspan 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
$  -- PARTIAL:
    (Journal -> Either String Journal
journalStyleAmounts (Journal -> Either String Journal)
-> (Journal -> Either String Journal)
-> Journal
-> Either String Journal
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions BalancingOpts
bopts) Journal
j{ jtxns = budgetts }
  where
    budgetspan :: DateSpan
budgetspan = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg3 String
"budget span" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (Day -> EFDay
Exact (Day -> EFDay) -> Maybe Day -> Maybe EFDay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
mbudgetgoalsstartdate) (Day -> EFDay
Exact (Day -> EFDay) -> Maybe Day -> Maybe EFDay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DateSpan -> Maybe Day
spanEnd DateSpan
reportspan)
      where
        mbudgetgoalsstartdate :: Maybe Day
mbudgetgoalsstartdate =
          -- We want to also generate budget goal txns before the report start date, in case -H is used.
          -- What should the actual starting date for goal txns be ? This gets tricky. 
          -- Consider a journal with a "~ monthly" periodic transaction rule, where the first transaction is on 1/5.
          -- Users will certainly expect a budget goal for january, but "~ monthly" generates transactions
          -- on the first of month, and starting from 1/5 would exclude 1/1.
          -- Secondly, consider a rule like "~ every february 2nd from 2020/01"; we should not start that
          -- before 2020-02-02.
          -- Hopefully the following algorithm produces intuitive behaviour in general:
          -- from the earlier of the journal start date and the report start date,
          -- move backward to the nearest natural start date of the largest period seen among the
          -- active periodic transactions, unless that is disallowed by a start date in the periodic rule.
          -- (Do we need to pay attention to an end date in the rule ? Don't think so.)
          -- (So with "~ monthly", the journal start date 1/5 is adjusted to 1/1.)
          case Maybe Day -> [Maybe Day] -> Maybe Day
forall a. Ord a => a -> [a] -> a
minimumDef Maybe Day
forall a. Maybe a
Nothing ([Maybe Day] -> Maybe Day) -> [Maybe Day] -> Maybe Day
forall a b. (a -> b) -> a -> b
$ (Maybe Day -> Bool) -> [Maybe Day] -> [Maybe Day]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe Day -> Bool
forall a. Maybe a -> Bool
isJust [Bool -> Journal -> Maybe Day
journalStartDate Bool
False Journal
j, DateSpan -> Maybe Day
spanStart DateSpan
reportspan] of
            Maybe Day
Nothing -> Maybe Day
forall a. Maybe a
Nothing
            Just Day
d  -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d'
              where
                -- the interval and any date span of the periodic transaction with longest period
                (Interval
intervl, DateSpan
spn) =
                  case [PeriodicTransaction]
budgetpts of
                    []  -> (Int -> Interval
Days Int
1, DateSpan
nulldatespan)
                    [PeriodicTransaction]
pts -> (PeriodicTransaction -> Interval
ptinterval PeriodicTransaction
pt, PeriodicTransaction -> DateSpan
ptspan PeriodicTransaction
pt)
                      where pt :: PeriodicTransaction
pt = (PeriodicTransaction -> PeriodicTransaction -> Ordering)
-> [PeriodicTransaction] -> PeriodicTransaction
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((PeriodicTransaction -> Interval)
-> PeriodicTransaction -> PeriodicTransaction -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing PeriodicTransaction -> Interval
ptinterval) [PeriodicTransaction]
pts  -- PARTIAL: maximumBy won't fail
                -- the natural start of this interval on or before the journal/report start
                intervalstart :: Day
intervalstart = Interval -> Day -> Day
intervalBoundaryBefore Interval
intervl Day
d
                -- the natural interval start before the journal/report start,
                -- or the rule-specified start if later,
                -- but no later than the journal/report start.
                d' :: Day
d' = Day -> Day -> Day
forall a. Ord a => a -> a -> a
min Day
d (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ Day -> (Day -> Day) -> Maybe Day -> Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Day
intervalstart (Day -> Day -> Day
forall a. Ord a => a -> a -> a
max Day
intervalstart) (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ DateSpan -> Maybe Day
spanStart DateSpan
spn

    -- select periodic transactions matching a pattern
    -- (the argument of the (final) --budget option).
    -- XXX two limitations/wishes, requiring more extensive type changes:
    -- - give an error if pat is non-null and matches no periodic txns
    -- - allow a regexp or a full hledger query, not just a substring
    pat :: AccountName
pat = AccountName -> Maybe AccountName -> AccountName
forall a. a -> Maybe a -> a
fromMaybe AccountName
"" (Maybe AccountName -> AccountName)
-> Maybe AccountName -> AccountName
forall a b. (a -> b) -> a -> b
$ String -> Maybe AccountName -> Maybe AccountName
forall a. Show a => String -> a -> a
dbg3 String
"budget pattern" (Maybe AccountName -> Maybe AccountName)
-> Maybe AccountName -> Maybe AccountName
forall a b. (a -> b) -> a -> b
$ AccountName -> AccountName
T.toLower (AccountName -> AccountName)
-> Maybe AccountName -> Maybe AccountName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportOpts -> Maybe AccountName
budgetpat_ ReportOpts
ropts
    budgetpts :: [PeriodicTransaction]
budgetpts = [PeriodicTransaction
pt | PeriodicTransaction
pt <- Journal -> [PeriodicTransaction]
jperiodictxns Journal
j, AccountName
pat AccountName -> AccountName -> Bool
`T.isInfixOf` AccountName -> AccountName
T.toLower (PeriodicTransaction -> AccountName
ptdescription PeriodicTransaction
pt)]
    budgetts :: [Transaction]
budgetts =
      String -> [Transaction] -> [Transaction]
forall a. Show a => String -> a -> a
dbg5 String
"budget goal txns" ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$
      [Transaction -> Transaction
makeBudgetTxn Transaction
t
      | PeriodicTransaction
pt <- [PeriodicTransaction]
budgetpts
      , Transaction
t <- Bool -> PeriodicTransaction -> DateSpan -> [Transaction]
runPeriodicTransaction Bool
False PeriodicTransaction
pt DateSpan
budgetspan
      ]
    makeBudgetTxn :: Transaction -> Transaction
makeBudgetTxn Transaction
t = Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction
t { tdescription = 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 -E/--empty.
--
journalWithBudgetAccountNames :: S.Set AccountName -> Bool -> Journal -> Journal
journalWithBudgetAccountNames :: Set AccountName -> Bool -> Journal -> Journal
journalWithBudgetAccountNames Set AccountName
budgetedaccts Bool
showunbudgeted Journal
j =
  (Journal -> String) -> Journal -> Journal
forall a. Show a => (a -> String) -> a -> a
dbg5With ((String
"budget account names: "String -> String -> String
forall a. [a] -> [a] -> [a]
++)(String -> String) -> (Journal -> String) -> Journal -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[AccountName] -> String
forall a. Show a => a -> String
pshow([AccountName] -> String)
-> (Journal -> [AccountName]) -> Journal -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Journal -> [AccountName]
journalAccountNamesUsed) (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$
  Journal
j { jtxns = remapTxn <$> jtxns j }
  where
    remapTxn :: Transaction -> Transaction
remapTxn = Transaction -> Transaction
txnTieKnot (Transaction -> Transaction)
-> (Transaction -> Transaction) -> Transaction -> Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings Posting -> Posting
remapPosting
    remapPosting :: Posting -> Posting
remapPosting Posting
p = Posting
p { paccount = remapAccount $ paccount p, poriginal = poriginal p <|> Just p }
    remapAccount :: AccountName -> AccountName
remapAccount AccountName
a
      | AccountName
a AccountName -> Set AccountName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set AccountName
budgetedaccts = AccountName
a
      | Just AccountName
p <- Maybe AccountName
budgetedparent   = if Bool
showunbudgeted then AccountName
a else AccountName
p
      | 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
        budgetedparent :: Maybe AccountName
budgetedparent = (AccountName -> Bool) -> [AccountName] -> Maybe AccountName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (AccountName -> Set AccountName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set AccountName
budgetedaccts) ([AccountName] -> Maybe AccountName)
-> [AccountName] -> Maybe 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
-> MultiBalanceReport
-> MultiBalanceReport
-> BudgetReport
combineBudgetAndActual ReportOpts
ropts Journal
j
      (PeriodicReport [DateSpan]
budgetperiods [PeriodicReportRow DisplayName Change]
budgetrows (PeriodicReportRow ()
_ [Change]
budgettots Change
budgetgrandtot Change
budgetgrandavg))
      (PeriodicReport [DateSpan]
actualperiods [PeriodicReportRow DisplayName Change]
actualrows (PeriodicReportRow ()
_ [Change]
actualtots Change
actualgrandtot Change
actualgrandavg)) =
    [DateSpan]
-> [BudgetReportRow]
-> PeriodicReportRow () (Maybe Change, Maybe Change)
-> BudgetReport
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport [DateSpan]
periods [BudgetReportRow]
combinedrows PeriodicReportRow () (Maybe Change, Maybe Change)
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
    actualsplusgoals :: [BudgetReportRow]
actualsplusgoals = [
        -- dbg0With (("actualsplusgoals: "<>)._brrShowDebug) $
        DisplayName
-> [(Maybe Change, Maybe Change)]
-> (Maybe Change, Maybe Change)
-> (Maybe Change, Maybe Change)
-> BudgetReportRow
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow DisplayName
acct [(Maybe Change, Maybe Change)]
amtandgoals (Maybe Change, Maybe Change)
totamtandgoal (Maybe Change, Maybe Change)
avgamtandgoal
      | PeriodicReportRow DisplayName
acct [Change]
actualamts Change
actualtot Change
actualavg <- [PeriodicReportRow DisplayName Change]
actualrows

      , let mbudgetgoals :: Maybe ([Change], Change, Change)
mbudgetgoals       = AccountName
-> HashMap AccountName ([Change], Change, Change)
-> Maybe ([Change], Change, Change)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (DisplayName -> AccountName
displayFull DisplayName
acct) HashMap AccountName ([Change], Change, Change)
budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage)
      , let budgetmamts :: [Maybe Change]
budgetmamts        = [Maybe Change]
-> (([Change], Change, Change) -> [Maybe Change])
-> Maybe ([Change], Change, Change)
-> [Maybe Change]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Change
forall a. Maybe a
Nothing Maybe Change -> [DateSpan] -> [Maybe Change]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [DateSpan]
periods) ((Change -> Maybe Change) -> [Change] -> [Maybe Change]
forall a b. (a -> b) -> [a] -> [b]
map Change -> Maybe Change
forall a. a -> Maybe a
Just ([Change] -> [Maybe Change])
-> (([Change], Change, Change) -> [Change])
-> ([Change], Change, Change)
-> [Maybe Change]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Change], Change, Change) -> [Change]
forall {a} {b} {c}. (a, b, c) -> a
first3) Maybe ([Change], Change, Change)
mbudgetgoals :: [Maybe BudgetGoal]
      , let mbudgettot :: Maybe Change
mbudgettot         = ([Change], Change, Change) -> Change
forall {a} {b} {c}. (a, b, c) -> b
second3 (([Change], Change, Change) -> Change)
-> Maybe ([Change], Change, Change) -> Maybe Change
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([Change], Change, Change)
mbudgetgoals :: Maybe BudgetTotal
      , let mbudgetavg :: Maybe Change
mbudgetavg         = ([Change], Change, Change) -> Change
forall {a} {b} {c}. (a, b, c) -> c
third3 (([Change], Change, Change) -> Change)
-> Maybe ([Change], Change, Change) -> Maybe Change
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([Change], Change, Change)
mbudgetgoals  :: Maybe BudgetAverage
      , let acctGoalByPeriod :: Map DateSpan Change
acctGoalByPeriod   = [(DateSpan, Change)] -> Map DateSpan Change
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (DateSpan
p,Change
budgetamt) | (DateSpan
p, Just Change
budgetamt) <- [DateSpan] -> [Maybe Change] -> [(DateSpan, Maybe Change)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DateSpan]
budgetperiods [Maybe Change]
budgetmamts ] :: Map DateSpan BudgetGoal
      , let acctActualByPeriod :: Map DateSpan Change
acctActualByPeriod = [(DateSpan, Change)] -> Map DateSpan Change
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (DateSpan
p,Change
actualamt) | (DateSpan
p, Just Change
actualamt) <- [DateSpan] -> [Maybe Change] -> [(DateSpan, Maybe Change)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DateSpan]
actualperiods ((Change -> Maybe Change) -> [Change] -> [Maybe Change]
forall a b. (a -> b) -> [a] -> [b]
map Change -> Maybe Change
forall a. a -> Maybe a
Just [Change]
actualamts) ] :: Map DateSpan Change
      , let amtandgoals :: [(Maybe Change, Maybe Change)]
amtandgoals        = [ (DateSpan -> Map DateSpan Change -> Maybe Change
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DateSpan
p Map DateSpan Change
acctActualByPeriod, DateSpan -> Map DateSpan Change -> Maybe Change
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DateSpan
p Map DateSpan Change
acctGoalByPeriod) | DateSpan
p <- [DateSpan]
periods ] :: [BudgetCell]
      , let totamtandgoal :: (Maybe Change, Maybe Change)
totamtandgoal      = (Change -> Maybe Change
forall a. a -> Maybe a
Just Change
actualtot, Maybe Change
mbudgettot)
      , let avgamtandgoal :: (Maybe Change, Maybe Change)
avgamtandgoal      = (Change -> Maybe Change
forall a. a -> Maybe a
Just Change
actualavg, Maybe Change
mbudgetavg)
      ]
      where
        HashMap AccountName ([Change], Change, Change)
budgetGoalsByAcct :: HashMap AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) =
          [(AccountName, ([Change], Change, Change))]
-> HashMap AccountName ([Change], Change, Change)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [ (DisplayName -> AccountName
displayFull DisplayName
acct, ([Change]
amts, Change
tot, Change
avg))
                      | PeriodicReportRow DisplayName
acct [Change]
amts Change
tot Change
avg <-
                          -- dbg0With (unlines.map (("budgetgoals: "<>).prrShowDebug)) $
                          [PeriodicReportRow DisplayName Change]
budgetrows
                      ]

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

    -- combine and re-sort rows
    -- TODO: add --sort-budget to sort by budget goal amount
    [BudgetReportRow]
combinedrows :: [BudgetReportRow] =
      -- map (dbg0With (("combinedrows: "<>)._brrShowDebug)) $
      [AccountName] -> [BudgetReportRow] -> [BudgetReportRow]
forall b.
[AccountName]
-> [PeriodicReportRow DisplayName b]
-> [PeriodicReportRow DisplayName b]
sortRowsLike ([BudgetReportRow] -> [AccountName]
forall {b}.
[PeriodicReportRow DisplayName (Maybe Change, b)] -> [AccountName]
mbrsorted [BudgetReportRow]
unbudgetedrows [AccountName] -> [AccountName] -> [AccountName]
forall a. [a] -> [a] -> [a]
++ [BudgetReportRow] -> [AccountName]
forall {b}.
[PeriodicReportRow DisplayName (Maybe Change, b)] -> [AccountName]
mbrsorted [BudgetReportRow]
rows') [BudgetReportRow]
rows
      where
        ([BudgetReportRow]
unbudgetedrows, [BudgetReportRow]
rows') = (BudgetReportRow -> Bool)
-> [BudgetReportRow] -> ([BudgetReportRow], [BudgetReportRow])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
==AccountName
unbudgetedAccountName) (AccountName -> Bool)
-> (BudgetReportRow -> AccountName) -> BudgetReportRow -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BudgetReportRow -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName) [BudgetReportRow]
rows
        mbrsorted :: [PeriodicReportRow DisplayName (Maybe Change, b)] -> [AccountName]
mbrsorted = (PeriodicReportRow DisplayName Change -> AccountName)
-> [PeriodicReportRow DisplayName Change] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow DisplayName Change -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName ([PeriodicReportRow DisplayName Change] -> [AccountName])
-> ([PeriodicReportRow DisplayName (Maybe Change, b)]
    -> [PeriodicReportRow DisplayName Change])
-> [PeriodicReportRow DisplayName (Maybe Change, b)]
-> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts
-> Journal
-> [PeriodicReportRow DisplayName Change]
-> [PeriodicReportRow DisplayName Change]
sortRows ReportOpts
ropts Journal
j ([PeriodicReportRow DisplayName Change]
 -> [PeriodicReportRow DisplayName Change])
-> ([PeriodicReportRow DisplayName (Maybe Change, b)]
    -> [PeriodicReportRow DisplayName Change])
-> [PeriodicReportRow DisplayName (Maybe Change, b)]
-> [PeriodicReportRow DisplayName Change]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeriodicReportRow DisplayName (Maybe Change, b)
 -> PeriodicReportRow DisplayName Change)
-> [PeriodicReportRow DisplayName (Maybe Change, b)]
-> [PeriodicReportRow DisplayName Change]
forall a b. (a -> b) -> [a] -> [b]
map (((Maybe Change, b) -> Change)
-> PeriodicReportRow DisplayName (Maybe Change, b)
-> PeriodicReportRow DisplayName Change
forall a b.
(a -> b)
-> PeriodicReportRow DisplayName a
-> PeriodicReportRow DisplayName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Maybe Change, b) -> Change)
 -> PeriodicReportRow DisplayName (Maybe Change, b)
 -> PeriodicReportRow DisplayName Change)
-> ((Maybe Change, b) -> Change)
-> PeriodicReportRow DisplayName (Maybe Change, b)
-> PeriodicReportRow DisplayName Change
forall a b. (a -> b) -> a -> b
$ Change -> Maybe Change -> Change
forall a. a -> Maybe a -> a
fromMaybe Change
nullmixedamt (Maybe Change -> Change)
-> ((Maybe Change, b) -> Maybe Change)
-> (Maybe Change, b)
-> Change
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Change, b) -> Maybe Change
forall a b. (a, b) -> a
fst)
        rows :: [BudgetReportRow]
rows = [BudgetReportRow]
actualsplusgoals [BudgetReportRow] -> [BudgetReportRow] -> [BudgetReportRow]
forall a. [a] -> [a] -> [a]
++ [BudgetReportRow]
othergoals

    totalrow :: PeriodicReportRow () (Maybe Change, Maybe Change)
totalrow = ()
-> [(Maybe Change, Maybe Change)]
-> (Maybe Change, Maybe Change)
-> (Maybe Change, Maybe Change)
-> PeriodicReportRow () (Maybe Change, Maybe Change)
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow ()
        [ (DateSpan -> Map DateSpan Change -> Maybe Change
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DateSpan
p Map DateSpan Change
totActualByPeriod, DateSpan -> Map DateSpan Change -> Maybe Change
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DateSpan
p Map DateSpan Change
totGoalByPeriod) | DateSpan
p <- [DateSpan]
periods ]
        ( Change -> Maybe Change
forall a. a -> Maybe a
Just Change
actualgrandtot, Change -> Maybe Change
budget Change
budgetgrandtot )
        ( Change -> Maybe Change
forall a. a -> Maybe a
Just Change
actualgrandavg, Change -> Maybe Change
budget Change
budgetgrandavg )
      where
        totGoalByPeriod :: Map DateSpan Change
totGoalByPeriod = [(DateSpan, Change)] -> Map DateSpan Change
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(DateSpan, Change)] -> Map DateSpan Change)
-> [(DateSpan, Change)] -> Map DateSpan Change
forall a b. (a -> b) -> a -> b
$ [DateSpan] -> [Change] -> [(DateSpan, Change)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DateSpan]
budgetperiods [Change]
budgettots :: Map DateSpan BudgetTotal
        totActualByPeriod :: Map DateSpan Change
totActualByPeriod = [(DateSpan, Change)] -> Map DateSpan Change
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(DateSpan, Change)] -> Map DateSpan Change)
-> [(DateSpan, Change)] -> Map DateSpan Change
forall a b. (a -> b) -> a -> b
$ [DateSpan] -> [Change] -> [(DateSpan, Change)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DateSpan]
actualperiods [Change]
actualtots :: Map DateSpan Change
        budget :: Change -> Maybe Change
budget Change
b = if Change -> Bool
mixedAmountLooksZero Change
b then Maybe Change
forall a. Maybe a
Nothing else Change -> Maybe Change
forall a. a -> Maybe a
Just Change
b

-- tests

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