budget: use a new first-class BudgetReport for --budget

hledger-lib/Hledger/Reports.hs

@@ -16,6 +16,7 @@ module Hledger.Reports (
   module Hledger.Reports.TransactionsReports,
   module Hledger.Reports.BalanceReport,
   module Hledger.Reports.MultiBalanceReports,
+  module Hledger.Reports.BudgetReport,
 --   module Hledger.Reports.BalanceHistoryReport,
 
   -- * Tests
@@ -32,6 +33,7 @@ import Hledger.Reports.PostingsReport
 import Hledger.Reports.TransactionsReports
 import Hledger.Reports.BalanceReport
 import Hledger.Reports.MultiBalanceReports
+import Hledger.Reports.BudgetReport
 -- import Hledger.Reports.BalanceHistoryReport
 
 tests_Hledger_Reports :: Test
@@ -42,5 +44,6 @@ tests_Hledger_Reports = TestList $
  tests_Hledger_Reports_EntriesReport,
  tests_Hledger_Reports_PostingsReport,
  tests_Hledger_Reports_BalanceReport,
- tests_Hledger_Reports_MultiBalanceReport
+ tests_Hledger_Reports_MultiBalanceReport,
+ tests_Hledger_Reports_BudgetReport
  ]

hledger-lib/Hledger/Reports/BudgetReport.hs

@@ -0,0 +1,341 @@
+{- |
+-}
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Hledger.Reports.BudgetReport
+where
+
+import Data.Decimal
+import Data.List
+import Data.Maybe
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Monoid ((<>))
+#endif
+import Data.Ord
+import Data.Time.Calendar
+--import Safe
+import Test.HUnit
+--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.CSV
+--import Test.HUnit
+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.MultiBalanceReports
+
+
+--type MultiBalanceReportRow    = (AccountName, AccountName, Int, [MixedAmount], MixedAmount, MixedAmount)
+--type MultiBalanceReportTotals = ([MixedAmount], MixedAmount, MixedAmount) -- (Totals list, sum of totals, average of totals)
+
+--type PeriodicReportRow a =
+--  ( AccountName  -- ^ A full account name.
+--  , [a]          -- ^ The data value for each subperiod.
+--  , a            -- ^ The total of this row's values.
+--  , a            -- ^ The average of this row's values.
+--  )
+
+type BudgetGoal    = Change
+type BudgetTotal   = Total
+type BudgetAverage = Average
+
+-- | A budget report tracks expected and actual changes per account and subperiod.
+type BudgetReport = PeriodicReport (Maybe Change, Maybe BudgetGoal)
+
+-- | Calculate budget goals from periodic transactions with the specified report interval,
+-- calculate actual inflows/outflows from the regular transactions (adjusted to match the
+-- budget goals' account tree), and return both as a 'BudgetReport'.
+budgetReport :: ReportOpts -> Bool -> Bool -> DateSpan -> Day -> Journal -> BudgetReport
+budgetReport ropts assrt showunbudgeted reportspan d j =
+  let
+    budgetj          = budgetJournal assrt ropts reportspan j
+    actualj          = budgetRollUp showunbudgeted budgetj j
+    q                = queryFromOpts d ropts
+    budgetgoalreport = dbg1 "budgetgoalreport" $ multiBalanceReport ropts q budgetj
+    actualreport     = dbg1 "actualreport"     $ multiBalanceReport ropts q actualj
+  in
+    dbg1 "budgetreport" $ 
+    combineBudgetAndActual budgetgoalreport actualreport
+
+-- | Select all periodic transactions from the given journal which
+-- match the requested report interval, and use them to generate
+-- budget transactions (like forecast transactions) in the specified
+-- report period (calculated in IO and passed in).
+budgetJournal :: Bool -> ReportOpts -> DateSpan -> Journal -> Journal
+budgetJournal assrt ropts reportspan j =
+  either error' id $ journalBalanceTransactions assrt j{ jtxns = budgetts }
+  where
+    budgetinterval = dbg2 "budgetinterval" $ interval_ ropts
+    budgetspan = dbg2 "budgetspan" $ reportspan
+    budgetts =
+      dbg1 "budgetts" $
+      [makeBudgetTxn t
+      | pt <- jperiodictxns j
+      , periodTransactionInterval pt == Just budgetinterval
+      , t <- runPeriodicTransaction pt budgetspan
+      ]
+    makeBudgetTxn t = txnTieKnot $ t { tdescription = T.pack "Budget transaction" }
+
+-- | Re-map account names to closest parent with periodic transaction from budget.
+-- Accounts that don't have suitable parent are either remapped to "<unbudgeted>:topAccount"
+-- or left as-is if --show-unbudgeted is provided.
+budgetRollUp :: Bool -> Journal -> Journal -> Journal
+budgetRollUp showunbudgeted budget j = j { jtxns = remapTxn <$> jtxns j }
+    where
+        budgetAccounts = nub $ concatMap (map paccount . ptpostings) $ jperiodictxns budget
+        remapAccount origAcctName = remapAccount' origAcctName
+          where
+            remapAccount' acctName
+              | acctName `elem` budgetAccounts = acctName
+              | otherwise =
+                case parentAccountName acctName of
+                  "" | showunbudgeted -> origAcctName
+                     | otherwise      -> T.append (T.pack "<unbudgeted>:") acctName  -- TODO: --drop should not remove this
+                  parent -> remapAccount' parent
+        remapPosting p = p { paccount = remapAccount $ paccount p, porigin = Just . fromMaybe p $ porigin p }
+        remapTxn = mapPostings (map remapPosting)
+        mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t }
+
+-- | 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
+  (MultiBalanceReport (budgetperiods, budgetrows, (budgettots, budgetgrandtot, budgetgrandavg)))
+  (MultiBalanceReport (actualperiods, actualrows, (actualtots, actualgrandtot, actualgrandavg))) =
+  let
+    periods = nub $ sort $ filter (/= nulldatespan) $ budgetperiods ++ actualperiods
+
+    -- first, combine any corresponding budget goals with actual changes
+    rows1 =
+      [ (acct, treeacct, treeindent, amtandgoals, totamtandgoal, avgamtandgoal)
+      | (acct, treeacct, treeindent, actualamts, actualtot, actualavg) <- actualrows
+      , let mbudgetgoals       = Map.lookup acct budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage)
+      , let budgetmamts        = maybe (replicate (length periods) Nothing) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal]
+      , let mbudgettot         = maybe Nothing (Just . second3) mbudgetgoals :: Maybe BudgetTotal
+      , let mbudgetavg         = maybe Nothing (Just . third3)  mbudgetgoals :: Maybe BudgetAverage
+      , let acctBudgetByPeriod = Map.fromList [ (p,budgetamt) | (p, Just budgetamt) <- zip budgetperiods budgetmamts ] :: Map DateSpan BudgetGoal
+      , let acctActualByPeriod = Map.fromList [ (p,actualamt) | (p, Just actualamt) <- zip actualperiods (map Just actualamts) ] :: Map DateSpan Change
+      , let amtandgoals        = [ (Map.lookup p acctActualByPeriod, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [(Maybe Change, Maybe BudgetGoal)]
+      , let totamtandgoal      = (Just actualtot, mbudgettot)
+      , let avgamtandgoal      = (Just actualavg, mbudgetavg)
+      ]
+      where
+        budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) =
+          Map.fromList [ (acct, (amts, tot, avg)) | (acct, _, _, amts, tot, avg) <- budgetrows ]
+
+    -- next, make rows for budget goals with no actual changes
+    rows2 =
+      [ (acct, treeacct, treeindent, amtandgoals, totamtandgoal, avgamtandgoal)
+      | (acct, treeacct, treeindent, budgetgoals, budgettot, budgetavg) <- budgetrows
+      , not $ acct `elem` acctsdone
+      , let acctBudgetByPeriod = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal
+      , let amtandgoals        = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [(Maybe Change, Maybe BudgetGoal)]
+      , let totamtandgoal      = (Nothing, Just budgettot)
+      , let avgamtandgoal      = (Nothing, Just budgetavg)
+      ]
+      where
+        acctsdone = map first6 rows1
+
+    -- combine and re-sort rows
+    -- TODO: respect hierarchy in tree mode
+    -- TODO: respect --sort-amount
+    -- TODO: add --sort-budget
+    rows :: [PeriodicReportRow (Maybe Change, Maybe BudgetGoal)] =
+      sortBy (comparing first6) $ rows1 ++ rows2
+-- massive duplication from multiBalanceReport to handle tree mode sorting ?
+--      dbg1 "sorteditems" $
+--      sortitems items
+--      where
+--        sortitems
+--          | sort_amount_ opts && accountlistmode_ opts == ALTree       = sortTreeMultiBalanceReportRowsByAmount
+--          | sort_amount_ opts                                          = sortFlatMultiBalanceReportRowsByAmount
+--          | not (sort_amount_ opts) && accountlistmode_ opts == ALTree = sortTreeMultiBalanceReportRowsByAccountCodeAndName
+--          | otherwise                                                  = sortFlatMultiBalanceReportRowsByAccountCodeAndName
+--          where
+--            -- Sort the report rows, representing a flat account list, by row total.
+--            sortFlatMultiBalanceReportRowsByAmount = sortBy (maybeflip $ comparing fifth6)
+--              where
+--                maybeflip = if normalbalance_ opts == Just NormallyNegative then id else flip
+--
+--            -- Sort the report rows, representing a tree of accounts, by row total at each level.
+--            -- To do this we recreate an Account tree with the row totals as balances,
+--            -- so we can do a hierarchical sort, flatten again, and then reorder the
+--            -- report rows similarly. Yes this is pretty long winded.
+--            sortTreeMultiBalanceReportRowsByAmount rows = sortedrows
+--              where
+--                anamesandrows = [(first6 r, r) | r <- rows]
+--                anames = map fst anamesandrows
+--                atotals = [(a,tot) | (a,_,_,_,tot,_) <- rows]
+--                nametree = treeFromPaths $ map expandAccountName anames
+--                accounttree = nameTreeToAccount "root" nametree
+--                accounttreewithbals = mapAccounts setibalance accounttree
+--                  where
+--                    -- this error should not happen, but it's ugly TODO
+--                    setibalance a = a{aibalance=fromMaybe (error "sortTreeMultiBalanceReportRowsByAmount 1") $ lookup (aname a) atotals}
+--                sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ opts) accounttreewithbals
+--                sortedaccounts = drop 1 $ flattenAccounts sortedaccounttree
+--                -- dropped the root account, also ignore any parent accounts not in rows
+--                sortedrows = concatMap (\a -> maybe [] (:[]) $ lookup (aname a) anamesandrows) sortedaccounts
+--
+--            -- Sort the report rows by account code if any, with the empty account code coming last, then account name.
+--            sortFlatMultiBalanceReportRowsByAccountCodeAndName = sortBy (comparing acodeandname)
+--              where
+--                acodeandname r = (acode', aname)
+--                  where
+--                    aname = first6 r
+--                    macode = fromMaybe Nothing $ lookup aname $ jaccounts j
+--                    acode' = fromMaybe maxBound macode
+--
+--            -- Sort the report rows, representing a tree of accounts, by account code and then account name at each level.
+--            -- Convert a tree of account names, look up the account codes, sort and flatten the tree, reorder the rows.
+--            sortTreeMultiBalanceReportRowsByAccountCodeAndName rows = sortedrows
+--              where
+--                anamesandrows = [(first6 r, r) | r <- rows]
+--                anames = map fst anamesandrows
+--                nametree = treeFromPaths $ map expandAccountName anames
+--                accounttree = nameTreeToAccount "root" nametree
+--                accounttreewithcodes = mapAccounts (accountSetCodeFrom j) accounttree
+--                sortedaccounttree = sortAccountTreeByAccountCodeAndName accounttreewithcodes
+--                sortedaccounts = drop 1 $ flattenAccounts sortedaccounttree
+--                -- dropped the root account, also ignore any parent accounts not in rows
+--                sortedrows = concatMap (\a -> maybe [] (:[]) $ lookup (aname a) anamesandrows) sortedaccounts
+--
+
+    -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells
+    totalrow =
+      ( ""
+      , ""
+      , 0
+      , [ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ] :: [(Maybe Total, Maybe BudgetTotal)]
+      , ( Just actualgrandtot, Just budgetgrandtot ) :: (Maybe Total, Maybe BudgetTotal)
+      , ( Just actualgrandavg, Just budgetgrandavg ) :: (Maybe Total, Maybe BudgetTotal)
+      )
+      where
+        totBudgetByPeriod = Map.fromList $ zip budgetperiods budgettots :: Map DateSpan BudgetTotal
+        totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change
+
+  in
+    PeriodicReport
+      ( periods
+      , rows
+      , totalrow
+      )
+
+-- | Figure out the overall period of a BudgetReport.
+budgetReportSpan :: BudgetReport -> DateSpan
+budgetReportSpan (PeriodicReport ([], _, _))    = DateSpan Nothing Nothing
+budgetReportSpan (PeriodicReport (spans, _, _)) = DateSpan (spanStart $ head spans) (spanEnd $ last spans)
+
+-- | Render a budget report as plain text suitable for console output.
+budgetReportAsText :: ReportOpts -> BudgetReport -> String
+budgetReportAsText ropts budgetr =
+  printf "Budget performance in %s:\n\n" (showDateSpan $ budgetReportSpan budgetr)
+  ++ 
+  tableAsText ropts showcell (budgetReportAsTable ropts budgetr)
+  where
+    showcell :: (Maybe Change, Maybe BudgetGoal) -> String
+    showcell (mactual, mbudget) = actualstr ++ " " ++ budgetstr
+      where
+        actualwidth  = 7
+        percentwidth = 4
+        budgetwidth  = 5
+        actualstr = printf ("%"++show actualwidth++"s") (maybe "0" showamt mactual)
+        budgetstr = case (mactual, mbudget) of
+          (_,       Nothing)     -> replicate (percentwidth + 7 + budgetwidth) ' '
+          (mactual, Just budget) ->
+            case percentage mactual budget of
+              Just pct ->
+                printf ("[%"++show percentwidth++"s%% of %"++show budgetwidth++"s]")
+                       (show $ roundTo 0 pct) (showbudgetamt budget)
+              Nothing ->
+                printf ("["++replicate (percentwidth+5) ' '++"%"++show budgetwidth++"s]")
+                       (showbudgetamt budget)
+
+    percentage :: Maybe Change -> BudgetGoal -> Maybe Percentage
+    percentage Nothing _ = Nothing
+    percentage (Just actual) budget =
+      -- percentage of budget consumed is always computed in the cost basis
+      case (toCost actual, toCost budget) of
+        (Mixed [a1], Mixed [a2])
+          | isReallyZeroAmount a1 -> Just 0 -- if there are no postings, we consumed 0% of budget
+          | acommodity a1 == acommodity a2 && aquantity a2 /= 0 ->
+            Just $ 100 * aquantity a1 / aquantity a2
+        _ -> Nothing
+        where
+          toCost = normaliseMixedAmount . costOfMixedAmount
+
+    showamt :: MixedAmount -> String
+    showamt | color_ ropts  = cshowMixedAmountOneLineWithoutPrice
+            | otherwise     = showMixedAmountOneLineWithoutPrice
+
+    -- don't show the budget amount in color, it messes up alignment
+    showbudgetamt = showMixedAmountOneLineWithoutPrice
+
+-- | Build a 'Table' from a multi-column balance report.
+budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount)
+budgetReportAsTable 
+  ropts 
+  (PeriodicReport
+    ( periods
+    , rows
+    , (_, _, _, coltots, grandtot, grandavg)
+    )) =
+    addtotalrow $ 
+    Table
+      (T.Group NoLine $ map Header accts)
+      (T.Group NoLine $ map Header colheadings)
+      (map rowvals rows)
+  where
+    colheadings = map showDateSpanMonthAbbrev periods
+                  ++ (if row_total_ ropts then ["  Total"] else [])
+                  ++ (if average_   ropts then ["Average"] else [])
+    accts = map renderacct rows
+    renderacct (a,a',i,_,_,_)
+      | tree_ ropts = replicate ((i-1)*2) ' ' ++ T.unpack a'
+      | otherwise   = T.unpack $ maybeAccountNameDrop ropts a
+    rowvals (_,_,_,as,rowtot,rowavg) = as
+                                       ++ (if row_total_ ropts then [rowtot] else [])
+                                       ++ (if average_   ropts then [rowavg] else [])
+    addtotalrow | no_total_ ropts = id
+                | otherwise       = (+----+ (row "" $
+                                     coltots
+                                     ++ (if row_total_ ropts && not (null coltots) then [grandtot] else [])
+                                     ++ (if average_   ropts && not (null coltots) then [grandavg] else [])
+                                     ))
+
+-- XXX here for now
+-- | Drop leading components of accounts names as specified by --drop, but only in --flat mode.
+maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName
+maybeAccountNameDrop opts a | tree_ opts = a
+                            | otherwise  = accountNameDrop (drop_ opts) a
+
+tests_Hledger_Reports_BudgetReport :: Test
+tests_Hledger_Reports_BudgetReport = TestList [
+  ]

hledger-lib/Hledger/Reports/MultiBalanceReports.hs

@@ -12,6 +12,8 @@ module Hledger.Reports.MultiBalanceReports (
   balanceReportFromMultiBalanceReport,
   mbrNegate,
   mbrNormaliseSign,
+  multiBalanceReportSpan,
+  tableAsText,
 
   -- -- * Tests
   tests_Hledger_Reports_MultiBalanceReport
@@ -24,6 +26,8 @@ import Data.Ord
 import Data.Time.Calendar
 import Safe
 import Test.HUnit
+import Text.Tabular as T
+import Text.Tabular.AsciiWide
 
 import Hledger.Data
 import Hledger.Query
@@ -259,6 +263,11 @@ mbrNegate (MultiBalanceReport (colspans, rows, totalsrow)) =
     mbrRowNegate (acct,shortacct,indent,amts,tot,avg) = (acct,shortacct,indent,map negate amts,-tot,-avg)
     mbrTotalsRowNegate (amts,tot,avg) = (map negate amts,-tot,-avg)
 
+-- | Figure out the overall date span of a multicolumn balance report.
+multiBalanceReportSpan :: MultiBalanceReport -> DateSpan
+multiBalanceReportSpan (MultiBalanceReport ([], _, _))       = DateSpan Nothing Nothing
+multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)
+
 -- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport, 
 -- in order to support --historical. Does not support tree-mode boring parent eliding. 
 -- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts 
@@ -322,6 +331,22 @@ tests_multiBalanceReport =
       Mixed [usd0])
   ]
 
+-- common rendering helper, XXX here for now
+
+tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String
+tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =
+  unlines
+  . trimborder
+  . lines
+  . render pretty id id showcell
+  . align
+  where
+    trimborder = drop 1 . init . map (drop 1 . init)
+    align (Table l t d) = Table l' t d
+      where
+        acctswidth = maximum' $ map strWidth (headerContents l)
+        l'         = padRightWide acctswidth <$> l
+
 tests_Hledger_Reports_MultiBalanceReport :: Test
 tests_Hledger_Reports_MultiBalanceReport = TestList
   tests_multiBalanceReport

hledger-lib/Hledger/Reports/ReportTypes.hs

@@ -22,19 +22,19 @@ type Average = MixedAmount  -- ^ The average of 'Change's or 'Balance's in a rep
 -- budget performance, etc. Successor to MultiBalanceReport.
 data PeriodicReport a =
   PeriodicReport
-    ( [DateSpan]            -- ^ The subperiods formed by spliting the overall report period by the report interval.
+    ( [DateSpan]            -- The subperiods formed by splitting the overall report period by the report interval.
                             -- For ending-balance reports, only the end date is significant.
                             -- Usually displayed as report columns.
-    , [PeriodicReportRow a] -- ^ One row per account in the report.
+    , [PeriodicReportRow a] -- One row per account in the report.
-    , PeriodicReportRow a   -- ^ The grand totals row. The account name in this row is always empty.
+    , PeriodicReportRow a   -- The grand totals row. The account name in this row is always empty.
     )
    deriving (Show)
 
 type PeriodicReportRow a =
-  ( AccountName  -- ^ A full account name.
+  ( AccountName  -- A full account name.
-  , AccountName  -- ^ Shortened form of the account name to display in tree mode. Usually the leaf name, possibly with parent accounts prefixed.
+  , AccountName  -- Shortened form of the account name to display in tree mode. Usually the leaf name, possibly with parent accounts prefixed.
-  , Int          -- ^ Indent level for displaying this account name in tree mode. 0, 1, 2... 
+  , Int          -- Indent level for displaying this account name in tree mode. 0, 1, 2... 
-  , [a]          -- ^ The data value for each subperiod.
+  , [a]          -- The data value for each subperiod.
-  , a            -- ^ The total of this row's values.
+  , a            -- The total of this row's values.
-  , a            -- ^ The average of this row's values.
+  , a            -- The average of this row's values.
   )

hledger-lib/hledger-lib.cabal

@@ -113,8 +113,10 @@ library
       Hledger.Read.TimeclockReader
       Hledger.Reports
       Hledger.Reports.ReportOptions
+      Hledger.Reports.ReportTypes
       Hledger.Reports.BalanceHistoryReport
       Hledger.Reports.BalanceReport
+      Hledger.Reports.BudgetReport
       Hledger.Reports.EntriesReport
       Hledger.Reports.MultiBalanceReports
       Hledger.Reports.PostingsReport
@@ -130,9 +132,8 @@ library
       Hledger.Utils.Tree
       Hledger.Utils.UTF8IOCompat
       Text.Megaparsec.Compat
+      Text.Tabular.AsciiWide
   other-modules:
-      Hledger.Reports.BudgetReport
-      Hledger.Reports.ReportTypes
       Paths_hledger_lib
   default-language: Haskell2010
 
@@ -172,6 +173,7 @@ test-suite doctests
     , regex-tdfa
     , safe >=0.2
     , split >=0.1
+    , tabular >=0.2
     , text >=1.2
     , time >=1.5
     , transformers >=0.2
@@ -229,6 +231,7 @@ test-suite doctests
       Hledger.Utils.Tree
       Hledger.Utils.UTF8IOCompat
       Text.Megaparsec.Compat
+      Text.Tabular.AsciiWide
       Paths_hledger_lib
   default-language: Haskell2010
 
@@ -268,6 +271,7 @@ test-suite easytests
     , regex-tdfa
     , safe >=0.2
     , split >=0.1
+    , tabular >=0.2
     , text >=1.2
     , time >=1.5
     , transformers >=0.2
@@ -323,6 +327,7 @@ test-suite easytests
       Hledger.Utils.Tree
       Hledger.Utils.UTF8IOCompat
       Text.Megaparsec.Compat
+      Text.Tabular.AsciiWide
       Paths_hledger_lib
   default-language: Haskell2010
 
@@ -363,6 +368,7 @@ test-suite hunittests
     , split >=0.1
     , test-framework
     , test-framework-hunit
+    , tabular >=0.2
     , text >=1.2
     , time >=1.5
     , transformers >=0.2
@@ -418,5 +424,6 @@ test-suite hunittests
       Hledger.Utils.Tree
       Hledger.Utils.UTF8IOCompat
       Text.Megaparsec.Compat
+      Text.Tabular.AsciiWide
       Paths_hledger_lib
   default-language: Haskell2010

hledger-lib/package.yaml

@@ -63,6 +63,7 @@ dependencies:
 - regex-tdfa
 - safe >=0.2
 - split >=0.1
+- tabular >=0.2
 - text >=1.2
 - time >=1.5
 - transformers >=0.2
@@ -141,6 +142,7 @@ library:
   - Hledger.Utils.Tree
   - Hledger.Utils.UTF8IOCompat
   - Text.Megaparsec.Compat
+  - Text.Tabular.AsciiWide
 #  other-modules:
 #  - Ledger.Parser.Text
 

hledger/Hledger/Cli/CliOptions.hs

@@ -53,7 +53,6 @@ module Hledger.Cli.CliOptions (
   replaceNumericFlags,
   -- | For register:
   registerWidthsFromOpts,
-  maybeAccountNameDrop,
   -- | For balance:
   lineFormatFromOpts,
 
@@ -584,11 +583,6 @@ registerWidthsFromOpts CliOpts{width_=Just s}  =
           eof
           return (totalwidth, descwidth)
 
--- | Drop leading components of accounts names as specified by --drop, but only in --flat mode.
-maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName
-maybeAccountNameDrop opts a | tree_ opts = a
-                            | otherwise  = accountNameDrop (drop_ opts) a
-
 -- for balance, currently:
 
 -- | Parse the format option if provided, possibly returning an error,

hledger/Hledger/Cli/Commands/Balance.hs

@@ -245,25 +245,23 @@ module Hledger.Cli.Commands.Balance (
  ,multiBalanceReportAsCsv
  ,multiBalanceReportAsHtml
  ,multiBalanceReportHtmlRows
- ,renderBalanceReportTable
  ,balanceReportAsTable
+ ,balanceReportTableAsText
  ,tests_Hledger_Cli_Commands_Balance
 ) where
 
-import Data.Decimal
 import Data.List
 import Data.Maybe
-import qualified Data.Map as Map
+--import qualified Data.Map as Map
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import System.Console.CmdArgs.Explicit as C
-import Data.Decimal (roundTo)
 import Lucid as L
 import Text.CSV
 import Test.HUnit
 import Text.Printf (printf)
 import Text.Tabular as T
-import Text.Tabular.AsciiWide
+--import Text.Tabular.AsciiWide
 
 import Hledger
 import Hledger.Cli.CliOptions
@@ -330,15 +328,15 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
         _ | boolopt "budget" rawopts -> do
           -- multi column budget report
           reportspan <- reportSpan j ropts
-          let budget = budgetJournal opts reportspan j
+          let budgetreport     = dbg1 "budgetreport"     $ budgetReport ropts assrt showunbudgeted reportspan d j
-              j' = budgetRollUp opts budget j
+                where
-              report       = dbg1 "report"       $ multiBalanceReport ropts (queryFromOpts d ropts) j'
+                  showunbudgeted = boolopt "show-unbudgeted" rawopts
-              budgetReport = dbg1 "budgetreport" $ multiBalanceReport ropts (queryFromOpts d ropts) budget
+                  assrt          = not $ ignore_assertions_ $ inputopts_ opts
               render = case format of
                 "csv"  -> const $ error' "Sorry, CSV output is not yet implemented for this kind of report."  -- TODO
                 "html" -> const $ error' "Sorry, HTML output is not yet implemented for this kind of report."  -- TODO
-                _     -> multiBalanceReportWithBudgetAsText ropts budgetReport
+                _      -> budgetReportAsText ropts
-          writeOutput opts $ render report
+          writeOutput opts $ render budgetreport
           
           | otherwise -> do
           -- multi column balance report
@@ -349,50 +347,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
                 _      -> multiBalanceReportAsText ropts
           writeOutput opts $ render report
 
--- | Re-map account names to closest parent with periodic transaction from budget.
+-- rendering single-column balance reports
--- Accounts that don't have suitable parent are either remapped to "<unbudgeted>:topAccount" 
--- or left as-is if --show-unbudgeted is provided. 
-budgetRollUp :: CliOpts -> Journal -> Journal -> Journal
-budgetRollUp CliOpts{rawopts_=rawopts} budget j = j { jtxns = remapTxn <$> jtxns j }
-    where
-        budgetAccounts = nub $ concatMap (map paccount . ptpostings) $ jperiodictxns budget
-        remapAccount origAcctName = remapAccount' origAcctName
-          where 
-            remapAccount' acctName
-              | acctName `elem` budgetAccounts = acctName
-              | otherwise = 
-                case parentAccountName acctName of
-                  "" | boolopt "show-unbudgeted" rawopts -> origAcctName
-                     | otherwise              -> T.append (T.pack "<unbudgeted>:") acctName  -- TODO: --drop should not remove this
-                  parent -> remapAccount' parent
-        remapPosting p = p { paccount = remapAccount $ paccount p, porigin = Just . fromMaybe p $ porigin p }
-        remapTxn = mapPostings (map remapPosting)
-        mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t }
-
--- | Select all periodic transactions from the given journal which
--- match the requested report interval, and use them to generate
--- budget transactions (like forecast transactions) in the specified
--- report period (calculated in IO and passed in).
-budgetJournal :: CliOpts -> DateSpan -> Journal -> Journal
-budgetJournal opts reportspan j = journalBalanceTransactions' opts j { jtxns = budgetts }
-  where 
-    budgetinterval = dbg2 "budgetinterval" $ intervalFromRawOpts $ rawopts_ opts
-    budgetspan = dbg2 "budgetspan" $ reportspan
-    budgetts =
-      dbg1 "budgetts" $
-      [makeBudgetTxn t
-      | pt <- jperiodictxns j
-      , periodTransactionInterval pt == Just budgetinterval
-      , t <- runPeriodicTransaction pt budgetspan
-      ]
-    makeBudgetTxn t = txnTieKnot $ t { tdescription = T.pack "Budget transaction" }
-    journalBalanceTransactions' opts j =
-      let assrt = not . ignore_assertions_ $ inputopts_ opts
-      in
-       either error' id $ journalBalanceTransactions assrt j
-
-
--- single-column balance reports
 
 -- | Find the best commodity to convert to when asked to show the
 -- market value of this commodity on the given date. That is, the one
@@ -522,7 +477,7 @@ renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field)
               | otherwise   = showMixedAmountWithoutPrice
   _                -> ""
 
--- multi-column balance reports
+-- rendering multi-column balance reports
 
 -- | Render a multi-column balance report as CSV.
 -- The CSV will always include the initial headings row,
@@ -641,7 +596,7 @@ multiBalanceReportHtmlFootRow ropts (acct:rest) =
 multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
 multiBalanceReportAsText opts r =
     printf "%s in %s:\n\n" desc (showDateSpan $ multiBalanceReportSpan r)
-      ++ renderBalanceReportTable opts tabl
+      ++ balanceReportTableAsText opts tabl
   where
     tabl = balanceReportAsTable opts r
     desc = case balancetype_ opts of
@@ -649,129 +604,11 @@ multiBalanceReportAsText opts r =
         CumulativeChange -> "Ending balances (cumulative)"
         HistoricalBalance -> "Ending balances (historical)"
 
-type ActualAmount = MixedAmount
-type BudgetAmount = MixedAmount
-type ActualAmountsReport = MultiBalanceReport
-type BudgetAmountsReport = MultiBalanceReport
-type ActualAmountsTable = Table String String MixedAmount
-type BudgetAmountsTable = Table String String MixedAmount
-type ActualAndBudgetAmountsTable = Table String String (Maybe MixedAmount, Maybe MixedAmount)
-type Percentage = Decimal
-
--- | Given two multi-column balance reports, the first representing a budget 
--- (target change amounts) and the second representing actual change amounts, 
--- render a budget report as plain text suitable for console output.
--- The reports should have the same number of columns.
-multiBalanceReportWithBudgetAsText :: ReportOpts -> BudgetAmountsReport -> ActualAmountsReport -> String
-multiBalanceReportWithBudgetAsText opts budgetr actualr =
-    printf "%s in %s:\n\n" desc (showDateSpan $ multiBalanceReportSpan actualr)
-      ++ renderBalanceReportTable' opts showcell actualandbudgetamts
-  where
-    desc :: String
-    desc = case balancetype_ opts of
-        PeriodChange -> "Balance changes"
-        CumulativeChange -> "Ending balances (cumulative)"
-        HistoricalBalance -> "Ending balances (historical)"
-
-    actualandbudgetamts :: ActualAndBudgetAmountsTable
-    actualandbudgetamts = combineTables (balanceReportAsTable opts actualr) (balanceReportAsTable opts budgetr)
-
-    showcell :: (Maybe ActualAmount, Maybe BudgetAmount) -> String
-    showcell (mactual, mbudget) = actualstr ++ " " ++ budgetstr
-      where
-        actualwidth  = 7
-        percentwidth = 4
-        budgetwidth  = 5
-        actualstr = printf ("%"++show actualwidth++"s") (maybe "" showamt mactual)
-        budgetstr = case (mactual, mbudget) of
-          (_,       Nothing)     -> replicate (percentwidth + 7 + budgetwidth) ' '
-          (mactual, Just budget) -> 
-            case percentage mactual budget of
-              Just pct ->
-                printf ("[%"++show percentwidth++"s%% of %"++show budgetwidth++"s]")
-                       (show $ roundTo 0 pct) (showamt budget)
-              Nothing ->
-                printf ("["++replicate (percentwidth+5) ' '++"%"++show budgetwidth++"s]")
-                       (showamt budget)
-
-    percentage :: Maybe ActualAmount -> BudgetAmount -> Maybe Percentage
-    percentage Nothing _ = Nothing
-    percentage (Just actual) budget =
-      -- percentage of budget consumed is always computed in the cost basis
-      case (toCost actual, toCost budget) of
-        (Mixed [a1], Mixed [a2])
-          | isReallyZeroAmount a1 -> Just 0 -- if there are no postings, we consumed 0% of budget
-          | acommodity a1 == acommodity a2 && aquantity a2 /= 0 ->
-            Just $ 100 * aquantity a1 / aquantity a2
-        _ -> Nothing
-        where
-          toCost = normaliseMixedAmount . costOfMixedAmount
-
-    showamt :: MixedAmount -> String
-    showamt | color_ opts  = cshowMixedAmountOneLineWithoutPrice
-            | otherwise    = showMixedAmountOneLineWithoutPrice
-
-    -- Combine a table of actual amounts and a table of budgeted amounts into  
-    -- a single table of (Maybe actualamount, Maybe budgetamount) tuples. 
-    -- The actual and budget table need not have the same account rows or date columns.
-    -- Every row and column from either table will appear in the combined table.
-    -- TODO better to combine the reports, not these tables which are just rendering helpers
-    combineTables :: ActualAmountsTable -> BudgetAmountsTable -> ActualAndBudgetAmountsTable
-    combineTables (Table aaccthdrs adatehdrs arows) (Table baccthdrs bdatehdrs brows) =
-      addtotalrow $ Table caccthdrs cdatehdrs crows
-      where
-        [aaccts, adates, baccts, bdates] = map headerContents [aaccthdrs, adatehdrs, baccthdrs, bdatehdrs]
-        -- combined account names
-        -- TODO Can't sort these or things will fall apart.
-        caccts = dbg2 "caccts" $ init $ (dbg2 "aaccts" $ filter (not . null) aaccts) `union` (dbg2 "baccts" baccts)
-        caccthdrs = T.Group NoLine $ map Header $ caccts
-        -- Actual column dates and budget column dates could be different.
-        -- TODO Can't easily combine these preserving correct order, will go wrong on monthly reports probably.
-        cdates = dbg2 "cdates" $ sort $ (dbg2 "adates" adates) `union` (dbg2 "bdates" bdates)
-        cdatehdrs = T.Group NoLine $ map Header cdates
-        -- corresponding rows of combined actual and/or budget amounts
-        crows = [ combineRow (actualRow a) (budgetRow a) | a <- caccts ]
-        -- totals row
-        addtotalrow | no_total_ opts = id
-                    | otherwise      = (+----+ (row "" $ combineRow (actualRow "") (budgetRow "")))
-        -- helpers
-        combineRow arow brow =
-          dbg1 "row" $ [(actualAmt d, budgetAmt d) | d <- cdates]
-          where
-            actualAmt date = Map.lookup date $ Map.fromList $ zip adates arow
-            budgetAmt date = Map.lookup date $ Map.fromList $ zip bdates brow
-
-        actualRow acct = fromMaybe [] $ Map.lookup acct $ Map.fromList $ zip aaccts arows
-        budgetRow acct = fromMaybe [] $ Map.lookup acct $ Map.fromList $ zip baccts brows
-
--- | Given a table representing a multi-column balance report (for example,
--- made using 'balanceReportAsTable'), render it in a format suitable for
--- console output.
-renderBalanceReportTable :: ReportOpts -> Table String String MixedAmount -> String
-renderBalanceReportTable ropts =
-  renderBalanceReportTable' ropts showamt
-  where
-    showamt | color_ ropts = cshowMixedAmountOneLineWithoutPrice
-            | otherwise    = showMixedAmountOneLineWithoutPrice
-
-renderBalanceReportTable' :: ReportOpts -> (a -> String) -> Table String String a -> String
-renderBalanceReportTable' (ReportOpts { pretty_tables_ = pretty}) showamt =
-  unlines
-  . trimborder
-  . lines
-  . render pretty id id showamt
-  . align
-  where
-    trimborder = drop 1 . init . map (drop 1 . init)
-    align (Table l t d) = Table l' t d
-      where
-        acctswidth = maximum' $ map strWidth (headerContents l)
-        l'         = padRightWide acctswidth <$> l
-
 -- | Build a 'Table' from a multi-column balance report.
 balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount
 balanceReportAsTable opts (MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
-   addtotalrow $ Table
+   addtotalrow $ 
+   Table
      (T.Group NoLine $ map Header accts)
      (T.Group NoLine $ map Header colheadings)
      (map rowvals items)
@@ -796,10 +633,14 @@ balanceReportAsTable opts (MultiBalanceReport (colspans, items, (coltotals,tot,a
                                     ++ (if average_ opts && not (null coltotals)   then [avg] else [])
                                     ))
 
--- | Figure out the overall date span of a multicolumn balance report.
+-- | Given a table representing a multi-column balance report (for example,
-multiBalanceReportSpan :: MultiBalanceReport -> DateSpan
+-- made using 'balanceReportAsTable'), render it in a format suitable for
-multiBalanceReportSpan (MultiBalanceReport ([], _, _))       = DateSpan Nothing Nothing
+-- console output.
-multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)
+balanceReportTableAsText :: ReportOpts -> Table String String MixedAmount -> String
+balanceReportTableAsText ropts = tableAsText ropts showamt
+  where
+    showamt | color_ ropts = cshowMixedAmountOneLineWithoutPrice
+            | otherwise    =  showMixedAmountOneLineWithoutPrice
 
 
 tests_Hledger_Cli_Commands_Balance = TestList

hledger/Hledger/Cli/CompoundBalanceCommand.hs

@@ -249,7 +249,7 @@ Balance Sheet
 compoundBalanceReportAsText :: ReportOpts -> CompoundBalanceReport -> String
 compoundBalanceReportAsText ropts (title, _colspans, subreports, (coltotals, grandtotal, grandavg)) =
   title ++ "\n\n" ++ 
-  renderBalanceReportTable ropts bigtable'
+  balanceReportTableAsText ropts bigtable'
   where
     singlesubreport = length subreports == 1
     bigtable = 

hledger/hledger.cabal

@@ -150,7 +150,6 @@ library
       Hledger.Cli.Commands.Stats
       Hledger.Cli.Commands.Tags
       Hledger.Cli.CompoundBalanceCommand
-      Text.Tabular.AsciiWide
   other-modules:
       Paths_hledger
   default-language: Haskell2010

hledger/package.yaml

@@ -131,7 +131,6 @@ library:
   - Hledger.Cli.Commands.Stats
   - Hledger.Cli.Commands.Tags
   - Hledger.Cli.CompoundBalanceCommand
-  - Text.Tabular.AsciiWide
   dependencies:
   - bytestring
   - containers

tests/budget/budget.test

@@ -32,7 +32,7 @@
 
 # 1. Test --budget switch
 $ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget
-Balance changes in 2016/12/01-2016/12/03:
+Budget performance in 2016/12/01-2016/12/03:
 
                        ||               2016/12/01                2016/12/02                2016/12/03 
 =======================++==============================================================================
@@ -45,7 +45,7 @@ Balance changes in 2016/12/01-2016/12/03:
 
 # 2. --show-unbudgeted
 $ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget --show-unbudgeted
-Balance changes in 2016/12/01-2016/12/03:
+Budget performance in 2016/12/01-2016/12/03:
 
                   ||               2016/12/01                2016/12/02                2016/12/03 
 ==================++==============================================================================
@@ -93,7 +93,7 @@ Balance changes in 2016/12/01-2016/12/03:
     assets:cash
 
 $ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget
-Balance changes in 2016/12/01-2016/12/03:
+Budget performance in 2016/12/01-2016/12/03:
 
                        ||                 2016/12/01                     2016/12/02                2016/12/03 
 =======================++=====================================================================================
@@ -137,7 +137,7 @@ $ hledger -f- bal --budget
 # 5. With -D it selects the daily budget. 
 # The budget is unbounded, so extends through the report period.
 $ hledger -f- bal --budget -D
-Balance changes in 2018/01/01-2018/01/03:
+Budget performance in 2018/01/01-2018/01/03:
 
    ||               2018/01/01                2018/01/02                2018/01/03 
 ===++==============================================================================
@@ -150,7 +150,7 @@ Balance changes in 2018/01/01-2018/01/03:
 
 # 6. And with -W it selects the weekly budget, defined by all weekly periodic transactions.
 $ hledger -f- bal --budget -W
-Balance changes in 2018/01/01w01:
+Budget performance in 2018/01/01w01:
 
    ||            2018/01/01w01 
 ===++==========================
@@ -182,7 +182,7 @@ Balance changes in 2018/01/01w01:
   (b)  1
 
 $ hledger -f- bal --budget -D
-Balance changes in 2018/01/01-2018/01/04:
+Budget performance in 2018/01/01-2018/01/04:
 
                 ||               2018/01/01                2018/01/02                2018/01/03                2018/01/04 
 ================++========================================================================================================
@@ -212,7 +212,7 @@ Balance changes in 2018/01/01-2018/01/04:
   (a)  1
 
 $ hledger -f- bal --budget -D
-Balance changes in 2018/01/01-2018/01/04:
+Budget performance in 2018/01/01-2018/01/04:
 
    ||               2018/01/01                2018/01/02                2018/01/03                2018/01/04 
 ===++========================================================================================================
@@ -222,7 +222,7 @@ Balance changes in 2018/01/01-2018/01/04:
 
 # 9. A "from A to B" budget should not be included in a report beginning on B.
 $ hledger -f- bal --budget -D -b 2018/1/3
-Balance changes in 2018/01/03-2018/01/04:
+Budget performance in 2018/01/03-2018/01/04:
 
    ||               2018/01/03                2018/01/04 
 ===++====================================================
@@ -243,18 +243,18 @@ Balance changes in 2018/01/03-2018/01/04:
 # 10. accounts with non-zero budget should be shown by default 
 # even if there are no actual transactions in the period,
 # or if the actual amount is zero.
-# $ hledger -f- bal --budget -D date:2018/1/1-2018/1/3
+$ hledger -f- bal --budget -D date:2018/1/1-2018/1/3
-# Balance changes in 2018/01/01-2018/01/02:
+Budget performance in 2018/01/01-2018/01/02:
 
-#    ||               2018/01/01                2018/01/02 
+   ||               2018/01/01                2018/01/02 
-# ===++====================================================
+===++====================================================
-#  a ||         [             1]          [             1] 
+ a ||       0 [             1]        0 [             1] 
-# ---++----------------------------------------------------
+---++----------------------------------------------------
-#    ||         [             1]          [             1] 
+   ||       0 [             1]        0 [             1] 
 
 # 11. With -E, zeroes are shown
 $ hledger -f- bal --budget -D date:2018/1/1-2018/1/3 -E
-Balance changes in 2018/01/01-2018/01/02:
+Budget performance in 2018/01/01-2018/01/02:
 
    ||               2018/01/01                2018/01/02 
 ===++====================================================