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

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

import Control.Applicative ((<|>))
import Control.Monad ((>=>))
import Data.Bifunctor (bimap)
import Data.Foldable (toList)
import Data.List (find, maximumBy, intercalate)
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.Ord (comparing)
import qualified Data.Set as S
import qualified Data.Text as T
import Data.These (These(..), these)
import Data.Time (Day)
import Safe (minimumDef)

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

-- 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 [BudgetCell]
budgetpairs BudgetCell
_tot BudgetCell
_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) <- [BudgetCell]
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 }
    -- ropts = _rsReportOpts rspec
    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

    (DateSpan
_, Maybe (PeriodData Day)
actualspans) = String
-> (DateSpan, Maybe (PeriodData Day))
-> (DateSpan, Maybe (PeriodData Day))
forall a. Show a => String -> a -> a
dbg5 String
"actualspans" ((DateSpan, Maybe (PeriodData Day))
 -> (DateSpan, Maybe (PeriodData Day)))
-> (DateSpan, Maybe (PeriodData Day))
-> (DateSpan, Maybe (PeriodData Day))
forall a b. (a -> b) -> a -> b
$ Journal -> ReportSpec -> (DateSpan, Maybe (PeriodData Day))
reportSpan Journal
actualj ReportSpec
rspec
    (DateSpan
_, Maybe (PeriodData Day)
budgetspans) = String
-> (DateSpan, Maybe (PeriodData Day))
-> (DateSpan, Maybe (PeriodData Day))
forall a. Show a => String -> a -> a
dbg5 String
"budgetspans" ((DateSpan, Maybe (PeriodData Day))
 -> (DateSpan, Maybe (PeriodData Day)))
-> (DateSpan, Maybe (PeriodData Day))
-> (DateSpan, Maybe (PeriodData Day))
forall a b. (a -> b) -> a -> b
$ Journal -> ReportSpec -> (DateSpan, Maybe (PeriodData Day))
reportSpan Journal
budgetj ReportSpec
rspec
    allspans :: Maybe (PeriodData Day)
allspans = case ReportOpts -> Interval
interval_ ReportOpts
ropts of
        -- 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.
        Interval
NoInterval -> Maybe (PeriodData Day)
actualspans
        Interval
_          -> (PeriodData Day -> PeriodData Day)
-> (PeriodData Day -> PeriodData Day -> PeriodData Day)
-> Maybe (PeriodData Day)
-> PeriodData Day
-> PeriodData Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PeriodData Day -> PeriodData Day
forall a. a -> a
id (Day -> PeriodData Day -> PeriodData Day -> PeriodData Day
forall a b. a -> PeriodData b -> PeriodData a -> PeriodData a
padPeriodData Day
nulldate) Maybe (PeriodData Day)
budgetspans (PeriodData Day -> PeriodData Day)
-> Maybe (PeriodData Day) -> Maybe (PeriodData Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PeriodData Day)
actualspans

    actualps :: [Posting]
actualps = String -> [Posting] -> [Posting]
forall a. Show a => String -> a -> a
dbg5 String
"actualps" ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PriceOracle -> DateSpan -> [Posting]
getPostings ReportSpec
rspec Journal
actualj PriceOracle
priceoracle DateSpan
reportspan
    budgetps :: [Posting]
budgetps = String -> [Posting] -> [Posting]
forall a. Show a => String -> a -> a
dbg5 String
"budgetps" ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PriceOracle -> DateSpan -> [Posting]
getPostings ReportSpec
rspec Journal
budgetj PriceOracle
priceoracle DateSpan
reportspan

    actualAcct :: Account BalanceData
actualAcct = String -> Account BalanceData -> Account BalanceData
forall a. Show a => String -> a -> a
dbg5 String
"actualAcct" (Account BalanceData -> Account BalanceData)
-> Account BalanceData -> Account BalanceData
forall a b. (a -> b) -> a -> b
$ ReportSpec
-> Journal
-> PriceOracle
-> Maybe (PeriodData Day)
-> [Posting]
-> Account BalanceData
generateMultiBalanceAccount ReportSpec
rspec Journal
actualj PriceOracle
priceoracle Maybe (PeriodData Day)
actualspans [Posting]
actualps
    budgetAcct :: Account BalanceData
budgetAcct = String -> Account BalanceData -> Account BalanceData
forall a. Show a => String -> a -> a
dbg5 String
"budgetAcct" (Account BalanceData -> Account BalanceData)
-> Account BalanceData -> Account BalanceData
forall a b. (a -> b) -> a -> b
$ ReportSpec
-> Journal
-> PriceOracle
-> Maybe (PeriodData Day)
-> [Posting]
-> Account BalanceData
generateMultiBalanceAccount ReportSpec
rspec Journal
budgetj PriceOracle
priceoracle Maybe (PeriodData Day)
budgetspans [Posting]
budgetps

    combinedAcct :: Account (These BalanceData BalanceData)
combinedAcct = String
-> Account (These BalanceData BalanceData)
-> Account (These BalanceData BalanceData)
forall a. Show a => String -> a -> a
dbg5 String
"combinedAcct" (Account (These BalanceData BalanceData)
 -> Account (These BalanceData BalanceData))
-> Account (These BalanceData BalanceData)
-> Account (These BalanceData BalanceData)
forall a b. (a -> b) -> a -> b
$ if [Posting] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Posting]
budgetps
        -- If no budget postings, just use actual account, to avoid unnecssary budget zeros
        then BalanceData -> These BalanceData BalanceData
forall a b. a -> These a b
This (BalanceData -> These BalanceData BalanceData)
-> Account BalanceData -> Account (These BalanceData BalanceData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Account BalanceData
actualAcct
        else Account BalanceData
-> Account BalanceData -> Account (These BalanceData BalanceData)
forall a b. Account a -> Account b -> Account (These a b)
mergeAccounts Account BalanceData
actualAcct Account BalanceData
budgetAcct

    budgetreport :: BudgetReport
budgetreport = ReportOpts
-> Maybe (PeriodData Day)
-> Account (These BalanceData BalanceData)
-> BudgetReport
generateBudgetReport ReportOpts
ropts Maybe (PeriodData Day)
allspans Account (These BalanceData BalanceData)
combinedAcct

-- | Lay out a set of postings grouped by date span into a regular matrix with rows
-- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport
-- from the columns.
generateBudgetReport :: ReportOpts -> Maybe (PeriodData Day) -> Account (These BalanceData BalanceData) -> BudgetReport
generateBudgetReport :: ReportOpts
-> Maybe (PeriodData Day)
-> Account (These BalanceData BalanceData)
-> BudgetReport
generateBudgetReport = (forall a.
 ReportOpts
 -> (BalanceData -> Change)
 -> a
 -> Account (These BalanceData BalanceData)
 -> PeriodicReportRow a BudgetCell)
-> (These BalanceData BalanceData -> Change)
-> (BudgetCell -> Change)
-> ReportOpts
-> Maybe (PeriodData Day)
-> Account (These BalanceData BalanceData)
-> BudgetReport
forall c b.
Show c =>
(forall a.
 ReportOpts
 -> (BalanceData -> Change)
 -> a
 -> Account b
 -> PeriodicReportRow a c)
-> (b -> Change)
-> (c -> Change)
-> ReportOpts
-> Maybe (PeriodData Day)
-> Account b
-> PeriodicReport DisplayName c
generatePeriodicReport ReportOpts
-> (BalanceData -> Change)
-> a
-> Account (These BalanceData BalanceData)
-> PeriodicReportRow a BudgetCell
forall a.
ReportOpts
-> (BalanceData -> Change)
-> a
-> Account (These BalanceData BalanceData)
-> PeriodicReportRow a BudgetCell
makeBudgetReportRow These BalanceData BalanceData -> Change
forall {b}. These BalanceData b -> Change
treeActualBalance BudgetCell -> Change
forall {b}. (Maybe Change, b) -> Change
flatActualBalance
  where
    treeActualBalance :: These BalanceData b -> Change
treeActualBalance = (BalanceData -> Change)
-> (b -> Change)
-> (BalanceData -> b -> Change)
-> These BalanceData b
-> Change
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these BalanceData -> Change
bdincludingsubs (Change -> b -> Change
forall a b. a -> b -> a
const Change
nullmixedamt) (Change -> b -> Change
forall a b. a -> b -> a
const (Change -> b -> Change)
-> (BalanceData -> Change) -> BalanceData -> b -> Change
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalanceData -> Change
bdincludingsubs)
    flatActualBalance :: (Maybe Change, b) -> Change
flatActualBalance = 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

-- | Build a report row.
--
-- Calculate the column totals. These are always the sum of column amounts.
makeBudgetReportRow :: ReportOpts -> (BalanceData -> MixedAmount)
                    -> a -> Account (These BalanceData BalanceData) -> PeriodicReportRow a BudgetCell
makeBudgetReportRow :: forall a.
ReportOpts
-> (BalanceData -> Change)
-> a
-> Account (These BalanceData BalanceData)
-> PeriodicReportRow a BudgetCell
makeBudgetReportRow ReportOpts
ropts BalanceData -> Change
balance =
    BudgetCell
-> (IntMap BudgetCell -> (BudgetCell, BudgetCell))
-> ReportOpts
-> (These BalanceData BalanceData -> BudgetCell)
-> a
-> Account (These BalanceData BalanceData)
-> PeriodicReportRow a BudgetCell
forall c b a.
c
-> (IntMap c -> (c, c))
-> ReportOpts
-> (b -> c)
-> a
-> Account b
-> PeriodicReportRow a c
makePeriodicReportRow (Change -> Maybe Change
forall a. a -> Maybe a
Just Change
nullmixedamt, Maybe Change
forall a. Maybe a
Nothing) IntMap BudgetCell -> (BudgetCell, BudgetCell)
forall {t :: * -> *}.
Foldable t =>
t BudgetCell -> (BudgetCell, BudgetCell)
avg ReportOpts
ropts (These Change Change -> BudgetCell
forall {a}. These Change a -> (Maybe Change, Maybe a)
theseToMaybe (These Change Change -> BudgetCell)
-> (These BalanceData BalanceData -> These Change Change)
-> These BalanceData BalanceData
-> BudgetCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BalanceData -> Change)
-> (BalanceData -> Change)
-> These BalanceData BalanceData
-> These Change Change
forall a b c d. (a -> b) -> (c -> d) -> These a c -> These b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap BalanceData -> Change
balance BalanceData -> Change
balance)
  where
    avg :: t BudgetCell -> (BudgetCell, BudgetCell)
avg t BudgetCell
xs = ((Maybe Change
actualtotal, Maybe Change
budgettotal), (Maybe Change
actualavg, Maybe Change
budgetavg))
      where
        ([Maybe Change]
actuals, [Maybe Change]
budgets) = [BudgetCell] -> ([Maybe Change], [Maybe Change])
forall a b. [(a, b)] -> ([a], [b])
unzip ([BudgetCell] -> ([Maybe Change], [Maybe Change]))
-> [BudgetCell] -> ([Maybe Change], [Maybe Change])
forall a b. (a -> b) -> a -> b
$ t BudgetCell -> [BudgetCell]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t BudgetCell
xs
        (Maybe Change
actualtotal, Maybe Change
actualavg) = (Change -> Maybe Change)
-> (Change -> Maybe Change) -> (Change, Change) -> BudgetCell
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Change -> Maybe Change
forall a. a -> Maybe a
Just Change -> Maybe Change
forall a. a -> Maybe a
Just ((Change, Change) -> BudgetCell)
-> ([Change] -> (Change, Change)) -> [Change] -> BudgetCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Change] -> (Change, Change)
forall (f :: * -> *). Foldable f => f Change -> (Change, Change)
sumAndAverageMixedAmounts ([Change] -> BudgetCell) -> [Change] -> BudgetCell
forall a b. (a -> b) -> a -> b
$ [Maybe Change] -> [Change]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Change]
actuals
        (Maybe Change
budgettotal, Maybe Change
budgetavg) = (Change -> Maybe Change)
-> (Change -> Maybe Change) -> (Change, Change) -> BudgetCell
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Change -> Maybe Change
forall a. a -> Maybe a
Just Change -> Maybe Change
forall a. a -> Maybe a
Just ((Change, Change) -> BudgetCell)
-> ([Change] -> (Change, Change)) -> [Change] -> BudgetCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Change] -> (Change, Change)
forall (f :: * -> *). Foldable f => f Change -> (Change, Change)
sumAndAverageMixedAmounts ([Change] -> BudgetCell) -> [Change] -> BudgetCell
forall a b. (a -> b) -> a -> b
$ [Maybe Change] -> [Change]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Change]
budgets

    theseToMaybe :: These Change a -> (Maybe Change, Maybe a)
theseToMaybe (This Change
a) = (Change -> Maybe Change
forall a. a -> Maybe a
Just Change
a, Maybe a
forall a. Maybe a
Nothing)
    theseToMaybe (That a
b) = (Change -> Maybe Change
forall a. a -> Maybe a
Just Change
nullmixedamt, a -> Maybe a
forall a. a -> Maybe a
Just a
b)
    theseToMaybe (These Change
a a
b) = (Change -> Maybe Change
forall a. a -> Maybe a
Just Change
a, a -> Maybe a
forall a. a -> Maybe a
Just a
b)

-- | 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. (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


-- tests

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