!dev: lib: Allow Account to store date-indexed balances.

This upgrades Account to enable it to store a multiperiod balance, with
a separate balance for each date period. This enables it do the hard
work in MultiBalanceReport.

Some new types are created to enable convenient operation of accounts.
- `BalanceData` is a type which stores an exclusive balance, inclusive
  balance, and number of postings. This was previously directly stored
  in Account, but is now factored into a separate data type.
- `PeriodData` is a container which stores date-indexed data, as well as
  pre-period data. In post cases, this represents the report spans,
  along with the historical data.
- Account becomes polymorphic, allowing customisation of the type of
  data it stores. This will usually be `BalanceData`, but in
  `BudgetReport` it can use `These BalanceData BalanceData` to store
  both actuals and budgets in the same structure. The data structure
  changes to contain a `PeriodData`, allowing multiperiod accounts.

Some minor changes are made to behaviour for consistency:
- --declared treats parent accounts consistently.
- --flat --empty ensures that implied accounts with no postings are not displayed, but
  accounts with zero balance and actual postings are.

hledger-lib/Hledger/Data.hs

@@ -10,6 +10,8 @@ functionality.  This package re-exports all the Hledger.Data.* modules
 
 module Hledger.Data (
                module Hledger.Data.Account,
+               module Hledger.Data.BalanceData,
+               module Hledger.Data.PeriodData,
                module Hledger.Data.AccountName,
                module Hledger.Data.Amount,
                module Hledger.Data.Balancing,
@@ -36,6 +38,8 @@ where
 
 import Test.Tasty (testGroup)
 import Hledger.Data.Account
+import Hledger.Data.BalanceData
+import Hledger.Data.PeriodData
 import Hledger.Data.AccountName
 import Hledger.Data.Amount
 import Hledger.Data.Balancing
@@ -58,7 +62,10 @@ import Hledger.Data.Types hiding (MixedAmountKey, Mixed)
 import Hledger.Data.Valuation
 
 tests_Data = testGroup "Data" [
-   tests_AccountName
+   tests_Account
+  ,tests_AccountName
+  ,tests_BalanceData
+  ,tests_PeriodData
   ,tests_Amount
   ,tests_Balancing
   -- ,tests_Currency

hledger-lib/Hledger/Data/Account.hs

@@ -1,6 +1,7 @@
-{-# LANGUAGE CPP               #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-|
 
 
@@ -11,8 +12,11 @@ account, and subaccounting-excluding and -including balances.
 
 module Hledger.Data.Account
 ( nullacct
+, accountFromBalances
+, accountFromPostings
 , accountsFromPostings
 , accountTree
+, accountTreeFromBalanceAndNames
 , showAccounts
 , showAccountsBoringFlag
 , printAccounts
@@ -20,6 +24,7 @@ module Hledger.Data.Account
 , parentAccounts
 , accountsLevels
 , mapAccounts
+, mapPeriodData
 , anyAccounts
 , filterAccounts
 , sumAccounts
@@ -27,38 +32,53 @@ module Hledger.Data.Account
 , clipAccountsAndAggregate
 , pruneAccounts
 , flattenAccounts
+, mergeAccounts
 , accountSetDeclarationInfo
 , sortAccountNamesByDeclaration
-, sortAccountTreeByAmount
+, sortAccountTreeByDeclaration
+, sortAccountTreeOn
+-- -- * Tests
+, tests_Account
 ) where
 
+import Control.Applicative ((<|>))
 import qualified Data.HashSet as HS
 import qualified Data.HashMap.Strict as HM
+import qualified Data.IntMap as IM
 import Data.List (find, sortOn)
 #if !MIN_VERSION_base(4,20,0)
 import Data.List (foldl')
 #endif
-import Data.List.Extra (groupOn)
+import Data.List.NonEmpty (NonEmpty(..), groupWith)
 import qualified Data.Map as M
-import Data.Ord (Down(..))
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+import Data.These (These(..))
+import Data.Time (Day(..), fromGregorian)
 import Safe (headMay)
 import Text.Printf (printf)
 
-import Hledger.Data.AccountName (expandAccountName, clipOrEllipsifyAccountName)
+import Hledger.Data.BalanceData ()
+import Hledger.Data.PeriodData
+import Hledger.Data.AccountName
 import Hledger.Data.Amount
 import Hledger.Data.Types
+import Hledger.Utils
 
 
 -- deriving instance Show Account
-instance Show Account where
-    show Account{..} = printf "Account %s (boring:%s, postings:%d, ebalance:%s, ibalance:%s)"
-                       aname
-                       (if aboring then "y" else "n" :: String)
-                       anumpostings
-                       (wbUnpack $ showMixedAmountB defaultFmt aebalance)
-                       (wbUnpack $ showMixedAmountB defaultFmt aibalance)
+instance Show a => Show (Account a) where
+  showsPrec d acct =
+    showParen (d > 10) $
+       showString "Account "
+      . showString (T.unpack $ aname acct)
+      . showString " (boring:"
+      . showString (if aboring acct then "y" else "n")
+      . showString ", adata:"
+      . shows (adata acct)
+      . showChar ')'
 
-instance Eq Account where
+instance Eq (Account a) where
   (==) a b = aname a == aname b -- quick equality test for speed
              -- and
              -- [ aname a == aname b
@@ -68,50 +88,73 @@ instance Eq Account where
              -- , aibalance a == aibalance b
              -- ]
 
-nullacct = Account
-  { aname            = ""
+nullacct :: Account BalanceData
+nullacct = accountFromBalances "" mempty
+
+-- | Construct an 'Account" from an account name and balances. Other fields are
+-- left blank.
+accountFromBalances :: AccountName -> PeriodData a -> Account a
+accountFromBalances name bal = Account
+  { aname            = name
   , adeclarationinfo = Nothing
   , asubs            = []
   , aparent          = Nothing
   , aboring          = False
-  , anumpostings     = 0
-  , aebalance        = nullmixedamt
-  , aibalance        = nullmixedamt
+  , adata            = bal
   }
 
--- | Derive 1. an account tree and 2. each account's total exclusive
--- and inclusive changes from a list of postings.
+-- | Derive 1. an account tree and 2. each account's total exclusive and
+-- inclusive changes associated with dates from a list of postings and a
+-- function for associating a date to each posting (usually representing the
+-- start dates of report subperiods).
 -- This is the core of the balance command (and of *ledger).
 -- The accounts are returned as a list in flattened tree order,
 -- and also reference each other as a tree.
 -- (The first account is the root of the tree.)
-accountsFromPostings :: [Posting] -> [Account]
-accountsFromPostings ps =
-  let
-    summed = foldr (\p -> HM.insertWith addAndIncrement (paccount p) (1, pamount p)) mempty ps
-      where addAndIncrement (n, a) (m, b) = (n + m, a `maPlus` b)
-    acctstree      = accountTree "root" $ HM.keys summed
-    acctswithebals = mapAccounts setnumpsebalance acctstree
-      where setnumpsebalance a = a{anumpostings=numps, aebalance=total}
-              where (numps, total) = HM.lookupDefault (0, nullmixedamt) (aname a) summed
-    acctswithibals = sumAccounts acctswithebals
-    acctswithparents = tieAccountParents acctswithibals
-    acctsflattened = flattenAccounts acctswithparents
-  in
-    acctsflattened
+accountsFromPostings :: (Posting -> Maybe Day) -> [Posting] -> [Account BalanceData]
+accountsFromPostings getPostingDate = flattenAccounts . accountFromPostings getPostingDate
+
+-- | Derive 1. an account tree and 2. each account's total exclusive
+-- and inclusive changes associated with dates from a list of postings and a
+-- function for associating a date to each posting (usually representing the
+-- start dates of report subperiods).
+-- This is the core of the balance command (and of *ledger).
+-- The accounts are returned as a tree.
+accountFromPostings :: (Posting -> Maybe Day) -> [Posting] -> Account BalanceData
+accountFromPostings getPostingDate ps =
+    tieAccountParents . sumAccounts $ mapAccounts setBalance acctTree
+  where
+    -- The special name "..." is stored in the root of the tree
+    acctTree     = accountTree "root" . HM.keys $ HM.delete "..." accountMap
+    setBalance a = a{adata = HM.lookupDefault mempty name accountMap}
+      where name = if aname a == "root" then "..." else aname a
+    accountMap   = processPostings ps
+
+    processPostings :: [Posting] -> HM.HashMap AccountName (PeriodData BalanceData)
+    processPostings = foldl' (flip processAccountName) mempty
+      where
+        processAccountName p = HM.alter (updateBalanceData p) (paccount p)
+        updateBalanceData p = Just
+                            . insertPeriodData (getPostingDate p) (BalanceData (pamount p) nullmixedamt 1)
+                            . fromMaybe mempty
 
 -- | Convert a list of account names to a tree of Account objects,
--- with just the account names filled in.
+-- with just the account names filled in and an empty balance.
 -- A single root account with the given name is added.
-accountTree :: AccountName -> [AccountName] -> Account
-accountTree rootname as = nullacct{aname=rootname, asubs=map (uncurry accountTree') $ M.assocs m }
+accountTree :: Monoid a => AccountName -> [AccountName] -> Account a
+accountTree rootname = accountTreeFromBalanceAndNames rootname mempty
+
+-- | Convert a list of account names to a tree of Account objects,
+-- with just the account names filled in. Each account is given the same
+-- supplied balance.
+-- A single root account with the given name is added.
+accountTreeFromBalanceAndNames :: AccountName -> PeriodData a -> [AccountName] -> Account a
+accountTreeFromBalanceAndNames rootname bals as =
+    (accountFromBalances rootname bals){ asubs=map (uncurry accountTree') $ M.assocs m }
   where
     T m = treeFromPaths $ map expandAccountName as :: FastTree AccountName
     accountTree' a (T m') =
-      nullacct{
-        aname=a
-       ,asubs=map (uncurry accountTree') $ M.assocs m'
-       }
+      (accountFromBalances a bals){ asubs=map (uncurry accountTree') $ M.assocs m' }
 
 -- | An efficient-to-build tree suggested by Cale Gibbard, probably
 -- better than accountNameTreeFrom.
@@ -130,7 +173,7 @@ treeFromPaths = foldl' mergeTrees (T M.empty) . map treeFromPath
 
 
 -- | Tie the knot so all subaccounts' parents are set correctly.
-tieAccountParents :: Account -> Account
+tieAccountParents :: Account a -> Account a
 tieAccountParents = tie Nothing
   where
     tie parent a@Account{..} = a'
@@ -138,35 +181,50 @@ tieAccountParents = tie Nothing
         a' = a{aparent=parent, asubs=map (tie (Just a')) asubs}
 
 -- | Get this account's parent accounts, from the nearest up to the root.
-parentAccounts :: Account -> [Account]
+parentAccounts :: Account a -> [Account a]
 parentAccounts Account{aparent=Nothing} = []
 parentAccounts Account{aparent=Just a} = a:parentAccounts a
 
 -- | List the accounts at each level of the account tree.
-accountsLevels :: Account -> [[Account]]
+accountsLevels :: Account a -> [[Account a]]
 accountsLevels = takeWhile (not . null) . iterate (concatMap asubs) . (:[])
 
 -- | Map a (non-tree-structure-modifying) function over this and sub accounts.
-mapAccounts :: (Account -> Account) -> Account -> Account
+mapAccounts :: (Account a -> Account a) -> Account a -> Account a
 mapAccounts f a = f a{asubs = map (mapAccounts f) $ asubs a}
 
+-- | Apply a function to all 'PeriodData' within this and sub accounts.
+mapPeriodData :: (PeriodData a -> PeriodData a) -> Account a -> Account a
+mapPeriodData f = mapAccounts (\a -> a{adata = f $ adata a})
+
 -- | Is the predicate true on any of this account or its subaccounts ?
-anyAccounts :: (Account -> Bool) -> Account -> Bool
+anyAccounts :: (Account a -> Bool) -> Account a -> Bool
 anyAccounts p a
     | p a = True
     | otherwise = any (anyAccounts p) $ asubs a
 
--- | Add subaccount-inclusive balances to an account tree.
-sumAccounts :: Account -> Account
-sumAccounts a
-  | null $ asubs a = a{aibalance=aebalance a}
-  | otherwise      = a{aibalance=ibal, asubs=subs}
+-- | Is the predicate true on all of this account and its subaccounts ?
+allAccounts :: (Account a -> Bool) -> Account a -> Bool
+allAccounts p a
+    | not (p a) = False
+    | otherwise = all (allAccounts p) $ asubs a
+
+-- | Recalculate all the subaccount-inclusive balances in this tree.
+sumAccounts :: Account BalanceData -> Account BalanceData
+sumAccounts a = a{asubs = subs, adata = setInclusiveBalances $ adata a}
   where
     subs = map sumAccounts $ asubs a
-    ibal = maSum $ aebalance a : map aibalance subs
+    subtotals = foldMap adata subs
+
+    setInclusiveBalances :: PeriodData BalanceData -> PeriodData BalanceData
+    setInclusiveBalances = mergePeriodData onlyChildren noChildren combineChildren subtotals
+
+    combineChildren children this = this  {bdincludingsubs = bdexcludingsubs this <> bdincludingsubs children}
+    onlyChildren    children      = mempty{bdincludingsubs = bdincludingsubs children}
+    noChildren               this = this  {bdincludingsubs = bdexcludingsubs this}
 
 -- | Remove all subaccounts below a certain depth.
-clipAccounts :: Int -> Account -> Account
+clipAccounts :: Int -> Account a -> Account a
 clipAccounts 0 a = a{asubs=[]}
 clipAccounts d a = a{asubs=subs}
     where
@@ -175,13 +233,14 @@ clipAccounts d a = a{asubs=subs}
 -- | Remove subaccounts below the specified depth, aggregating their balance at the depth limit
 -- (accounts at the depth limit will have any sub-balances merged into their exclusive balance).
 -- If the depth is Nothing, return the original accounts
-clipAccountsAndAggregate :: DepthSpec -> [Account] -> [Account]
+clipAccountsAndAggregate :: Monoid a => DepthSpec -> [Account a] -> [Account a]
 clipAccountsAndAggregate (DepthSpec Nothing []) as = as
-clipAccountsAndAggregate d                      as = combined
+clipAccountsAndAggregate depthSpec              as = combined
     where
-      clipped  = [a{aname=clipOrEllipsifyAccountName d $ aname a} | a <- as]
-      combined = [a{aebalance=maSum $ map aebalance same}
-                 | same@(a:_) <- groupOn aname clipped]
+      clipped  = [a{aname=clipOrEllipsifyAccountName depthSpec $ aname a} | a <- as]
+      combined = [a{adata=foldMap adata same}
+                 | same@(a:|_) <- groupWith aname clipped]
+
 {-
 test cases, assuming d=1:
 
@@ -211,7 +270,7 @@ combined: [assets 2 2]
 -}
 
 -- | Remove all leaf accounts and subtrees matching a predicate.
-pruneAccounts :: (Account -> Bool) -> Account -> Maybe Account
+pruneAccounts :: (Account a -> Bool) -> Account a -> Maybe (Account a)
 pruneAccounts p = headMay . prune
   where
     prune a
@@ -224,33 +283,47 @@ pruneAccounts p = headMay . prune
 -- | Flatten an account tree into a list, which is sometimes
 -- convenient. Note since accounts link to their parents/subs, the
 -- tree's structure remains intact and can still be used. It's a tree/list!
-flattenAccounts :: Account -> [Account]
+flattenAccounts :: Account a -> [Account a]
 flattenAccounts a = squish a []
   where squish a' as = a' : Prelude.foldr squish as (asubs a')
 
 -- | Filter an account tree (to a list).
-filterAccounts :: (Account -> Bool) -> Account -> [Account]
+filterAccounts :: (Account a -> Bool) -> Account a -> [Account a]
 filterAccounts p a
     | p a       = a : concatMap (filterAccounts p) (asubs a)
     | otherwise = concatMap (filterAccounts p) (asubs a)
 
--- | Sort each group of siblings in an account tree by inclusive amount,
--- so that the accounts with largest normal balances are listed first.
--- The provided normal balance sign determines whether normal balances
--- are negative or positive, affecting the sort order. Ie,
--- if balances are normally negative, then the most negative balances
--- sort first, and vice versa.
-sortAccountTreeByAmount :: NormalSign -> Account -> Account
-sortAccountTreeByAmount normalsign = mapAccounts $ \a -> a{asubs=sortSubs $ asubs a}
+-- | Merge two account trees and their subaccounts.
+--
+-- This assumes that the top-level 'Account's have the same name.
+mergeAccounts :: Account a -> Account b -> Account (These a b)
+mergeAccounts a = tieAccountParents . merge a
   where
-    sortSubs = case normalsign of
-        NormallyPositive -> sortOn (\a -> (Down $ amt a, aname a))
-        NormallyNegative -> sortOn (\a -> (amt a, aname a))
-    amt = mixedAmountStripCosts . aibalance
+    merge acct1 acct2 = acct1
+       { adeclarationinfo = adeclarationinfo acct1 <|> adeclarationinfo acct2
+       , aparent = Nothing
+       , aboring = aboring acct1 && aboring acct2
+       , adata = mergeBalances (adata acct1) (adata acct2)
+       , asubs = mergeSubs (sortOn aname $ asubs acct1) (sortOn aname $ asubs acct2)
+       }
+
+    mergeSubs (x:xs) (y:ys) = case compare (aname x) (aname y) of
+      EQ -> merge x y : mergeSubs xs ys
+      LT -> fmap This x : mergeSubs xs (y:ys)
+      GT -> fmap That y : mergeSubs (x:xs) ys
+    mergeSubs xs [] = map (fmap This) xs
+    mergeSubs [] ys = map (fmap That) ys
+
+    mergeBalances = mergePeriodData This That These
+
+-- | Sort each group of siblings in an account tree by projecting through
+-- a provided function.
+sortAccountTreeOn :: Ord b => (Account a -> b) -> Account a -> Account a
+sortAccountTreeOn f = mapAccounts $ \a -> a{asubs=sortOn f $ asubs a}
 
 -- | Add extra info for this account derived from the Journal's
 -- account directives, if any (comment, tags, declaration order..).
-accountSetDeclarationInfo :: Journal -> Account -> Account
+accountSetDeclarationInfo :: Journal -> Account a -> Account a
 accountSetDeclarationInfo j a@Account{..} =
   a{ adeclarationinfo=lookup aname $ jdeclaredaccounts j }
 
@@ -271,14 +344,13 @@ sortAccountNamesByDeclaration j keepparents as =
     flattenAccounts $                                   -- convert to an account list
     sortAccountTreeByDeclaration $                      -- sort by declaration order (and name)
     mapAccounts (accountSetDeclarationInfo j) $         -- add declaration order info
-    accountTree "root"                                  -- convert to an account tree
-    as
+    (accountTree "root" as :: Account ())               -- convert to an account tree
 
 -- | Sort each group of siblings in an account tree by declaration order, then account name.
 -- So each group will contain first the declared accounts,
 -- in the same order as their account directives were parsed,
 -- and then the undeclared accounts, sorted by account name.
-sortAccountTreeByDeclaration :: Account -> Account
+sortAccountTreeByDeclaration :: Account a -> Account a
 sortAccountTreeByDeclaration a
   | null $ asubs a = a
   | otherwise      = a{asubs=
@@ -286,26 +358,37 @@ sortAccountTreeByDeclaration a
       map sortAccountTreeByDeclaration $ asubs a
       }
 
-accountDeclarationOrderAndName :: Account -> (Int, AccountName)
+accountDeclarationOrderAndName :: Account a -> (Int, AccountName)
 accountDeclarationOrderAndName a = (adeclarationorder', aname a)
   where
     adeclarationorder' = maybe maxBound adideclarationorder $ adeclarationinfo a
 
 -- | Search an account list by name.
-lookupAccount :: AccountName -> [Account] -> Maybe Account
+lookupAccount :: AccountName -> [Account a] -> Maybe (Account a)
 lookupAccount a = find ((==a).aname)
 
 -- debug helpers
 
-printAccounts :: Account -> IO ()
+printAccounts :: Show a => Account a -> IO ()
 printAccounts = putStrLn . showAccounts
 
+showAccounts :: Show a => Account a -> String
 showAccounts = unlines . map showAccountDebug . flattenAccounts
 
 showAccountsBoringFlag = unlines . map (show . aboring) . flattenAccounts
 
-showAccountDebug a = printf "%-25s %4s %4s %s"
+showAccountDebug a = printf "%-25s %s %4s"
                      (aname a)
-                     (wbUnpack . showMixedAmountB defaultFmt $ aebalance a)
-                     (wbUnpack . showMixedAmountB defaultFmt $ aibalance a)
                      (if aboring a then "b" else " " :: String)
+                     (show $ adata a)
+
+
+tests_Account = testGroup "Account" [
+    testGroup "accountFromPostings" [
+      testCase "no postings, no days" $
+        accountFromPostings undefined [] @?= accountTree "root" []
+     ,testCase "no postings, only 2000-01-01" $
+         allAccounts (all (\d -> (ModifiedJulianDay $ toInteger d) == fromGregorian 2000 01 01) . IM.keys . pdperiods . adata)
+                     (accountFromPostings undefined []) @? "Not all adata have exactly 2000-01-01"
+    ]
+  ]

hledger-lib/Hledger/Data/Amount.hs

@@ -135,6 +135,7 @@ module Hledger.Data.Amount (
   divideMixedAmount,
   multiplyMixedAmount,
   averageMixedAmounts,
+  sumAndAverageMixedAmounts,
   isNegativeAmount,
   isNegativeMixedAmount,
   mixedAmountIsZero,
@@ -851,8 +852,14 @@ transformMixedAmount :: (Quantity -> Quantity) -> MixedAmount -> MixedAmount
 transformMixedAmount f = mapMixedAmountUnsafe (transformAmount f)
 
 -- | Calculate the average of some mixed amounts.
-averageMixedAmounts :: [MixedAmount] -> MixedAmount
-averageMixedAmounts as = fromIntegral (length as) `divideMixedAmount` maSum as
+averageMixedAmounts :: Foldable f => f MixedAmount -> MixedAmount
+averageMixedAmounts = snd . sumAndAverageMixedAmounts
+
+-- | Calculate the sum and average of some mixed amounts.
+sumAndAverageMixedAmounts :: Foldable f => f MixedAmount -> (MixedAmount, MixedAmount)
+sumAndAverageMixedAmounts amts = (total, fromIntegral nAmts `divideMixedAmount` total)
+  where
+    (nAmts, total) = foldl' (\(n, a) b -> (n + 1, maPlus a b)) (0 :: Int, nullmixedamt) amts
 
 -- | Is this mixed amount negative, if we can tell that unambiguously?
 -- Ie when normalised, are all individual commodity amounts negative ?
@@ -1039,9 +1046,16 @@ mixedAmountSetStyles = styleAmounts
 instance HasAmounts MixedAmount where
   styleAmounts styles = mapMixedAmountUnsafe (styleAmounts styles)
 
-instance HasAmounts Account where
-  styleAmounts styles acct@Account{aebalance,aibalance} =
-    acct{aebalance=styleAmounts styles aebalance, aibalance=styleAmounts styles aibalance}
+instance HasAmounts BalanceData where
+  styleAmounts styles balance@BalanceData{bdexcludingsubs,bdincludingsubs} =
+    balance{bdexcludingsubs=styleAmounts styles bdexcludingsubs, bdincludingsubs=styleAmounts styles bdincludingsubs}
+
+instance HasAmounts a => HasAmounts (PeriodData a) where
+  styleAmounts styles = fmap (styleAmounts styles)
+
+instance HasAmounts a => HasAmounts (Account a) where
+  styleAmounts styles acct@Account{adata} =
+    acct{adata = styleAmounts styles <$> adata}
 
 -- | Reset each individual amount's display style to the default.
 mixedAmountUnstyled :: MixedAmount -> MixedAmount

hledger-lib/Hledger/Data/BalanceData.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE CPP #-}
+{-|
+
+
+A 'BalanceData is a data type tracking a number of postings, exclusive, and inclusive balance
+for given date ranges.
+
+-}
+module Hledger.Data.BalanceData
+( mapBalanceData
+, opBalanceData
+
+, tests_BalanceData
+) where
+
+
+import Test.Tasty (testGroup)
+import Test.Tasty.HUnit ((@?=), testCase)
+
+import Hledger.Data.Amount
+import Hledger.Data.Types
+
+
+instance Show BalanceData where
+  showsPrec d (BalanceData e i n) =
+    showParen (d > 10) $
+        showString "BalanceData"
+      . showString "{ bdexcludingsubs = " . showString (wbUnpack (showMixedAmountB defaultFmt e))
+      . showString ", bdincludingsubs = " . showString (wbUnpack (showMixedAmountB defaultFmt i))
+      . showString ", bdnumpostings = " . shows n
+      . showChar '}'
+
+instance Semigroup BalanceData where
+  BalanceData e i n <> BalanceData e' i' n' = BalanceData (maPlus e e') (maPlus i i') (n + n')
+
+instance Monoid BalanceData where
+  mempty = BalanceData nullmixedamt nullmixedamt 0
+
+-- | Apply an operation to both 'MixedAmount' in an 'BalanceData'.
+mapBalanceData :: (MixedAmount -> MixedAmount) -> BalanceData -> BalanceData
+mapBalanceData f a = a{bdexcludingsubs = f $ bdexcludingsubs a, bdincludingsubs = f $ bdincludingsubs a}
+
+-- | Merge two 'BalanceData', using the given operation to combine their amounts.
+opBalanceData :: (MixedAmount -> MixedAmount -> MixedAmount) -> BalanceData -> BalanceData -> BalanceData
+opBalanceData f a b = a{bdexcludingsubs = f (bdexcludingsubs a) (bdexcludingsubs b), bdincludingsubs = f (bdincludingsubs a) (bdincludingsubs b)}
+
+
+-- tests
+
+tests_BalanceData = testGroup "BalanceData" [
+
+  testCase "opBalanceData maPlus" $ do
+    opBalanceData maPlus (BalanceData (mixed [usd 1]) (mixed [usd 2]) 5) (BalanceData (mixed [usd 3]) (mixed [usd 4]) 0)
+      @?= BalanceData (mixed [usd 4]) (mixed [usd 6]) 5,
+
+  testCase "opBalanceData maMinus" $ do
+    opBalanceData maMinus (BalanceData (mixed [usd 1]) (mixed [usd 2]) 5) (BalanceData (mixed [usd 3]) (mixed [usd 4]) 0)
+      @?= BalanceData (mixed [usd (-2)]) (mixed [usd (-2)]) 5
+  ]

hledger-lib/Hledger/Data/Journal.hs

@@ -56,7 +56,6 @@ module Hledger.Data.Journal (
   journalAccountNamesDeclared,
   journalAccountNamesDeclaredOrUsed,
   journalAccountNamesDeclaredOrImplied,
-  journalLeafAccountNamesDeclared,
   journalAccountNames,
   journalLeafAccountNames,
   journalAccountNameTree,
@@ -463,11 +462,6 @@ journalAccountNamesImplied = expandAccountNames . journalAccountNamesUsed
 journalAccountNamesDeclared :: Journal -> [AccountName]
 journalAccountNamesDeclared = nubSort . map fst . jdeclaredaccounts
 
--- | Sorted unique account names declared by account directives in this journal,
--- which have no children.
-journalLeafAccountNamesDeclared :: Journal -> [AccountName]
-journalLeafAccountNamesDeclared = treeLeaves . accountNameTreeFrom . journalAccountNamesDeclared
-
 -- | Sorted unique account names declared by account directives or posted to
 -- by transactions in this journal.
 journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName]

hledger-lib/Hledger/Data/Json.hs

@@ -22,9 +22,11 @@ import           Data.Aeson.Encode.Pretty (Config(..), Indent(..), NumberFormat(
 --import           Data.Aeson.TH
 import qualified Data.ByteString.Lazy as BL
 import           Data.Decimal (DecimalRaw(..), roundTo)
+import qualified Data.IntMap as IM
 import           Data.Maybe (fromMaybe)
 import qualified Data.Text.Lazy    as TL
 import qualified Data.Text.Lazy.Builder as TB
+import           Data.Time (Day(..))
 import           Text.Megaparsec (Pos, SourcePos, mkPos, unPos)
 
 import           Hledger.Data.Types
@@ -155,24 +157,27 @@ instance ToJSON TimeclockCode
 instance ToJSON TimeclockEntry
 instance ToJSON Journal
 
-instance ToJSON Account where
+instance ToJSON BalanceData
+instance ToJSON a => ToJSON (PeriodData a) where
+  toJSON a = object
+    [ "pdpre" .= pdpre a
+    , "pdperiods" .= map (\(d, x) -> (ModifiedJulianDay (toInteger d), x)) (IM.toList $ pdperiods a)
+    ]
+
+instance ToJSON a => ToJSON (Account a) where
   toJSON = object . accountKV
   toEncoding = pairs . mconcat . accountKV
 
 accountKV ::
 #if MIN_VERSION_aeson(2,2,0)
-  KeyValue e kv
+  (KeyValue e kv, ToJSON a)
 #else
-  KeyValue kv
+  (KeyValue kv, ToJSON a)
 #endif
-  => Account -> [kv]
+  => Account a -> [kv]
 accountKV a =
     [ "aname"            .= aname a
     , "adeclarationinfo" .= adeclarationinfo a
-    , "aebalance"        .= aebalance a
-    , "aibalance"        .= aibalance a
-    , "anumpostings"     .= anumpostings a
-    , "aboring"          .= aboring a
     -- To avoid a cycle, show just the parent account's name
     -- in a dummy field. When re-parsed, there will be no parent.
     , "aparent_"         .= maybe "" aname (aparent a)
@@ -181,7 +186,9 @@ accountKV a =
     -- The actual subaccounts (and their subs..), making a (probably highly redundant) tree
     -- ,"asubs"        .= asubs a
     -- Omit the actual subaccounts
-    , "asubs"            .= ([]::[Account])
+    , "asubs"            .= ([]::[Account BalanceData])
+    , "aboring"          .= aboring a
+    , "adata"            .= adata a
     ]
 
 instance ToJSON Ledger
@@ -215,10 +222,17 @@ instance FromJSON PostingType
 instance FromJSON Posting
 instance FromJSON Transaction
 instance FromJSON AccountDeclarationInfo
+
+instance FromJSON BalanceData
+instance FromJSON a => FromJSON (PeriodData a) where
+  parseJSON = withObject "PeriodData" $ \v -> PeriodData
+    <$> v .: "pdpre"
+    <*> (IM.fromList . map (\(d, x) -> (fromInteger $ toModifiedJulianDay d, x)) <$> v .: "pdperiods")
+
 -- XXX The ToJSON instance replaces subaccounts with just names.
 -- Here we should try to make use of those to reconstruct the
 -- parent-child relationships.
-instance FromJSON Account
+instance FromJSON a => FromJSON (Account a)
 
 -- Decimal, various attempts
 --

hledger-lib/Hledger/Data/Ledger.hs

@@ -32,6 +32,7 @@ import Test.Tasty (testGroup)
 import Test.Tasty.HUnit ((@?=), testCase)
 import Hledger.Data.Types
 import Hledger.Data.Account
+import Hledger.Data.Dates (nulldate)
 import Hledger.Data.Journal
 import Hledger.Query
 
@@ -61,7 +62,8 @@ ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as}
     (q',depthq)  = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q)
     j'  = filterJournalAmounts (filterQuery queryIsSym q) $ -- remove amount parts which the query's sym: terms would exclude
           filterJournalPostings q' j
-    as  = accountsFromPostings $ journalPostings j'
+    -- Ledger does not use date-separated balances, so dates are left empty
+    as  = accountsFromPostings (const $ Just nulldate) $ journalPostings j'
     j'' = filterJournalPostings depthq j'
 
 -- | List a ledger's account names.
@@ -69,21 +71,21 @@ ledgerAccountNames :: Ledger -> [AccountName]
 ledgerAccountNames = drop 1 . map aname . laccounts
 
 -- | Get the named account from a ledger.
-ledgerAccount :: Ledger -> AccountName -> Maybe Account
+ledgerAccount :: Ledger -> AccountName -> Maybe (Account BalanceData)
 ledgerAccount l a = lookupAccount a $ laccounts l
 
 -- | Get this ledger's root account, which is a dummy "root" account
 -- above all others. This should always be first in the account list,
 -- if somehow not this returns a null account.
-ledgerRootAccount :: Ledger -> Account
+ledgerRootAccount :: Ledger -> Account BalanceData
 ledgerRootAccount = headDef nullacct . laccounts
 
 -- | List a ledger's top-level accounts (the ones below the root), in tree order.
-ledgerTopAccounts :: Ledger -> [Account]
+ledgerTopAccounts :: Ledger -> [Account BalanceData]
 ledgerTopAccounts = asubs . headDef nullacct . laccounts
 
 -- | List a ledger's bottom-level (subaccount-less) accounts, in tree order.
-ledgerLeafAccounts :: Ledger -> [Account]
+ledgerLeafAccounts :: Ledger -> [Account BalanceData]
 ledgerLeafAccounts = filter (null.asubs) . laccounts
 
 -- | List a ledger's postings, in the order parsed.

hledger-lib/Hledger/Data/PeriodData.hs

@@ -0,0 +1,121 @@
+{-# LANGUAGE CPP #-}
+{-|
+
+
+Data values for zero or more report periods, and for the pre-report period.
+Report periods are assumed to be contiguous, and represented only by start dates
+(as keys of an IntMap).
+
+-}
+module Hledger.Data.PeriodData
+( periodDataFromList
+
+, lookupPeriodData
+, insertPeriodData
+, opPeriodData
+, mergePeriodData
+, padPeriodData
+
+, tests_PeriodData
+) where
+
+import Data.Foldable1 (Foldable1(..))
+import qualified Data.IntMap.Strict as IM
+import qualified Data.IntSet as IS
+#if !MIN_VERSION_base(4,20,0)
+import Data.List (foldl')
+#endif
+import Data.Time (Day(..), fromGregorian)
+
+import Test.Tasty (testGroup)
+import Test.Tasty.HUnit ((@?=), testCase)
+
+import Hledger.Data.Amount
+import Hledger.Data.Types
+
+
+instance Show a => Show (PeriodData a) where
+  showsPrec d (PeriodData h ds) =
+    showParen (d > 10) $
+        showString "PeriodData"
+      . showString "{ pdpre = " . shows h
+      . showString ", pdperiods = "
+      . showString "fromList " . shows (map (\(day, x) -> (ModifiedJulianDay $ toInteger day, x)) $ IM.toList ds)
+      . showChar '}'
+
+instance Foldable PeriodData where
+  foldr f z (PeriodData h as) = foldr f (f h z) as
+  foldl f z (PeriodData h as) = foldl f (f z h) as
+  foldl' f z (PeriodData h as) = let fzh = f z h in fzh `seq` foldl' f fzh as
+
+instance Foldable1 PeriodData where
+  foldrMap1 f g (PeriodData h as) = foldr g (f h) as
+  foldlMap1 f g (PeriodData h as) = foldl g (f h) as
+  foldlMap1' f g (PeriodData h as) = let fh = f h in fh `seq` foldl' g fh as
+
+instance Traversable PeriodData where
+  traverse f (PeriodData h as) = liftA2 PeriodData (f h) $ traverse f as
+
+-- | The Semigroup instance for 'AccountBalance' will simply take the union of
+-- keys in the date map section. This may not be the result you want if the
+-- keys are not identical.
+instance Semigroup a => Semigroup (PeriodData a) where
+  PeriodData h1 as1 <> PeriodData h2 as2 = PeriodData (h1 <> h2) $ IM.unionWith (<>) as1 as2
+
+instance Monoid a => Monoid (PeriodData a) where
+  mempty = PeriodData mempty mempty
+
+-- | Construct an 'PeriodData' from a list.
+periodDataFromList :: a -> [(Day, a)] -> PeriodData a
+periodDataFromList h = PeriodData h . IM.fromList . map (\(d, a) -> (fromInteger $ toModifiedJulianDay d, a))
+
+-- | Get account balance information to the period containing a given 'Day'.
+lookupPeriodData :: Day -> PeriodData a -> a
+lookupPeriodData d (PeriodData h as) =
+    maybe h snd $ IM.lookupLE (fromInteger $ toModifiedJulianDay d) as
+
+-- | Add account balance information to the appropriate location in 'PeriodData'.
+insertPeriodData :: Semigroup a => Maybe Day -> a -> PeriodData a -> PeriodData a
+insertPeriodData mday b balances = case mday of
+    Nothing  -> balances{pdpre = pdpre balances <> b}
+    Just day -> balances{pdperiods = IM.insertWith (<>) (fromInteger $ toModifiedJulianDay day) b $ pdperiods balances}
+
+-- | Merges two 'PeriodData', using the given operation to combine their balance information.
+--
+-- This will drop keys if they are not present in both 'PeriodData'.
+opPeriodData :: (a -> b -> c) -> PeriodData a -> PeriodData b -> PeriodData c
+opPeriodData f (PeriodData h1 as1) (PeriodData h2 as2) =
+    PeriodData (f h1 h2) $ IM.intersectionWith f as1 as2
+
+-- | Merges two 'PeriodData', using the given operations for balance
+-- information only in the first, only in the second, or in both
+-- 'PeriodData', respectively.
+mergePeriodData :: (a -> c) -> (b -> c) -> (a -> b -> c)
+                -> PeriodData a -> PeriodData b -> PeriodData c
+mergePeriodData only1 only2 f = \(PeriodData h1 as1) (PeriodData h2 as2) ->
+    PeriodData (f h1 h2) $ merge as1 as2
+  where
+    merge = IM.mergeWithKey (\_ x y -> Just $ f x y) (fmap only1) (fmap only2)
+
+-- | Pad out the datemap of an 'PeriodData' so that every key from a set is present.
+padPeriodData :: Monoid a => IS.IntSet -> PeriodData a -> PeriodData a
+padPeriodData keys bal = bal{pdperiods = pdperiods bal <> IM.fromSet (const mempty) keys}
+
+
+-- tests
+
+tests_PeriodData =
+  let
+    dayMap  = periodDataFromList (mixed [usd 1]) [(fromGregorian 2000 01 01, mixed [usd 2]), (fromGregorian 2004 02 28, mixed [usd 3])]
+    dayMap2 = periodDataFromList (mixed [usd 2]) [(fromGregorian 2000 01 01, mixed [usd 4]), (fromGregorian 2004 02 28, mixed [usd 6])]
+  in testGroup "PeriodData" [
+
+  testCase "periodDataFromList" $ do
+    length dayMap @?= 3,
+
+  testCase "Semigroup instance" $ do
+    dayMap <> dayMap @?= dayMap2,
+
+  testCase "Monoid instance" $ do
+    dayMap <> mempty @?= dayMap
+  ]

hledger-lib/Hledger/Data/Types.hs

@@ -18,6 +18,7 @@ For more detailed documentation on each type, see the corresponding modules.
 
 -- {-# LANGUAGE DeriveAnyClass #-}  -- https://hackage.haskell.org/package/deepseq-1.4.4.0/docs/Control-DeepSeq.html#v:rnf
 {-# LANGUAGE CPP        #-}
+{-# LANGUAGE DeriveFunctor        #-}
 {-# LANGUAGE DeriveGeneric        #-}
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE OverloadedStrings    #-}
@@ -39,6 +40,7 @@ import Data.Bifunctor (first)
 import Data.Decimal (Decimal, DecimalRaw(..))
 import Data.Default (Default(..))
 import Data.Functor (($>))
+import qualified Data.IntMap.Strict as IM
 import Data.List (intercalate, sortBy)
 --XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html
 --Note: You should use Data.Map.Strict instead of this module if:
@@ -733,20 +735,36 @@ nullaccountdeclarationinfo = AccountDeclarationInfo {
   ,adisourcepos        = SourcePos "" (mkPos 1) (mkPos 1)
 }
 
--- | An account, with its balances, parent/subaccount relationships, etc.
--- Only the name is required; the other fields are added when needed.
-data Account = Account {
-   aname                     :: AccountName    -- ^ this account's full name
+-- | An account within a hierarchy, with references to its parent
+-- and subaccounts if any, and with per-report-period data of type 'a'.
+-- Only the name is required; the other fields may or may not be present.
+data Account a = Account {
+   aname                     :: AccountName        -- ^ full name
   ,adeclarationinfo          :: Maybe AccountDeclarationInfo  -- ^ optional extra info from account directives
   -- relationships in the tree
-  ,asubs                     :: [Account]      -- ^ this account's sub-accounts
-  ,aparent                   :: Maybe Account  -- ^ parent account
-  ,aboring                   :: Bool           -- ^ used in the accounts report to label elidable parents
-  -- balance information
-  ,anumpostings              :: Int            -- ^ the number of postings to this account
-  ,aebalance                 :: MixedAmount    -- ^ this account's balance, excluding subaccounts
-  ,aibalance                 :: MixedAmount    -- ^ this account's balance, including subaccounts
-  } deriving (Generic)
+  ,asubs                     :: [Account a]        -- ^ subaccounts
+  ,aparent                   :: Maybe (Account a)  -- ^ parent account
+  ,aboring                   :: Bool               -- ^ used in some reports to indicate elidable accounts
+  ,adata                     :: PeriodData a       -- ^ associated data per report period
+  } deriving (Generic, Functor)
+
+-- | Data values for zero or more report periods, and for the pre-report period.
+-- Report periods are assumed to be contiguous, and represented only by start dates
+-- (as keys of an IntMap). XXX how does that work, again ?
+data PeriodData a = PeriodData {
+   pdpre     :: a            -- ^ data from the pre-report period (e.g. historical balances)
+  ,pdperiods :: IM.IntMap a  -- ^ data for the periods
+  } deriving (Eq, Functor, Generic)
+
+-- | Data that's useful in "balance" reports:
+-- subaccount-exclusive and -inclusive amounts,
+-- typically representing either a balance change or an end balance;
+-- and a count of postings.
+data BalanceData = BalanceData {
+   bdexcludingsubs :: MixedAmount  -- ^ balance data excluding subaccounts
+  ,bdincludingsubs :: MixedAmount  -- ^ balance data including subaccounts
+  ,bdnumpostings :: Int            -- ^ the number of postings
+  } deriving (Eq, Generic)
 
 -- | Whether an account's balance is normally a positive number (in
 -- accounting terms, a debit balance) or a negative number (credit balance).
@@ -761,7 +779,7 @@ data NormalSign = NormallyPositive | NormallyNegative deriving (Show, Eq)
 -- account is the root of the tree and always exists.
 data Ledger = Ledger {
    ljournal  :: Journal
-  ,laccounts :: [Account]
+  ,laccounts :: [Account BalanceData]
   } deriving (Generic)
 
 instance NFData AccountAlias

hledger-lib/Hledger/Reports/BudgetReport.hs

@@ -9,23 +9,22 @@ module Hledger.Reports.BudgetReport (
   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 Control.Monad ((>=>))
+import Data.Bifunctor (bimap)
+import Data.Foldable (toList)
+import Data.List (find, maximumBy, intercalate)
 import Data.List.Extra (nubSort)
-import Data.Maybe (fromMaybe, isJust)
-import Data.Map (Map)
-import qualified Data.Map as Map
+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 Safe (minimumDef)
 
 import Hledger.Data
@@ -33,8 +32,6 @@ 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
@@ -69,7 +66,9 @@ budgetReport rspec bopts reportspan j = dbg4 "sortedbudgetreport" budgetreport
     -- 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 = (_rsReportOpts rspec){ accountlistmode_ = ALTree }
+    -- ropts = _rsReportOpts rspec
     showunbudgeted = empty_ ropts
+
     budgetedaccts =
       dbg3 "budgetedacctsinperiod" $
       S.fromList $
@@ -78,21 +77,59 @@ budgetReport rspec bopts reportspan j = dbg4 "sortedbudgetreport" budgetreport
       concatMap tpostings $
       concatMap (\pt -> runPeriodicTransaction False pt reportspan) $
       jperiodictxns j
+
     actualj = journalWithBudgetAccountNames budgetedaccts showunbudgeted j
     budgetj = journalAddBudgetGoalTransactions bopts ropts reportspan j
     priceoracle = journalPriceOracle (infer_prices_ ropts) j
-    budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) =
-        dbg5 "budgetgoalreport" $ multiBalanceReportWith rspec{_rsReportOpts=ropts{empty_=True}} budgetj priceoracle mempty
-    budgetedacctsseen = S.fromList $ map prrFullName budgetgoalitems
-    actualreport@(PeriodicReport actualspans _ _) =
-        dbg5 "actualreport"     $ multiBalanceReportWith rspec{_rsReportOpts=ropts{empty_=True}} actualj priceoracle budgetedacctsseen
-    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.
-      | interval_ ropts == NoInterval = PeriodicReport actualspans budgetgoalitems budgetgoaltotals
-      | otherwise = budgetgoalreport
-    budgetreport = combineBudgetAndActual ropts j budgetgoalreport' actualreport
+
+    (_, actualspans) = dbg5 "actualspans" $ reportSpan actualj rspec
+    (_, budgetspans) = dbg5 "budgetspans" $ reportSpan budgetj rspec
+    allspans = case interval_ 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.
+        NoInterval -> actualspans
+        _          -> nubSort . filter (/= nulldatespan) $ actualspans ++ budgetspans
+
+    actualps = dbg5 "actualps" $ getPostings rspec actualj priceoracle reportspan
+    budgetps = dbg5 "budgetps" $ getPostings rspec budgetj priceoracle reportspan
+
+    actualAcct = dbg5 "actualAcct" $ generateMultiBalanceAccount rspec actualj priceoracle actualspans actualps
+    budgetAcct = dbg5 "budgetAcct" $ generateMultiBalanceAccount rspec budgetj priceoracle budgetspans budgetps
+
+    combinedAcct = dbg5 "combinedAcct" $ if null budgetps
+        -- If no budget postings, just use actual account, to avoid unnecssary budget zeros
+        then This <$> actualAcct
+        else mergeAccounts actualAcct budgetAcct
+
+    budgetreport = generateBudgetReport ropts allspans 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 -> [DateSpan] -> Account (These BalanceData BalanceData) -> BudgetReport
+generateBudgetReport = generatePeriodicReport makeBudgetReportRow treeActualBalance flatActualBalance
+  where
+    treeActualBalance = these bdincludingsubs (const nullmixedamt) (const . bdincludingsubs)
+    flatActualBalance = fromMaybe nullmixedamt . 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 ropts balance =
+    makePeriodicReportRow (Just nullmixedamt, Nothing) avg ropts (theseToMaybe . bimap balance balance)
+  where
+    avg xs = ((actualtotal, budgettotal), (actualavg, budgetavg))
+      where
+        (actuals, budgets) = unzip $ toList xs
+        (actualtotal, actualavg) = bimap Just Just . sumAndAverageMixedAmounts $ catMaybes actuals
+        (budgettotal, budgetavg) = bimap Just Just . sumAndAverageMixedAmounts $ catMaybes budgets
+
+    theseToMaybe (This a) = (Just a, Nothing)
+    theseToMaybe (That b) = (Just nullmixedamt, Just b)
+    theseToMaybe (These a b) = (Just a, Just 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
@@ -179,81 +216,6 @@ journalWithBudgetAccountNames budgetedaccts showunbudgeted j =
         budgetedparent = find (`S.member` budgetedaccts) $ parentAccountNames a
         u = 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 ropts j
-      (PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ budgettots budgetgrandtot budgetgrandavg))
-      (PeriodicReport actualperiods actualrows (PeriodicReportRow _ actualtots actualgrandtot actualgrandavg)) =
-    PeriodicReport periods combinedrows totalrow
-  where
-    periods = nubSort . filter (/= nulldatespan) $ budgetperiods ++ actualperiods
-
-    -- first, combine any corresponding budget goals with actual changes
-    actualsplusgoals = [
-        -- dbg0With (("actualsplusgoals: "<>)._brrShowDebug) $
-        PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal
-      | PeriodicReportRow acct actualamts actualtot actualavg <- actualrows
-
-      , let mbudgetgoals       = HM.lookup (displayFull acct) budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage)
-      , let budgetmamts        = maybe (Nothing <$ periods) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal]
-      , let mbudgettot         = second3 <$> mbudgetgoals :: Maybe BudgetTotal
-      , let mbudgetavg         = third3 <$> mbudgetgoals  :: Maybe BudgetAverage
-      , let acctGoalByPeriod   = 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 acctGoalByPeriod) | p <- periods ] :: [BudgetCell]
-      , let totamtandgoal      = (Just actualtot, mbudgettot)
-      , let avgamtandgoal      = (Just actualavg, mbudgetavg)
-      ]
-      where
-        budgetGoalsByAcct :: HashMap AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) =
-          HM.fromList [ (displayFull acct, (amts, tot, avg))
-                      | PeriodicReportRow acct amts tot avg <-
-                          -- dbg0With (unlines.map (("budgetgoals: "<>).prrShowDebug)) $
-                          budgetrows
-                      ]
-
-    -- next, make rows for budget goals with no actual changes
-    othergoals = [
-        -- dbg0With (("othergoals: "<>)._brrShowDebug) $
-        PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal
-      | PeriodicReportRow acct budgetgoals budgettot budgetavg <- budgetrows
-      , displayFull acct `notElem` map prrFullName actualsplusgoals
-      , let acctGoalByPeriod   = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal
-      , let amtandgoals        = [ (Just 0, Map.lookup p acctGoalByPeriod) | p <- periods ] :: [BudgetCell]
-      , let totamtandgoal      = (Just 0, Just budgettot)
-      , let avgamtandgoal      = (Just 0, Just budgetavg)
-      ]
-
-    -- combine and re-sort rows
-    -- TODO: add --sort-budget to sort by budget goal amount
-    combinedrows :: [BudgetReportRow] =
-      -- map (dbg0With (("combinedrows: "<>)._brrShowDebug)) $
-      sortRowsLike (mbrsorted unbudgetedrows ++ mbrsorted rows') rows
-      where
-        (unbudgetedrows, rows') = partition ((==unbudgetedAccountName) . prrFullName) rows
-        mbrsorted = map prrFullName . sortRows ropts j . map (fmap $ fromMaybe nullmixedamt . fst)
-        rows = actualsplusgoals ++ othergoals
-
-    totalrow = PeriodicReportRow ()
-        [ (Map.lookup p totActualByPeriod, Map.lookup p totGoalByPeriod) | p <- periods ]
-        ( Just actualgrandtot, budget budgetgrandtot )
-        ( Just actualgrandavg, budget budgetgrandavg )
-      where
-        totGoalByPeriod = Map.fromList $ zip budgetperiods budgettots :: Map DateSpan BudgetTotal
-        totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change
-        budget b = if mixedAmountLooksZero b then Nothing else Just b
 
 -- tests
 

hledger-lib/Hledger/Reports/MultiBalanceReport.hs

@@ -1,8 +1,10 @@
 {-# LANGUAGE FlexibleInstances   #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE NamedFieldPuns   #-}
+{-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections       #-}
 {-|
 
 Multi-column balance reports, used by the balance command.
@@ -19,15 +21,12 @@ module Hledger.Reports.MultiBalanceReport (
   compoundBalanceReport,
   compoundBalanceReportWith,
 
-  sortRows,
-  sortRowsLike,
-
   -- * Helper functions
   makeReportQuery,
-  getPostingsByColumn,
   getPostings,
-  startingPostings,
-  generateMultiBalanceReport,
+  generateMultiBalanceAccount,
+  generatePeriodicReport,
+  makePeriodicReportRow,
 
   -- -- * Tests
   tests_MultiBalanceReport
@@ -35,21 +34,18 @@ module Hledger.Reports.MultiBalanceReport (
 where
 
 import Control.Monad (guard)
-import Data.Bifunctor (second)
 import Data.Foldable (toList)
-import Data.List (sortOn, transpose)
+import Data.List (sortOn)
 import Data.List.NonEmpty (NonEmpty((:|)))
-import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HM
-import Data.Map (Map)
-import qualified Data.Map as M
+import qualified Data.HashSet as HS
+import qualified Data.IntMap.Strict as IM
+import qualified Data.IntSet as IS
 import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import Data.Ord (Down(..))
 import Data.Semigroup (sconcat)
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Data.Time.Calendar (fromGregorian)
-import Safe (lastDef, minimumMay)
+import Data.These (these)
+import Data.Time.Calendar (Day(..), addDays, fromGregorian)
+import Data.Traversable (mapAccumL)
 
 import Hledger.Data
 import Hledger.Query
@@ -86,9 +82,6 @@ dbg5 s = let p = "multiBalanceReport" in Hledger.Utils.dbg5 (p++" "++s)
 type MultiBalanceReport    = PeriodicReport    DisplayName MixedAmount
 type MultiBalanceReportRow = PeriodicReportRow DisplayName MixedAmount
 
--- type alias just to remind us which AccountNames might be depth-clipped, below.
-type ClippedAccountName = AccountName
-
 
 -- | Generate a multicolumn balance report for the matched accounts,
 -- showing the change of balance, accumulated balance, or historical balance
@@ -98,7 +91,7 @@ type ClippedAccountName = AccountName
 -- by the balance command (in multiperiod mode) and (via compoundBalanceReport)
 -- by the bs/cf/is commands.
 multiBalanceReport :: ReportSpec -> Journal -> MultiBalanceReport
-multiBalanceReport rspec j = multiBalanceReportWith rspec j (journalPriceOracle infer j) mempty
+multiBalanceReport rspec j = multiBalanceReportWith rspec j (journalPriceOracle infer j)
   where infer = infer_prices_ $ _rsReportOpts rspec
 
 -- | A helper for multiBalanceReport. This one takes some extra arguments,
@@ -106,26 +99,23 @@ multiBalanceReport rspec j = multiBalanceReportWith rspec j (journalPriceOracle
 -- 'AccountName's which should not be elided. Commands which run multiple
 -- reports (bs etc.) can generate the price oracle just once for efficiency,
 -- passing it to each report by calling this function directly.
-multiBalanceReportWith :: ReportSpec -> Journal -> PriceOracle -> Set AccountName -> MultiBalanceReport
-multiBalanceReportWith rspec' j priceoracle unelidableaccts = report
+multiBalanceReportWith :: ReportSpec -> Journal -> PriceOracle -> MultiBalanceReport
+multiBalanceReportWith rspec' j priceoracle = report
   where
     -- Queries, report/column dates.
-    (reportspan, colspans) = reportSpan j rspec'
+    (reportspan, colspans) = dbg5 "reportSpan" $ reportSpan j rspec'
     rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan
     -- force evaluation order to show price lookup after date spans in debug output (XXX not working)
     -- priceoracle = reportspan `seq` priceoracle0
 
-    -- Group postings into their columns.
-    colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle colspans
+    -- Get postings
+    ps = dbg5 "ps" $ getPostings rspec j priceoracle reportspan
 
-    -- The matched accounts with a starting balance. All of these should appear
-    -- in the report, even if they have no postings during the report period.
-    startbals = dbg5 "startbals" $
-      startingBalances rspec j priceoracle $ startingPostings rspec j priceoracle reportspan
+    -- Process changes into normal, cumulative, or historical amounts, plus value them and mark which are uninteresting
+    acct = dbg5 "acct" $ generateMultiBalanceAccount rspec j priceoracle colspans ps
 
     -- Generate and postprocess the report, negating balances and taking percentages if needed
-    report = dbg4 "multiBalanceReportWith" $
-      generateMultiBalanceReport rspec j priceoracle unelidableaccts colps startbals
+    report = dbg4 "multiBalanceReportWith" $ generateMultiBalanceReport (_rsReportOpts rspec) colspans acct
 
 -- | Generate a compound balance report from a list of CBCSubreportSpec. This
 -- shares postings between the subreports.
@@ -141,23 +131,18 @@ compoundBalanceReportWith :: ReportSpec -> Journal -> PriceOracle
 compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
   where
     -- Queries, report/column dates.
-    (reportspan, colspans) = reportSpan j rspec'
+    (reportspan, colspans) = dbg5 "reportSpan" $ reportSpan j rspec'
     rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan
 
-    -- Group postings into their columns.
-    colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle colspans
-
-    -- The matched postings with a starting balance. All of these should appear
-    -- in the report, even if they have no postings during the report period.
-    startps = dbg5 "startps" $ startingPostings rspec j priceoracle reportspan
+    -- Get postings
+    ps = dbg5 "ps" $ getPostings rspec j priceoracle reportspan
 
     subreports = map generateSubreport subreportspecs
       where
         generateSubreport CBCSubreportSpec{..} =
             ( cbcsubreporttitle
             -- Postprocess the report, negating balances and taking percentages if needed
-            , cbcsubreporttransform $
-                generateMultiBalanceReport rspecsub j priceoracle mempty colps' startbals'
+            , cbcsubreporttransform $ generateMultiBalanceReport ropts colspans acct
             , cbcsubreportincreasestotal
             )
           where
@@ -165,10 +150,9 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
             -- Add a restriction to this subreport to the report query.
             -- XXX in non-thorough way, consider updateReportSpec ?
             rspecsub = rspec{_rsReportOpts=ropts, _rsQuery=And [cbcsubreportquery, _rsQuery rspec]}
-            -- Starting balances and column postings specific to this subreport.
-            startbals' = startingBalances rspecsub j priceoracle $
-              filter (matchesPostingExtra (journalAccountType j) cbcsubreportquery) startps
-            colps' = map (second $ filter (matchesPostingExtra (journalAccountType j) cbcsubreportquery)) colps
+            -- Account representing this subreport
+            acct = generateMultiBalanceAccount rspecsub j priceoracle colspans $
+                     filter (matchesPostingExtra (journalAccountType j) cbcsubreportquery) ps
 
     -- Sum the subreport totals by column. Handle these cases:
     -- - no subreports
@@ -181,47 +165,8 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
         subreportTotal (_, sr, increasestotal) =
             (if increasestotal then id else fmap maNegate) $ prTotals sr
 
-    cbr = CompoundPeriodicReport "" (map fst colps) subreports overalltotals
+    cbr = CompoundPeriodicReport "" colspans subreports overalltotals
 
--- XXX seems refactorable
--- | Calculate accounts' balances on the report start date, from these postings
--- which should be all postings before that date, and possibly also from account declarations.
-startingBalances :: ReportSpec -> Journal -> PriceOracle -> [Posting]
-                             -> HashMap AccountName Account
-startingBalances rspec j priceoracle ps =
-    M.findWithDefault nullacct emptydatespan
-      <$> calculateReportMatrix rspec j priceoracle mempty [(emptydatespan, ps)]
-
--- | Postings needed to calculate starting balances.
---
--- Balances at report start date, from all earlier postings which otherwise match the query.
--- These balances are unvalued.
--- TODO: Do we want to check whether to bother calculating these? isHistorical
--- and startDate is not nothing, otherwise mempty? This currently gives a
--- failure with some totals which are supposed to be 0 being blank.
-startingPostings :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> [Posting]
-startingPostings rspec@ReportSpec{_rsQuery=query,_rsReportOpts=ropts} j priceoracle reportspan =
-    getPostings rspec' j priceoracle
-  where
-    rspec' = rspec{_rsQuery=startbalq,_rsReportOpts=ropts'}
-    -- If we're re-valuing every period, we need to have the unvalued start
-    -- balance, so we can do it ourselves later.
-    ropts' = case value_ ropts of
-        Just (AtEnd _) -> ropts{period_=precedingperiod, value_=Nothing}
-        _              -> ropts{period_=precedingperiod}
-
-    -- q projected back before the report start date.
-    -- When there's no report start date, in case there are future txns (the hledger-ui case above),
-    -- we use emptydatespan to make sure they aren't counted as starting balance.
-    startbalq = dbg3 "startbalq" $ And [datelessq, precedingspanq]
-    datelessq = dbg3 "datelessq" $ filterQuery (not . queryIsDateOrDate2) query
-
-    precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan .
-                         periodAsDateSpan $ period_ ropts
-    precedingspan = DateSpan Nothing (Exact <$> spanStart reportspan)
-    precedingspanq = (if date2_ ropts then Date2 else Date) $ case precedingspan of
-        DateSpan Nothing Nothing -> emptydatespan
-        a -> a
 
 -- | Remove any date queries and insert queries from the report span.
 -- The user's query expanded to the report span
@@ -237,82 +182,97 @@ makeReportQuery rspec reportspan
     dateless         = dbg3 "dateless" . filterQuery (not . queryIsDateOrDate2)
     dateqcons        = if date2_ (_rsReportOpts rspec) then Date2 else Date
 
--- | Group postings, grouped by their column
-getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> [DateSpan] -> [(DateSpan, [Posting])]
-getPostingsByColumn rspec j priceoracle colspans =
-    groupByDateSpan True getDate colspans ps
-  where
-    -- Postings matching the query within the report period.
-    ps = dbg5 "getPostingsByColumn" $ getPostings rspec j priceoracle
-    -- The date spans to be included as report columns.
-    getDate = postingDateOrDate2 (whichDate (_rsReportOpts rspec))
-
 -- | Gather postings matching the query within the report period.
-getPostings :: ReportSpec -> Journal -> PriceOracle -> [Posting]
-getPostings rspec@ReportSpec{_rsQuery=query, _rsReportOpts=ropts} j priceoracle =
-    journalPostings $ journalValueAndFilterPostingsWith rspec' j priceoracle
+getPostings :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> [Posting]
+getPostings rspec@ReportSpec{_rsQuery=query, _rsReportOpts=ropts} j priceoracle reportspan =
+    map clipPosting
+    . setPostingsCount
+    . journalPostings
+    $ journalValueAndFilterPostingsWith rspec' j priceoracle
   where
-    rspec' = rspec{_rsQuery=depthless, _rsReportOpts = ropts'}
+    -- Clip posting names to the requested depth
+    clipPosting p = p{paccount = clipOrEllipsifyAccountName depthSpec $ paccount p}
+
+    -- If doing --count, set all posting amounts to "1".
+    setPostingsCount = case balancecalc_ ropts of
+        CalcPostingsCount -> map (postingTransformAmount (const $ mixed [num 1]))
+        _                 -> id
+
+    rspec' = rspec{_rsQuery=fullreportq,_rsReportOpts=ropts'}
+    -- If we're re-valuing every period, we need to have the unvalued start
+    -- balance, so we can do it ourselves later.
     ropts' = if isJust (valuationAfterSum ropts)
-        then ropts{value_=Nothing, conversionop_=Just NoConversionOp}  -- If we're valuing after the sum, don't do it now
-        else ropts
+        then ropts{period_=dateSpanAsPeriod fullreportspan, value_=Nothing, conversionop_=Just NoConversionOp}  -- If we're valuing after the sum, don't do it now
+        else ropts{period_=dateSpanAsPeriod fullreportspan}
+
+    -- q projected back before the report start date.
+    -- When there's no report start date, in case there are future txns (the hledger-ui case above),
+    -- we use emptydatespan to make sure they aren't counted as starting balance.
+    fullreportq = dbg3 "fullreportq" $ And [datelessq, fullreportspanq]
+    datelessq   = dbg3 "datelessq" $ filterQuery (not . queryIsDateOrDate2) depthlessq
 
     -- The user's query with no depth limit, and expanded to the report span
     -- if there is one (otherwise any date queries are left as-is, which
     -- handles the hledger-ui+future txns case above).
-    depthless = dbg3 "depthless" $ filterQuery (not . queryIsDepth) query
+    depthlessq = dbg3 "depthlessq" $ filterQuery (not . queryIsDepth) query
 
--- | From set of postings, eg for a single report column, calculate the balance change in each account. 
--- Accounts and amounts will be depth-clipped appropriately if a depth limit is in effect.
---
--- When --declared is used, accounts which have been declared with an account directive
--- are also included, with a 0 balance change. But only leaf accounts, since non-leaf
--- empty declared accounts are less useful in reports. This is primarily for hledger-ui.
-acctChanges :: ReportSpec -> Journal -> [Posting] -> HashMap ClippedAccountName Account
-acctChanges ReportSpec{_rsQuery=query,_rsReportOpts=ReportOpts{accountlistmode_, declared_}} j ps =
-  HM.fromList [(aname a, a) | a <- accts]
+    depthSpec  = dbg3 "depthSpec" . queryDepth $ filterQuery queryIsDepth query
+
+    fullreportspan  = if requiresHistorical ropts then DateSpan Nothing (Exact <$> spanEnd reportspan) else reportspan
+    fullreportspanq = (if date2_ ropts then Date2 else Date) $ case fullreportspan of
+        DateSpan Nothing Nothing -> emptydatespan
+        a -> a
+
+-- | Generate the 'Account' for the requested multi-balance report from a list
+-- of 'Posting's.
+generateMultiBalanceAccount :: ReportSpec -> Journal -> PriceOracle -> [DateSpan] -> [Posting] -> Account BalanceData
+generateMultiBalanceAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle colspans =
+    -- Add declared accounts if called with --declared and --empty
+    (if (declared_ ropts && empty_ ropts) then addDeclaredAccounts rspec j else id)
+    -- Negate amounts if applicable
+    . (if invert_ ropts then fmap (mapBalanceData maNegate) else id)
+    -- Mark which accounts are boring and which are interesting
+    . markAccountBoring rspec
+    -- Set account declaration info (for sorting purposes)
+    . mapAccounts (accountSetDeclarationInfo j)
+    -- Process changes into normal, cumulative, or historical amounts, plus value them
+    . calculateReportAccount rspec j priceoracle colspans
+
+-- | Add declared accounts to the account tree.
+addDeclaredAccounts :: Monoid a => ReportSpec -> Journal -> Account a -> Account a
+addDeclaredAccounts rspec j acct =
+    these id id const <$> mergeAccounts acct declaredTree
   where
-    -- With --declared, add the query-matching declared accounts
-    -- (as dummy postings so they are processed like the rest).
-    -- This function is used for calculating both pre-start changes and column changes,
-    -- and the declared accounts are really only needed for the former, 
-    -- but it's harmless to have them in the column changes as well.
-    ps' = ps ++ if declared_ then declaredacctps else []
-      where
-        declaredacctps =
-          [nullposting{paccount=a}
-          | a <- journalLeafAccountNamesDeclared j
-          , matchesAccountExtra (journalAccountType j) (journalAccountTags j) accttypetagsq a
-          ]
-          where
-            accttypetagsq  = dbg3 "accttypetagsq" $
-              filterQueryOrNotQuery (\q -> queryIsAcct q || queryIsType q || queryIsTag q) query
+    declaredTree =
+        mapAccounts (\a -> a{aboring = not $ aname a `HS.member` HS.fromList declaredAccounts}) $
+          accountTreeFromBalanceAndNames "root" (mempty <$ adata acct) declaredAccounts
 
-    filterbydepth = case accountlistmode_ of
-        ALTree -> filter (depthMatches . aname)       -- a tree - just exclude deeper accounts
-        ALFlat -> clipAccountsAndAggregate depthSpec  -- a list - aggregate deeper accounts at the depth limit
-                  . filter ((0<) . anumpostings)      -- and exclude empty parent accounts
-      where
-        depthSpec = dbg3 "depthq" . queryDepth $ filterQuery queryIsDepth query
-        depthMatches name = maybe True (accountNameLevel name <=) $ getAccountNameClippedDepth depthSpec name
+    -- With --declared, add the query-matching declared accounts (as dummy postings
+    -- so they are processed like the rest).
+    declaredAccounts =
+      map (clipOrEllipsifyAccountName depthSpec) .
+      filter (matchesAccountExtra (journalAccountType j) (journalAccountTags j) accttypetagsq) $
+      journalAccountNamesDeclared j
+
+    accttypetagsq  = dbg3 "accttypetagsq" .
+      filterQueryOrNotQuery (\q -> queryIsAcct q || queryIsType q || queryIsTag q) $
+      _rsQuery rspec
+
+    depthSpec = queryDepth . filterQuery queryIsDepth $ _rsQuery rspec
 
-    accts = filterbydepth $ drop 1 $ accountsFromPostings ps'
 
 -- | Gather the account balance changes into a regular matrix, then
 -- accumulate and value amounts, as specified by the report options.
 -- Makes sure all report columns have an entry.
-calculateReportMatrix :: ReportSpec -> Journal -> PriceOracle
-                      -> HashMap ClippedAccountName Account
-                      -> [(DateSpan, [Posting])]
-                      -> HashMap ClippedAccountName (Map DateSpan Account)
-calculateReportMatrix rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle startbals colps =  -- PARTIAL:
-    -- Ensure all columns have entries, including those with starting balances
-    HM.mapWithKey rowbals allchanges
+calculateReportAccount :: ReportSpec -> Journal -> PriceOracle -> [DateSpan] -> [Posting] -> Account BalanceData
+calculateReportAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle colspans ps =  -- PARTIAL:
+    mapPeriodData rowbals changesAcct
   where
     -- The valued row amounts to be displayed: per-period changes,
     -- zero-based cumulative totals, or
     -- starting-balance-based historical balances.
-    rowbals name unvaluedChanges = dbg5 "rowbals" $ case balanceaccum_ ropts of
+    rowbals :: PeriodData BalanceData -> PeriodData BalanceData
+    rowbals unvaluedChanges = case balanceaccum_ ropts of
         PerPeriod  -> changes
         Cumulative -> cumulative
         Historical -> historical
@@ -320,207 +280,208 @@ calculateReportMatrix rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle startb
         -- changes to report on: usually just the valued changes themselves, but use the
         -- differences in the valued historical amount for CalcValueChange and CalcGain.
         changes = case balancecalc_ ropts of
-            CalcChange        -> M.mapWithKey avalue unvaluedChanges
-            CalcBudget        -> M.mapWithKey avalue unvaluedChanges
-            CalcValueChange   -> periodChanges valuedStart historical
-            CalcGain          -> periodChanges valuedStart historical
-            CalcPostingsCount -> M.mapWithKey avalue unvaluedChanges
+            CalcChange        -> avalue unvaluedChanges
+            CalcBudget        -> avalue unvaluedChanges
+            CalcValueChange   -> periodChanges historical
+            CalcGain          -> periodChanges historical
+            CalcPostingsCount -> avalue unvaluedChanges
         -- the historical balance is the valued cumulative sum of all unvalued changes
-        historical = M.mapWithKey avalue $ cumulativeSum startingBalance unvaluedChanges
+        historical = avalue $ cumulativeSum unvaluedChanges
         -- since this is a cumulative sum of valued amounts, it should not be valued again
-        cumulative = cumulativeSum nullacct changes
-        startingBalance = HM.lookupDefault nullacct name startbals
-        valuedStart = avalue (DateSpan Nothing (Exact <$> historicalDate)) startingBalance
+        cumulative = cumulativeSum changes{pdpre = mempty}
+        avalue = periodDataValuation ropts j priceoracle colspans
 
-    -- In each column, get each account's balance changes
-    colacctchanges = dbg5 "colacctchanges" $ map (second $ acctChanges rspec j) colps :: [(DateSpan, HashMap ClippedAccountName Account)]
-    -- Transpose it to get each account's balance changes across all columns
-    acctchanges = dbg5 "acctchanges" $ transposeMap colacctchanges :: HashMap AccountName (Map DateSpan Account)
-    -- Fill out the matrix with zeros in empty cells
-    allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals)
+    changesAcct = dbg5With (\x -> "multiBalanceReport changesAcct\n" ++ showAccounts x) .
+        mapPeriodData (padPeriodData intervalStarts) $
+        accountFromPostings getIntervalStartDate ps
 
-    avalue = acctApplyBoth . mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle
-    acctApplyBoth f a = a{aibalance = f $ aibalance a, aebalance = f $ aebalance a}
-    historicalDate = minimumMay $ mapMaybe spanStart colspans
-    zeros = M.fromList [(spn, nullacct) | spn <- colspans]
-    colspans = map fst colps
+    getIntervalStartDate p = intToDay <$> IS.lookupLE (dayToInt $ getPostingDate p) intervalStarts
+    getPostingDate = postingDateOrDate2 (whichDate (_rsReportOpts rspec))
 
+    intervalStarts = IS.fromList . map dayToInt $ case mapMaybe spanStart colspans of
+      [] -> [nulldate]  -- Deal with the case of the empty journal
+      xs -> xs
+    dayToInt = fromInteger . toModifiedJulianDay
+    intToDay = ModifiedJulianDay . toInteger
+
+-- | The valuation function to use for the chosen report options.
+periodDataValuation :: ReportOpts -> Journal -> PriceOracle -> [DateSpan]
+                    -> PeriodData BalanceData -> PeriodData BalanceData
+periodDataValuation ropts j priceoracle colspans =
+    opPeriodData valueBalanceData balanceDataPeriodEnds
+  where
+    valueBalanceData :: Day -> BalanceData -> BalanceData
+    valueBalanceData d = mapBalanceData (valueMixedAmount d)
+
+    valueMixedAmount :: Day -> MixedAmount -> MixedAmount
+    valueMixedAmount = mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle
+
+    balanceDataPeriodEnds :: PeriodData Day
+    balanceDataPeriodEnds = dbg5 "balanceDataPeriodEnds" $ case colspans of  -- FIXME: Change colspans to nonempty list
+        [DateSpan Nothing Nothing] -> periodDataFromList nulldate [(nulldate, nulldate)]  -- Empty journal
+        h:ds                       -> periodDataFromList (makeJustFst $ boundaries h) $ map (makeJust . boundaries) (h:ds)
+        []                         -> error "balanceDataPeriodEnds: Shouldn't have empty colspans"  -- PARTIAL: Shouldn't occur
+      where
+        boundaries spn = (spanStart spn, spanEnd spn)
+
+        makeJust (Just x, Just y) = (x, addDays (-1) y)
+        makeJust _    = error "calculateReportAccount: expected all non-initial spans to have start and end dates"
+        makeJustFst (Just x, _) = addDays (-1) x
+        makeJustFst _ = error "calculateReportAccount: expected initial span to have an end date"
+
+-- | Mark which nodes of an 'Account' are boring, and so should be omitted from reports.
+markAccountBoring :: ReportSpec -> Account BalanceData -> Account BalanceData
+markAccountBoring ReportSpec{_rsQuery=query,_rsReportOpts=ropts}
+    -- If depth 0, all accounts except the top-level account are boring
+    | qdepthIsZero = markBoring False . mapAccounts (markBoring True)
+    -- Otherwise the top level account is boring, and subaccounts are boring if
+    -- they are both boring in and of themselves and are boring parents
+    | otherwise    = markBoring True . mapAccounts (markBoringBy (liftA2 (&&) isBoring isBoringParent))
+  where
+    -- Accounts boring on their own
+    isBoring :: Account BalanceData -> Bool
+    isBoring acct = tooDeep || allZeros
+      where
+        tooDeep = d > qdepth                                       -- Throw out anything too deep
+        allZeros = isZeroRow balance amts && not keepEmptyAccount  -- Throw away everything with a zero balance in the row, unless..
+        keepEmptyAccount = empty_ ropts && keepWhenEmpty acct      -- We are keeping empty rows and this row meets the criteria
+
+        amts = pdperiods $ adata acct
+        d = accountNameLevel $ aname acct
+
+        qdepth = fromMaybe maxBound . getAccountNameClippedDepth depthspec $ aname acct
+        balance = maybeStripPrices . case accountlistmode_ ropts of
+            ALTree | d == qdepth -> bdincludingsubs
+            _                    -> bdexcludingsubs
+
+    -- Accounts which don't have enough interesting subaccounts
+    isBoringParent :: Account a -> Bool
+    isBoringParent acct = case accountlistmode_ ropts of
+        ALTree -> notEnoughSubs || droppedAccount
+        ALFlat -> True
+      where
+        notEnoughSubs = length interestingSubs < minimumSubs
+        droppedAccount = accountNameLevel (aname acct) <= drop_ ropts
+        interestingSubs = filter (anyAccounts (not . aboring)) $ asubs acct
+        minimumSubs = if no_elide_ ropts then 1 else 2
+
+    isZeroRow balance = all (mixedAmountLooksZero . balance)
+    keepWhenEmpty = case accountlistmode_ ropts of
+        ALFlat -> any ((0<) . bdnumpostings) . pdperiods . adata  -- Keep all accounts that have postings in flat mode
+        ALTree -> null . asubs                                    -- Keep only empty leaves in tree mode
+    maybeStripPrices = if conversionop_ ropts == Just NoConversionOp then id else mixedAmountStripCosts
+
+    qdepthIsZero = depthspec == DepthSpec (Just 0) []
+    depthspec = queryDepth query
+
+    markBoring   v a = a{aboring = v}
+    markBoringBy f a = a{aboring = f a}
+
+
+-- | Build a report row.
+--
+-- Calculate the column totals. These are always the sum of column amounts.
+generateMultiBalanceReport :: ReportOpts -> [DateSpan] -> Account BalanceData -> MultiBalanceReport
+generateMultiBalanceReport ropts colspans =
+    reportPercent ropts . generatePeriodicReport makeMultiBalanceReportRow bdincludingsubs id ropts colspans
 
 -- | 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.
-generateMultiBalanceReport :: ReportSpec -> Journal -> PriceOracle -> Set AccountName
-                           -> [(DateSpan, [Posting])] -> HashMap AccountName Account
-                           -> MultiBalanceReport
-generateMultiBalanceReport rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle unelidableaccts colps0 startbals =
-    report
+generatePeriodicReport :: Show c =>
+    (forall a. ReportOpts -> (BalanceData -> MixedAmount) -> a -> Account b -> PeriodicReportRow a c)
+    -> (b -> MixedAmount) -> (c -> MixedAmount)
+    -> ReportOpts -> [DateSpan] -> Account b -> PeriodicReport DisplayName c
+generatePeriodicReport makeRow treeAmt flatAmt ropts colspans acct =
+    PeriodicReport colspans (buildAndSort acct) totalsrow
   where
-    -- If doing --count, set all posting amounts to "1".
-    colps =
-      if balancecalc_ ropts == CalcPostingsCount
-      then map (second (map (postingTransformAmount (const $ mixed [num 1])))) colps0
-      else colps0
+    -- Build report rows and sort them
+    buildAndSort = dbg5 "sortedrows" . case accountlistmode_ ropts of
+        ALTree | sort_amount_ ropts -> buildRows . sortTreeByAmount
+        ALFlat | sort_amount_ ropts -> sortFlatByAmount . buildRows
+        _                           -> buildRows . sortAccountTreeByDeclaration
 
-    -- Process changes into normal, cumulative, or historical amounts, plus value them
-    matrix = calculateReportMatrix rspec j priceoracle startbals colps
+    buildRows = buildReportRows makeRow ropts
 
-    -- All account names that will be displayed, possibly depth-clipped.
-    displaynames = dbg5 "displaynames" $ displayedAccounts rspec unelidableaccts matrix
+    -- Calculate column totals from the inclusive balances of the root account
+    totalsrow = dbg5 "totalsrow" $ makeRow ropts bdincludingsubs () acct
 
-    -- All the rows of the report.
-    rows = dbg5 "rows" . (if invert_ ropts then map (fmap maNegate) else id)  -- Negate amounts if applicable
-             $ buildReportRows ropts displaynames matrix
+    sortTreeByAmount = case fromMaybe NormallyPositive $ normalbalance_ ropts of
+        NormallyPositive -> sortAccountTreeOn (\r -> (Down $ amt r, aname r))
+        NormallyNegative -> sortAccountTreeOn (\r -> (amt r, aname r))
+      where
+        amt = mixedAmountStripCosts . sortKey . fmap treeAmt . pdperiods . adata
+        sortKey = case balanceaccum_ ropts of
+          PerPeriod -> maSum
+          _         -> maybe nullmixedamt snd . IM.lookupMax
 
-    -- Calculate column totals
-    totalsrow = dbg5 "totalsrow" $ calculateTotalsRow ropts rows $ length colps
-
-    -- Sorted report rows.
-    sortedrows = dbg5 "sortedrows" $ sortRows ropts j rows
-
-    -- Take percentages if needed
-    report = reportPercent ropts $ PeriodicReport (map fst colps) sortedrows totalsrow
+    sortFlatByAmount = case fromMaybe NormallyPositive $ normalbalance_ ropts of
+        NormallyPositive -> sortOn (\r -> (Down $ amt r, prrFullName r))
+        NormallyNegative -> sortOn (\r -> (amt r, prrFullName r))
+      where amt = mixedAmountStripCosts . flatAmt . prrTotal
 
 -- | Build the report rows.
 -- One row per account, with account name info, row amounts, row total and row average.
--- Rows are unsorted.
-buildReportRows :: ReportOpts
-                -> HashMap AccountName DisplayName
-                -> HashMap AccountName (Map DateSpan Account)
-                -> [MultiBalanceReportRow]
-buildReportRows ropts displaynames =
-  toList . HM.mapMaybeWithKey mkRow  -- toList of HashMap's Foldable instance - does not sort consistently
+-- Rows are sorted according to the order in the 'Account' tree.
+buildReportRows :: forall b c.
+                (ReportOpts -> (BalanceData -> MixedAmount) -> DisplayName -> Account b -> PeriodicReportRow DisplayName c)
+                -> ReportOpts -> Account b -> [PeriodicReportRow DisplayName c]
+buildReportRows makeRow ropts = mkRows True (-drop_ ropts) 0
   where
-    mkRow name accts = do
-        displayname <- HM.lookup name displaynames
-        return $ PeriodicReportRow displayname rowbals rowtot rowavg
+    -- Build the row for an account at a given depth with some number of boring parents
+    mkRows :: Bool -> Int -> Int -> Account b -> [PeriodicReportRow DisplayName c]
+    mkRows isRoot d boringParents acct
+        -- Account is a boring root account, and should be bypassed entirely
+        | aboring acct && isRoot         = buildSubrows d 0
+        -- Account is boring and has been dropped, so should be skipped and move up the hierarchy
+        | aboring acct && d < 0          = buildSubrows (d + 1) 0
+        -- Account is boring, and we can omit boring parents, so we should omit but keep track
+        | aboring acct && canOmitParents = buildSubrows d (boringParents + 1)
+        -- Account is not boring or otherwise should be displayed.
+        | otherwise = makeRow ropts balance displayname acct : buildSubrows (d + 1) 0
       where
-        rowbals = map balance $ toList accts  -- toList of Map's Foldable instance - does sort by key
-        -- The total and average for the row.
-        -- These are always simply the sum/average of the displayed row amounts.
-        -- Total for a cumulative/historical report is always the last column.
-        rowtot = case balanceaccum_ ropts of
-            PerPeriod -> maSum rowbals
-            _         -> lastDef nullmixedamt rowbals
-        rowavg = averageMixedAmounts rowbals
-    balance = case accountlistmode_ ropts of ALTree -> aibalance; ALFlat -> aebalance
+        displayname = displayedName d boringParents $ aname acct
+        buildSubrows i b = concatMap (mkRows False i b) $ asubs acct
 
--- | Calculate accounts which are to be displayed in the report,
--- and their name and their indent level if displayed in tree mode.
-displayedAccounts :: ReportSpec
-                  -> Set AccountName
-                  -> HashMap AccountName (Map DateSpan Account)
-                  -> HashMap AccountName DisplayName
-displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts valuedaccts
-    | qdepthIsZero = HM.singleton "..." $ DisplayName "..." "..." 0
-    | otherwise    = HM.mapWithKey (\a _ -> displayedName a) displayedAccts
-  where
-    displayedName name = case accountlistmode_ ropts of
-        ALTree -> DisplayName name leaf (max 0 $ level - 1 - boringParents)
-        ALFlat -> DisplayName name droppedName 0
+    canOmitParents = flat_ ropts || not (no_elide_ ropts)
+    balance = case accountlistmode_ ropts of
+        ALTree -> bdincludingsubs
+        ALFlat -> bdexcludingsubs
+
+    displayedName d boringParents name
+        | d == 0 && name == "root" = DisplayName "..." "..." 0
+        | otherwise = case accountlistmode_ ropts of
+            ALTree -> DisplayName name leaf $ max 0 d
+            ALFlat -> DisplayName name droppedName 0
       where
-        droppedName   = accountNameDrop (drop_ ropts) name
-        leaf          = accountNameFromComponents . reverse . map accountLeafName $
-                          droppedName : takeWhile notDisplayed parents
-        level         = max 0 $ (accountNameLevel name) - drop_ ropts
-        parents       = take (level - 1) $ parentAccountNames name
-        boringParents = if no_elide_ ropts then 0 else length $ filter notDisplayed parents
-        notDisplayed  = not . (`HM.member` displayedAccts)
+        leaf = accountNameFromComponents
+               . reverse . take (boringParents + 1) . reverse
+               $ accountNameComponents droppedName
+        droppedName = accountNameDrop (drop_ ropts) name
 
-    -- Accounts which are to be displayed
-    displayedAccts = (if qdepthIsZero then id else HM.filterWithKey keep) valuedaccts
-      where
-        keep name amts = isInteresting name amts || name `HM.member` interestingParents
 
-    -- Accounts interesting for their own sake
-    isInteresting name amts =
-        d <= qdepth                                -- Throw out anything too deep
-        && ( name `Set.member` unelidableaccts     -- Unelidable accounts should be kept unless too deep
-           ||(empty_ ropts && keepWhenEmpty amts)  -- Keep empty accounts when called with --empty
-           || not (isZeroRow balance amts)         -- Keep everything with a non-zero balance in the row
-           )
-      where
-        d = accountNameLevel name
-        qdepth = fromMaybe maxBound $ getAccountNameClippedDepth depthspec name
-        keepWhenEmpty = case accountlistmode_ ropts of
-            ALFlat -> const True          -- Keep all empty accounts in flat mode
-            ALTree -> all (null . asubs)  -- Keep only empty leaves in tree mode
-        balance = maybeStripPrices . case accountlistmode_ ropts of
-            ALTree | d == qdepth -> aibalance
-            _                    -> aebalance
-          where maybeStripPrices = if conversionop_ ropts == Just NoConversionOp then id else mixedAmountStripCosts
-
-    -- Accounts interesting because they are a fork for interesting subaccounts
-    interestingParents = dbg5 "interestingParents" $ case accountlistmode_ ropts of
-        ALTree -> HM.filterWithKey hasEnoughSubs numSubs
-        ALFlat -> mempty
-      where
-        hasEnoughSubs name nsubs = nsubs >= minSubs && accountNameLevel name > drop_ ropts
-        minSubs = if no_elide_ ropts then 1 else 2
-
-    isZeroRow balance = all (mixedAmountLooksZero . balance)
-    depthspec = queryDepth query
-    qdepthIsZero = depthspec == DepthSpec (Just 0) []
-    numSubs = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts
-
--- | Sort the rows by amount or by account declaration order.
-sortRows :: ReportOpts -> Journal -> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
-sortRows ropts j
-    | sort_amount_ ropts, ALTree <- accountlistmode_ ropts = sortTreeMBRByAmount
-    | sort_amount_ ropts, ALFlat <- accountlistmode_ ropts = sortFlatMBRByAmount
-    | otherwise                                            = sortMBRByAccountDeclaration
-  where
-    -- Sort the report rows, representing a tree of accounts, by row total at each level.
-    -- Similar to sortMBRByAccountDeclaration/sortAccountNamesByDeclaration.
-    sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
-    sortTreeMBRByAmount rows = mapMaybe (`HM.lookup` rowMap) sortedanames
-      where
-        accounttree = accountTree "root" $ map prrFullName rows
-        rowMap = HM.fromList $ map (\row -> (prrFullName row, row)) rows
-        -- Set the inclusive balance of an account from the rows, or sum the
-        -- subaccounts if it's not present
-        accounttreewithbals = mapAccounts setibalance accounttree
-        setibalance a = a{aibalance = maybe (maSum . map aibalance $ asubs a) prrTotal $
-                                          HM.lookup (aname a) rowMap}
-        sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ ropts) accounttreewithbals
-        sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree
-
-    -- Sort the report rows, representing a flat account list, by row total (and then account name).
-    sortFlatMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
-    sortFlatMBRByAmount = case fromMaybe NormallyPositive $ normalbalance_ ropts of
-        NormallyPositive -> sortOn (\r -> (Down $ amt r, prrFullName r))
-        NormallyNegative -> sortOn (\r -> (amt r, prrFullName r))
-      where amt = mixedAmountStripCosts . prrTotal
-
-    -- Sort the report rows by account declaration order then account name.
-    sortMBRByAccountDeclaration :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
-    sortMBRByAccountDeclaration rows = sortRowsLike sortedanames rows
-      where
-        sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) $ map prrFullName rows
-
--- | Build the report totals row.
+-- | Build a report row.
 --
 -- Calculate the column totals. These are always the sum of column amounts.
-calculateTotalsRow :: ReportOpts -> [MultiBalanceReportRow] -> Int -> PeriodicReportRow () MixedAmount
-calculateTotalsRow ropts rows colcount =
-    PeriodicReportRow () coltotals grandtotal grandaverage
+makeMultiBalanceReportRow :: ReportOpts -> (BalanceData -> MixedAmount)
+                          -> a -> Account BalanceData -> PeriodicReportRow a MixedAmount
+makeMultiBalanceReportRow = makePeriodicReportRow nullmixedamt sumAndAverageMixedAmounts
+
+-- | Build a report row.
+--
+-- Calculate the column totals. These are always the sum of column amounts.
+makePeriodicReportRow :: c -> (IM.IntMap c -> (c, c))
+                      -> ReportOpts -> (b -> c)
+                      -> a -> Account b -> PeriodicReportRow a c
+makePeriodicReportRow nullEntry totalAndAverage ropts balance name acct =
+    PeriodicReportRow name (toList rowbals) rowtotal avg
   where
-    isTopRow row = flat_ ropts || not (any (`HM.member` rowMap) parents)
-      where parents = init . expandAccountName $ prrFullName row
-    rowMap = HM.fromList $ map (\row -> (prrFullName row, row)) rows
-
-    colamts = transpose . map prrAmounts $ filter isTopRow rows
-
-    coltotals :: [MixedAmount] = dbg5 "coltotals" $ case colamts of
-      [] -> replicate colcount nullmixedamt
-      _ -> map maSum colamts
-
-    -- Calculate the grand total and average. These are always the sum/average
-    -- of the column totals.
+    rowbals = fmap balance . pdperiods $ adata acct
+    (total, avg) = totalAndAverage rowbals
     -- Total for a cumulative/historical report is always the last column.
-    grandtotal = case balanceaccum_ ropts of
-        PerPeriod -> maSum coltotals
-        _         -> lastDef nullmixedamt coltotals
-    grandaverage = averageMixedAmounts coltotals
+    rowtotal = case balanceaccum_ ropts of
+        PerPeriod -> total
+        _         -> maybe nullEntry snd $ IM.lookupMax rowbals
 
 -- | Map the report rows to percentages if needed
 reportPercent :: ReportOpts -> MultiBalanceReport -> MultiBalanceReport
@@ -534,31 +495,6 @@ reportPercent ropts report@(PeriodicReport spans rows totalrow)
         (perdivide rowtotal $ prrTotal totalrow)
         (perdivide rowavg $ prrAverage totalrow)
 
-
--- | Transpose a Map of HashMaps to a HashMap of Maps.
---
--- Makes sure that all DateSpans are present in all rows.
-transposeMap :: [(DateSpan, HashMap AccountName a)]
-             -> HashMap AccountName (Map DateSpan a)
-transposeMap = foldr (uncurry addSpan) mempty
-  where
-    addSpan spn acctmap seen = HM.foldrWithKey (addAcctSpan spn) seen acctmap
-
-    addAcctSpan spn acct a = HM.alter f acct
-      where f = Just . M.insert spn a . fromMaybe mempty
-
--- | A sorting helper: sort a list of things (eg report rows) keyed by account name
--- to match the provided ordering of those same account names.
-sortRowsLike :: [AccountName] -> [PeriodicReportRow DisplayName b] -> [PeriodicReportRow DisplayName b]
-sortRowsLike sortedas rows = mapMaybe (`HM.lookup` rowMap) sortedas
-  where rowMap = HM.fromList $ map (\row -> (prrFullName row, row)) rows
-
--- | Given a list of account names, find all forking parent accounts, i.e.
--- those which fork between different branches
-subaccountTallies :: [AccountName] -> HashMap AccountName Int
-subaccountTallies = foldr incrementParent mempty . expandAccountNames
-  where incrementParent a = HM.insertWith (+) (parentAccountName a) 1
-
 -- | A helper: what percentage is the second mixed amount of the first ?
 -- Keeps the sign of the first amount.
 -- Uses unifyMixedAmount to unify each argument and then divides them.
@@ -572,26 +508,13 @@ perdivide a b = fromMaybe (error' errmsg) $ do  -- PARTIAL:
     return $ mixed [per $ if aquantity b' == 0 then 0 else aquantity a' / abs (aquantity b') * 100]
   where errmsg = "Cannot calculate percentages if accounts have different commodities (Hint: Try --cost, -V or similar flags.)"
 
--- Add the values of two accounts. Should be right-biased, since it's used
--- in scanl, so other properties (such as anumpostings) stay in the right place
-sumAcct :: Account -> Account -> Account
-sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} =
-    a{aibalance = i1 `maPlus` i2, aebalance = e1 `maPlus` e2}
-
--- Subtract the values in one account from another. Should be left-biased.
-subtractAcct :: Account -> Account -> Account
-subtractAcct a@Account{aibalance=i1,aebalance=e1} Account{aibalance=i2,aebalance=e2} =
-    a{aibalance = i1 `maMinus` i2, aebalance = e1 `maMinus` e2}
-
--- | Extract period changes from a cumulative list
-periodChanges :: Account -> Map k Account -> Map k Account
-periodChanges start amtmap =
-    M.fromDistinctAscList . zip dates $ zipWith subtractAcct amts (start:amts)
-  where (dates, amts) = unzip $ M.toAscList amtmap
-
 -- | Calculate a cumulative sum from a list of period changes.
-cumulativeSum :: Account -> Map DateSpan Account -> Map DateSpan Account
-cumulativeSum start = snd . M.mapAccum (\a b -> let s = sumAcct a b in (s, s)) start
+cumulativeSum :: Traversable t => t BalanceData -> t BalanceData
+cumulativeSum = snd . mapAccumL (\prev new -> let z = prev <> new in (z, z)) mempty
+
+-- | Extract period changes from a cumulative list.
+periodChanges :: Traversable t => t BalanceData -> t BalanceData
+periodChanges = snd . mapAccumL (\prev new -> (new, opBalanceData maMinus new prev)) mempty
 
 -- tests
 

hledger-lib/Hledger/Reports/PostingsReport.hs

@@ -243,10 +243,10 @@ summarisePostingsInDateSpan spn@(DateSpan b e) wd mdepth showempty ps
     summarypes = map (, dateSpanAsPeriod spn) $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps
     anames = nubSort $ map paccount ps
     -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping
-    accts = accountsFromPostings ps
+    accts = accountsFromPostings (const Nothing) ps
     balance a = maybe nullmixedamt bal $ lookupAccount a accts
       where
-        bal = if isclipped a then aibalance else aebalance
+        bal = (if isclipped a then bdincludingsubs else bdexcludingsubs) . pdpre . adata
         isclipped a' = maybe False (accountNameLevel a' >=) mdepth
 
 

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -52,6 +52,7 @@ module Hledger.Reports.ReportOptions (
   journalApplyValuationFromOptsWith,
   mixedAmountApplyValuationAfterSumFromOptsWith,
   valuationAfterSum,
+  requiresHistorical,
   intervalFromRawOpts,
   queryFromFlags,
   transactionDateFn,
@@ -677,21 +678,20 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{_rsReportOpts=ropts} j priceo
 -- | Select the Account valuation functions required for performing valuation after summing
 -- amounts. Used in MultiBalanceReport to value historical and similar reports.
 mixedAmountApplyValuationAfterSumFromOptsWith :: ReportOpts -> Journal -> PriceOracle
-                                              -> (DateSpan -> MixedAmount -> MixedAmount)
+                                              -> (Day -> MixedAmount -> MixedAmount)
 mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle =
     case valuationAfterSum ropts of
         Just mc -> case balancecalc_ ropts of
             CalcGain -> gain mc
-            _        -> \spn -> valuation mc spn . costing
+            _        -> \d -> valuation mc d . costing
         Nothing      -> const id
   where
-    valuation mc spn = mixedAmountValueAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd spn)
-    gain mc spn = mixedAmountGainAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd spn)
+    valuation mc d = mixedAmountValueAtDate priceoracle styles mc d
+    gain mc d = mixedAmountGainAtDate priceoracle styles mc d
     costing = case fromMaybe NoConversionOp $ conversionop_ ropts of
         NoConversionOp -> id
         ToCost         -> styleAmounts styles . mixedAmountCost
     styles = journalCommodityStyles j
-    err = error' "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date"
 
 -- | If the ReportOpts specify that we are performing valuation after summing amounts,
 -- return Just of the commodity symbol we're converting to, Just Nothing for the default,
@@ -699,12 +699,15 @@ mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle =
 -- Used for example with historical reports with --value=end.
 valuationAfterSum :: ReportOpts -> Maybe (Maybe CommoditySymbol)
 valuationAfterSum ropts = case value_ ropts of
-    Just (AtEnd mc) | valueAfterSum -> Just mc
-    _                               -> Nothing
-  where valueAfterSum = balancecalc_  ropts == CalcValueChange
-                     || balancecalc_  ropts == CalcGain
-                     || balanceaccum_ ropts /= PerPeriod
+    Just (AtEnd mc) | requiresHistorical ropts -> Just mc
+    _                                          -> Nothing
 
+-- | If the ReportOpts specify that we will need to consider historical
+-- postings, either because this is a historical report, or because the
+-- valuation strategy requires historical amounts.
+requiresHistorical :: ReportOpts -> Bool
+requiresHistorical ReportOpts{balanceaccum_ = accum, balancecalc_ = calc} =
+    accum == Historical || calc == CalcValueChange || calc == CalcGain
 
 -- | Convert report options to a query, ignoring any non-flag command line arguments.
 queryFromFlags :: ReportOpts -> Query
@@ -780,7 +783,7 @@ reportSpanBothDates = reportSpanHelper True
 -- primary and secondary dates.
 reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, [DateSpan])
 reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts} =
-    (reportspan, intervalspans)
+    (reportspan, if not (null intervalspans) then intervalspans else [reportspan])
   where
     -- The date span specified by -b/-e/-p options and query args if any.
     requestedspan  = dbg3 "requestedspan" $ if bothdates then queryDateSpan' query else queryDateSpan (date2_ ropts) query

hledger-lib/hledger-lib.cabal

@@ -115,6 +115,8 @@ library
       Text.Tabular.AsciiWide
       Text.WideString
   other-modules:
+      Hledger.Data.BalanceData
+      Hledger.Data.PeriodData
       Paths_hledger_lib
   autogen-modules:
       Paths_hledger_lib
@@ -163,6 +165,7 @@ library
     , template-haskell
     , terminal-size >=0.3.3
     , text >=1.2.4.1
+    , these >=1.0.0
     , time >=1.5
     , timeit
     , transformers >=0.2
@@ -222,6 +225,7 @@ test-suite doctest
     , template-haskell
     , terminal-size >=0.3.3
     , text >=1.2.4.1
+    , these >=1.0.0
     , time >=1.5
     , timeit
     , transformers >=0.2
@@ -283,6 +287,7 @@ test-suite unittest
     , template-haskell
     , terminal-size >=0.3.3
     , text >=1.2.4.1
+    , these >=1.0.0
     , time >=1.5
     , timeit
     , transformers >=0.2

hledger-lib/package.yaml

@@ -85,6 +85,7 @@ dependencies:
 - template-haskell
 - terminal-size >=0.3.3
 - text >=1.2.4.1
+- these >=1.0.0
 - time >=1.5
 - timeit
 - transformers >=0.2

hledger-web/Hledger/Web/Widget/Common.hs

@@ -82,9 +82,9 @@ balanceReportAsHtml (journalR, registerR) here hideEmpty j qparam qopts (items,
   where
     l = ledgerFromJournal Any j
     indent a = preEscapedString $ concat $ replicate (2 + 2 * a) " "
-    hasSubAccounts acct = maybe True (not . null . asubs) (ledgerAccount l acct)
+    hasSubAccounts acct = maybe True (not . null . asubs) $ ledgerAccount l acct
     isInterestingAccount acct = maybe False isInteresting $ ledgerAccount l acct
-      where isInteresting a = not (mixedAmountLooksZero (aebalance a)) || any isInteresting (asubs a)
+      where isInteresting a = not (all (mixedAmountLooksZero . bdexcludingsubs) . pdperiods $ adata a) || any isInteresting (asubs a)
     matchesAcctSelector acct = Just True == ((`matchesAccount` acct) <$> inAccountQuery qopts)
 
 accountQuery :: AccountName -> Text

hledger/test/balance/balance.test

@@ -161,7 +161,6 @@ $ hledger -f - balance -N --output-format=csv
 
 # ** 10. --declared includes all declared leaf accounts, even if they have no postings.
 # They are filtered, depth-clipped, and form trees like the others.
-# (XXX Here a:ac is not declared and so not shown, even though normally a balance report clipped to depth 2 would show it. Wrong ?)
 <
 account a
 account a:aa
@@ -172,27 +171,17 @@ $ hledger -f - balance -NE --declared --tree --depth 2 a
                    0  a
                    0    aa
                    0    ab
+                   0    ac
 
-# ** 11. In list mode we can see that non-leaf declared accounts are excluded.
-<
-account a
-account a:aa
-account a:ab
-account a:ac:aca
-account b
+# ** 11. In list mode we can see that declared accounts are included, even if they have no postings.
 $ hledger -f - balance -NE --declared --flat
+                   0  a
                    0  a:aa
                    0  a:ab
                    0  a:ac:aca
                    0  b
 
 # ** 12. not:ACCT queries work with declared accounts.
-<
-account a
-account a:aa
-account a:ab
-account a:ac:aca
-account b
 $ hledger -f - balance -NE --declared not:a
                    0  b
 
@@ -217,3 +206,20 @@ $ hledger -f- bal --count -1
                    1  b
 --------------------
                    3  
+
+# ** 16. Make sure that balance --flat --empty does not display implied
+# accounts (i.e. those with no postings, like "assets", here), but does show
+# accounts that have postings with zero balance (like "assets:bank:checking"
+# here).
+$ hledger -f sample.journal balance --flat --empty
+                   0  assets:bank:checking
+                  $1  assets:bank:saving
+                 $-2  assets:cash
+                  $1  expenses:food
+                  $1  expenses:supplies
+                 $-1  income:gifts
+                 $-1  income:salary
+                  $1  liabilities:debts
+--------------------
+                   0  
+

hledger/test/balance/budget.test

@@ -50,7 +50,6 @@ Budget performance in 2016-12-01..2016-12-03:
                   ||          2016-12-01          2016-12-02           2016-12-03 
 ==================++==============================================================
  assets:cash      || $-10 [ 40% of $-25]  $-14 [56% of $-25]  $-51 [204% of $-25] 
- expenses         ||  $10 [ 40% of  $25]   $14 [56% of  $25]   $51 [204% of  $25] 
  expenses:cab     ||    0                    0                 $15                
  expenses:food    ||  $10 [100% of  $10]    $9 [90% of  $10]   $11 [110% of  $10] 
  expenses:leisure ||    0 [  0% of  $15]    $5 [33% of  $15]     0 [  0% of  $15] 
@@ -340,7 +339,6 @@ Budget performance in 2018-05-01..2018-06-30, valued at period ends:
                 || 2018-05-31           2018-06-30 
 ================++=================================
  <unbudgeted>   ||       €-10  €-10                
- assets         ||        €10   €10 [           0] 
  assets:bank    ||          0   €-1 [ 100% of €-1] 
  assets:pension ||        €10   €11 [1100% of  €1] 
 ----------------++---------------------------------
@@ -747,8 +745,7 @@ Budget performance in 2023-08:
 ==============++=================
  income       || 0 [0% of $-200] 
    employment || 0 [0% of $-100] 
-   gifts      || 0               
-     cash     || 0 [0% of $-100] 
+   gifts:cash || 0 [0% of $-100] 
 --------------++-----------------
               || 0 [0% of $-200] 
 

hledger/test/incomestatement.test

@@ -282,7 +282,7 @@ Quarterly Income Statement 2008
  expenses:food     ||       0   50.0 %       0       0   50.0 %   50.0 % 
  expenses:supplies ||       0   50.0 %       0       0   50.0 %   50.0 % 
 
-# ** 9. With --declared, declared leaf accounts are included, and in the right place.
+# ** 9. With --declared, declared accounts are included, and in the right place.
 <
 account revenues
 account revenues:aa
@@ -296,6 +296,7 @@ Income Statement ..
 =================++====
  Revenues        ||    
 -----------------++----
+ revenues        ||  0 
  revenues:aa     ||  0 
  revenues:ab     ||  0 
  revenues:ac:aca ||  0