balance report speedup

This refactoring fixes an O(n^2) slowdown in the balance command with large numbers of accounts. It's now speedy, and the implementation is clearer. To facilitate this, the Account type now represents a tree of accounts which can easily be traversed up or down (and/or flattened into a list). Benchmark on a 2010 macbook: +-------------------------------------------++--------------+------------+--------+ | || before: | after: | | | || hledger-0.18 | hledgeropt | ledger | +===========================================++==============+============+========+ | -f data/100x100x10.journal balance || 0.21 | 0.07 | 0.09 | | -f data/1000x1000x10.journal balance || 10.13 | 0.47 | 0.62 | | -f data/1000x10000x10.journal balance || 40.67 | 0.67 | 1.01 | | -f data/10000x1000x10.journal balance || 15.01 | 3.22 | 2.36 | | -f data/10000x1000x10.journal balance aa || 4.77 | 4.40 | 2.33 | +-------------------------------------------++--------------+------------+--------+
2012-10-21 17:18:18 +00:00 · 2012-10-21 17:18:18 +00:00 · 00f22819ae
commit 00f22819ae
parent cb2a4e543f
11 changed files with 558 additions and 722 deletions
--- a/hledger-lib/Hledger/Data/Account.hs
+++ b/hledger-lib/Hledger/Data/Account.hs
@ -1,31 +1,166 @@
+{-# LANGUAGE RecordWildCards, StandaloneDeriving #-}
 {-|

-An 'Account' stores

- an 'AccountName',
-
- all 'Posting's in the account, excluding subaccounts
-
- a 'MixedAmount' representing the account balance, including subaccounts.
+An 'Account' has a name, a list of subaccounts, an optional parent
+account, and subaccounting-excluding and -including balances.

 -}

 module Hledger.Data.Account
 where
+import Data.List
+import qualified Data.Map as M
+import Safe (headMay, lookupJustDef)
 import Test.HUnit
 import Text.Printf

+import Hledger.Data.AccountName
 import Hledger.Data.Amount
+import Hledger.Data.Posting()
 import Hledger.Data.Types
+import Hledger.Utils


+-- deriving instance Show Account
 instance Show Account where
-    show (Account a ps b) = printf "Account %s with %d postings and %s balance" a (length ps) (showMixedAmountDebug b)
+    show Account{..} = printf "Account %s (boring:%s, ebalance:%s, ibalance:%s)"
+                       aname  
+                       (if aboring then "y" else "n")
+                       (showMixedAmount aebalance)
+                       (showMixedAmount aibalance)

 instance Eq Account where
-    (==) (Account n1 t1 b1) (Account n2 t2 b2) = n1 == n2 && t1 == t2 && b1 == b2
+  (==) a b = aname a == aname b -- quick equality test for speed
+             -- and
+             -- [ aname a == aname b
+             -- -- , aparent a == aparent b  -- avoid infinite recursion
+             -- , asubs a == asubs b
+             -- , aebalance a == aebalance b
+             -- , aibalance a == aibalance b
+             -- ]
+
+nullacct = Account
+  { aname = ""
+  , aparent = Nothing
+  , asubs = []
+  , aebalance = nullmixedamt
+  , aibalance = nullmixedamt
+  , aboring = False
+  }
+
+-- | Derive an account tree with balances from a set of postings.
+-- (*ledger's core feature.) The accounts are returned in a list, but
+-- retain their tree structure; the first one is the root of the tree.
+accountsFromPostings :: [Posting] -> [Account]
+accountsFromPostings ps =
+  let
+    acctamts = [(paccount p,pamount p) | p <- ps]
+    grouped = groupBy (\a b -> fst a == fst b) $ sort $ acctamts
+    summed = map (\as@((aname,_):_) -> (aname, sum $ map snd as)) grouped -- always non-empty
+    setebalance a = a{aebalance=lookupJustDef nullmixedamt (aname a) summed}
+    nametree = treeFromPaths $ map (expandAccountName . fst) summed
+    acctswithnames = nameTreeToAccount "root" nametree
+    acctswithebals = mapAccounts setebalance acctswithnames
+    acctswithibals = sumAccounts acctswithebals
+    acctswithparents = tieAccountParents acctswithibals
+    acctsflattened = flattenAccounts acctswithparents
+  in
+    acctsflattened
+
+-- | Convert an AccountName tree to an Account tree
+nameTreeToAccount :: AccountName -> FastTree AccountName -> Account
+nameTreeToAccount rootname (T m) =
+    nullacct{ aname=rootname, asubs=map (uncurry nameTreeToAccount) $ M.assocs m }
+
+-- | Tie the knot so all subaccounts' parents are set correctly.
+tieAccountParents :: Account -> Account
+tieAccountParents = tie Nothing
+  where
+    tie parent a@Account{..} = a'
+      where
+        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{aparent=Nothing} = []
+parentAccounts Account{aparent=Just a} = a:parentAccounts a
+
+-- | List the accounts at each level of the account tree.
+accountsLevels :: Account -> [[Account]]
+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 f a = f a{asubs = map (mapAccounts f) $ asubs a}
+
+-- | Is the predicate true on any of this account or its subaccounts ?
+anyAccounts :: (Account -> Bool) -> Account -> Bool
+anyAccounts p a
+    | p a = True
+    | otherwise = any (anyAccounts p) $ asubs a
+
+-- | Add subaccount-inclusive balances to an account tree.
+-- -- , also noting
+-- -- whether it has an interesting balance or interesting subs to help
+-- -- with eliding later.
+sumAccounts :: Account -> Account
+sumAccounts a
+  | null $ asubs a = a{aibalance=aebalance a}
+  | otherwise      = a{aibalance=ibal, asubs=subs}
+  where
+    subs = map sumAccounts $ asubs a
+    ibal = sum $ aebalance a : map aibalance subs
+
+-- | Remove all subaccounts below a certain depth.
+clipAccounts :: Int -> Account -> Account
+clipAccounts 0 a = a{asubs=[]} 
+clipAccounts d a = a{asubs=subs}
+    where
+      subs = map (clipAccounts (d-1)) $ asubs a
+
+-- | Remove all leaf accounts and subtrees matching a predicate.
+pruneAccounts :: (Account -> Bool) -> Account -> Maybe Account
+pruneAccounts p = headMay . prune
+  where
+    prune a
+      | null prunedsubs = if p a then [] else [a]
+      | otherwise       = [a{asubs=prunedsubs}]
+      where
+        prunedsubs = concatMap prune $ asubs a
+
+-- | Flatten an account tree into a list, which is sometimes
+-- convenient. Note since accounts link to their parents/subs, the
+-- account tree remains intact and can still be used. It's a tree/list!
+flattenAccounts :: Account -> [Account]
+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 p a
+    | p a       = a : concatMap (filterAccounts p) (asubs a)
+    | otherwise = concatMap (filterAccounts p) (asubs a)
+
+-- | Search an account list by name.
+lookupAccount :: AccountName -> [Account] -> Maybe Account
+lookupAccount a = find ((==a).aname)
+
+-- debug helpers
+
+printAccounts :: Account -> IO ()
+printAccounts = putStrLn . showAccounts
+
+showAccounts = unlines . map showAccountDebug . flattenAccounts
+
+showAccountsBoringFlag = unlines . map (show . aboring) . flattenAccounts
+
+showAccountDebug a = printf "%-25s %4s %4s %s"
+                     (aname a)
+                     (showMixedAmount $ aebalance a)
+                     (showMixedAmount $ aibalance a)
+                     (if aboring a then "b" else " ")

-nullacct = Account "" [] nullmixedamt

 tests_Hledger_Data_Account = TestList [
 ]
--- a/hledger-lib/Hledger/Data/AccountName.hs
+++ b/hledger-lib/Hledger/Data/AccountName.hs
@ -10,11 +10,9 @@ hierarchy.
 module Hledger.Data.AccountName
 where
 import Data.List
-import Data.Map (Map)
 import Data.Tree
 import Test.HUnit
 import Text.Printf
-import qualified Data.Map as M

 import Hledger.Data.Types
 import Hledger.Utils
@ -42,8 +40,11 @@ accountNameDrop n = accountNameFromComponents . drop n . accountNameComponents

 -- | ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"]
 expandAccountNames :: [AccountName] -> [AccountName]
-expandAccountNames as = nub $ concatMap expand as
-    where expand = map accountNameFromComponents . tail . inits . accountNameComponents
+expandAccountNames as = nub $ concatMap expandAccountName as
+
+-- | "a:b:c" -> ["a","a:b","a:b:c"]
+expandAccountName :: AccountName -> [AccountName]
+expandAccountName = map accountNameFromComponents . tail . inits . accountNameComponents

 -- | ["a:b:c","d:e"] -> ["a","d"]
 topAccountNames :: [AccountName] -> [AccountName]
@ -72,83 +73,15 @@ subAccountNamesFrom accts a = filter (`isSubAccountNameOf` a) accts

 -- | Convert a list of account names to a tree.
 accountNameTreeFrom :: [AccountName] -> Tree AccountName
-accountNameTreeFrom = accountNameTreeFrom1
-
-accountNameTreeFrom1 accts = 
-    Node "top" (accounttreesfrom (topAccountNames accts))
+accountNameTreeFrom accts = 
+    Node "root" (accounttreesfrom (topAccountNames accts))
        where
          accounttreesfrom :: [AccountName] -> [Tree AccountName]
          accounttreesfrom [] = []
          accounttreesfrom as = [Node a (accounttreesfrom $ subs a) | a <- as]
          subs = subAccountNamesFrom (expandAccountNames accts)

-nullaccountnametree = Node "top" []
-
-accountNameTreeFrom2 accts = 
-   Node "top" $ unfoldForest (\a -> (a, subs a)) $ topAccountNames accts
-        where
-          subs = subAccountNamesFrom allaccts
-          allaccts = expandAccountNames accts
-          -- subs' a = subsmap ! a
-          -- subsmap :: Map AccountName [AccountName]
-          -- subsmap = Data.Map.fromList [(a, subAccountNamesFrom allaccts a) | a <- allaccts]
-
-accountNameTreeFrom3 accts = 
-    Node "top" $ forestfrom allaccts $ topAccountNames accts
-        where
-          -- drop accts from the list of potential subs as we add them to the tree
-          forestfrom :: [AccountName] -> [AccountName] -> Forest AccountName
-          forestfrom subaccts accts = 
-              [let subaccts' = subaccts \\ accts in Node a $ forestfrom subaccts' (subAccountNamesFrom subaccts' a) | a <- accts]
-          allaccts = expandAccountNames accts
-          
-
-- a more efficient tree builder from Cale Gibbard
-newtype Tree' a = T (Map a (Tree' a))
-  deriving (Show, Eq, Ord)
-
-mergeTrees :: (Ord a) => Tree' a -> Tree' a -> Tree' a
-mergeTrees (T m) (T m') = T (M.unionWith mergeTrees m m')
-
-emptyTree = T M.empty
-
-pathtree :: [a] -> Tree' a
-pathtree []     = T M.empty
-pathtree (x:xs) = T (M.singleton x (pathtree xs))
-
-fromPaths :: (Ord a) => [[a]] -> Tree' a
-fromPaths = foldl' mergeTrees emptyTree . map pathtree
-
-- the above, but trying to build Tree directly
-
-- mergeTrees' :: (Ord a) => Tree a -> Tree a -> Tree a
-- mergeTrees' (Node m ms) (Node m' ms') = Node undefined (ms `union` ms')
-
-- emptyTree' = Node "top" []
-
-- pathtree' :: [a] -> Tree a
-- pathtree' []     = Node undefined []
-- pathtree' (x:xs) = Node x [pathtree' xs]
-
-- fromPaths' :: (Ord a) => [[a]] -> Tree a
-- fromPaths' = foldl' mergeTrees' emptyTree' . map pathtree'
-
-
-- converttree :: [AccountName] -> Tree' AccountName -> [Tree AccountName]
-- converttree parents (T m) = [Node (accountNameFromComponents $ parents ++ [a]) (converttree (parents++[a]) b) | (a,b) <- M.toList m]
-
-- accountNameTreeFrom4 :: [AccountName] -> Tree AccountName
-- accountNameTreeFrom4 accts = Node "top" (converttree [] $ fromPaths $ map accountNameComponents accts)
-
-converttree :: Tree' AccountName -> [Tree AccountName]
-converttree (T m) = [Node a (converttree b) | (a,b) <- M.toList m]
-
-expandTreeNames :: Tree AccountName -> Tree AccountName
-expandTreeNames (Node x ts) = Node x (map (treemap (\n -> accountNameFromComponents [x,n]) . expandTreeNames) ts)
-
-accountNameTreeFrom4 :: [AccountName] -> Tree AccountName
-accountNameTreeFrom4 = Node "top" . map expandTreeNames . converttree . fromPaths . map accountNameComponents
-
+nullaccountnametree = Node "root" []

 -- | Elide an account name to fit in the specified width.
 -- From the ledger 2.6 news:
@ -199,10 +132,10 @@ isAccountRegex s = take 1 s == "^" && (take 5 $ reverse s) == ")$|:("
 tests_Hledger_Data_AccountName = TestList
 [
  "accountNameTreeFrom" ~: do
-    accountNameTreeFrom ["a"]       `is` Node "top" [Node "a" []]
-    accountNameTreeFrom ["a","b"]   `is` Node "top" [Node "a" [], Node "b" []]
-    accountNameTreeFrom ["a","a:b"] `is` Node "top" [Node "a" [Node "a:b" []]]
-    accountNameTreeFrom ["a:b:c"]   `is` Node "top" [Node "a" [Node "a:b" [Node "a:b:c" []]]]
+    accountNameTreeFrom ["a"]       `is` Node "root" [Node "a" []]
+    accountNameTreeFrom ["a","b"]   `is` Node "root" [Node "a" [], Node "b" []]
+    accountNameTreeFrom ["a","a:b"] `is` Node "root" [Node "a" [Node "a:b" []]]
+    accountNameTreeFrom ["a:b:c"]   `is` Node "root" [Node "a" [Node "a:b" [Node "a:b:c" []]]]

  ,"expandAccountNames" ~:
    expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] `is`
--- a/hledger-lib/Hledger/Data/Journal.hs
+++ b/hledger-lib/Hledger/Data/Journal.hs
@ -23,7 +23,6 @@ module Hledger.Data.Journal (
  filterJournalPostings,
  filterJournalTransactions,
  -- * Querying
-  journalAccountInfo,
  journalAccountNames,
  journalAccountNamesUsed,
  journalAmountAndPriceCommodities,
@ -43,7 +42,6 @@ module Hledger.Data.Journal (
  journalEquityAccountQuery,
  journalCashAccountQuery,
  -- * Misc
-  groupPostings,
  matchpats,
  nullctx,
  nulljournal,
@ -53,7 +51,7 @@ module Hledger.Data.Journal (
 )
 where
 import Data.List
-import Data.Map (findWithDefault, (!), toAscList)
+import Data.Map (findWithDefault)
 import Data.Ord
 import Data.Time.Calendar
 import Data.Time.LocalTime
@ -67,7 +65,6 @@ import qualified Data.Map as Map
 import Hledger.Utils
 import Hledger.Data.Types
 import Hledger.Data.AccountName
-import Hledger.Data.Account()
 import Hledger.Data.Amount
 import Hledger.Data.Commodity
 import Hledger.Data.Dates
@ -477,209 +474,6 @@ isnegativepat = (negateprefix `isPrefixOf`)

 abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat

-- | Calculate the account tree and all account balances from a journal's
-- postings, returning the results for efficient lookup.
-journalAccountInfo :: Journal -> (Tree AccountName, Map.Map AccountName Account)
-journalAccountInfo j = (ant, amap)
-    where
-      (ant, psof, _, inclbalof) = (groupPostings . journalPostings) j
-      amap = Map.fromList [(a, acctinfo a) | a <- flatten ant]
-      acctinfo a = Account a (psof a) (inclbalof a)
-
-tests_journalAccountInfo = [
- "journalAccountInfo" ~: do
-   let (t,m) = journalAccountInfo samplejournal
-   assertEqual "account tree"
-    (Node "top" [
-      Node "assets" [
-       Node "assets:bank" [
-        Node "assets:bank:checking" [],
-        Node "assets:bank:saving" []
-        ],
-       Node "assets:cash" []
-       ],
-      Node "expenses" [
-       Node "expenses:food" [],
-       Node "expenses:supplies" []
-       ],
-      Node "income" [
-       Node "income:gifts" [],
-       Node "income:salary" []
-       ],
-      Node "liabilities" [
-       Node "liabilities:debts" []
-       ]
-      ]
-     )
-    t
-   mapM_ 
-         (\(e,a) -> assertEqual "" e a)
-         (zip [
-               ("assets",Account "assets" [] (Mixed [dollars (-1)]))
-              ,("assets:bank",Account "assets:bank" [] (Mixed [dollars 1]))
-              ,("assets:bank:checking",Account "assets:bank:checking" [
-                  Posting {
-                    pstatus=False,
-                    paccount="assets:bank:checking",
-                    pamount=(Mixed [dollars 1]),
-                    pcomment="",
-                    ptype=RegularPosting,
-                    ptags=[],
-                    ptransaction=Nothing
-                  },
-                  Posting {
-                    pstatus=False,
-                    paccount="assets:bank:checking",
-                    pamount=(Mixed [dollars 1]),
-                    pcomment="",
-                    ptype=RegularPosting,
-                    ptags=[],
-                    ptransaction=Nothing
-                  },
-                  Posting {
-                    pstatus=False,
-                    paccount="assets:bank:checking",
-                    pamount=(Mixed [dollars (-1)]),
-                    pcomment="",
-                    ptype=RegularPosting,
-                    ptags=[],
-                    ptransaction=Nothing
-                  },
-                  Posting {
-                    pstatus=False,
-                    paccount="assets:bank:checking",
-                    pamount=(Mixed [dollars (-1)]),
-                    pcomment="",
-                    ptype=RegularPosting,
-                    ptags=[],
-                    ptransaction=Nothing
-                  }
-                  ] (Mixed [nullamt]))
-              ,("assets:bank:saving",Account "assets:bank:saving" [
-                  Posting {
-                    pstatus=False,
-                    paccount="assets:bank:saving",
-                    pamount=(Mixed [dollars 1]),
-                    pcomment="",
-                    ptype=RegularPosting,
-                    ptags=[],
-                    ptransaction=Nothing
-                  }
-                  ] (Mixed [dollars 1]))
-              ,("assets:cash",Account "assets:cash" [
-                  Posting {
-                    pstatus=False,
-                    paccount="assets:cash",
-                    pamount=(Mixed [dollars (-2)]),
-                    pcomment="",
-                    ptype=RegularPosting,
-                    ptags=[],
-                    ptransaction=Nothing
-                  }
-                ] (Mixed [dollars (-2)]))
-              ,("expenses",Account "expenses" [] (Mixed [dollars 2]))
-              ,("expenses:food",Account "expenses:food" [
-                  Posting {
-                    pstatus=False,
-                    paccount="expenses:food",
-                    pamount=(Mixed [dollars 1]),
-                    pcomment="",
-                    ptype=RegularPosting,
-                    ptags=[],
-                    ptransaction=Nothing
-                  }
-                ] (Mixed [dollars 1]))
-              ,("expenses:supplies",Account "expenses:supplies" [
-                  Posting {
-                    pstatus=False,
-                    paccount="expenses:supplies",
-                    pamount=(Mixed [dollars 1]),
-                    pcomment="",
-                    ptype=RegularPosting,
-                    ptags=[],
-                    ptransaction=Nothing
-                  }
-                ] (Mixed [dollars 1]))
-              ,("income",Account "income" [] (Mixed [dollars (-2)]))
-              ,("income:gifts",Account "income:gifts" [
-                  Posting {
-                    pstatus=False,
-                    paccount="income:gifts",
-                    pamount=(Mixed [dollars (-1)]),
-                    pcomment="",
-                    ptype=RegularPosting,
-                    ptags=[],
-                    ptransaction=Nothing
-                  }
-                ] (Mixed [dollars (-1)]))
-              ,("income:salary",Account "income:salary" [
-                  Posting {
-                    pstatus=False,
-                    paccount="income:salary",
-                    pamount=(Mixed [dollars (-1)]),
-                    pcomment="",
-                    ptype=RegularPosting,
-                    ptags=[],
-                    ptransaction=Nothing
-                  }
-                  ] (Mixed [dollars (-1)]))
-              ,("liabilities",Account "liabilities" [] (Mixed [dollars 1]))
-              ,("liabilities:debts",Account "liabilities:debts" [
-                  Posting {
-                    pstatus=False,
-                    paccount="liabilities:debts",
-                    pamount=(Mixed [dollars 1]),
-                    pcomment="",
-                    ptype=RegularPosting,
-                    ptags=[],
-                    ptransaction=Nothing
-                  }
-                ] (Mixed [dollars 1]))
-              ,("top",Account "top" [] (Mixed [nullamt]))
-             ]
-             (toAscList m)
-         )
- ]
-
-- | Given a list of postings, return an account name tree and three query
-- functions that fetch postings, subaccount-excluding-balance and
-- subaccount-including-balance by account name.
-groupPostings :: [Posting] -> (Tree AccountName,
-                               (AccountName -> [Posting]),
-                               (AccountName -> MixedAmount),
-                               (AccountName -> MixedAmount))
-groupPostings ps = (ant, psof, exclbalof, inclbalof)
-    where
-      anames = sort $ nub $ map paccount ps
-      ant = accountNameTreeFrom $ expandAccountNames anames
-      allanames = flatten ant
-      pmap = Map.union (postingsByAccount ps) (Map.fromList [(a,[]) | a <- allanames])
-      psof = (pmap !)
-      balmap = Map.fromList $ flatten $ calculateBalances ant psof
-      exclbalof = fst . (balmap !)
-      inclbalof = snd . (balmap !)
-
-- | Add subaccount-excluding and subaccount-including balances to a tree
-- of account names somewhat efficiently, given a function that looks up
-- transactions by account name.
-calculateBalances :: Tree AccountName -> (AccountName -> [Posting]) -> Tree (AccountName, (MixedAmount, MixedAmount))
-calculateBalances ant psof = addbalances ant
-    where
-      addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs'
-          where
-            bal         = sumPostings $ psof a
-            subsbal     = sum $ map (snd . snd . root) subs'
-            subs'       = map addbalances subs
-
-- | Convert a list of postings to a map from account name to that
-- account's postings.
-postingsByAccount :: [Posting] -> Map.Map AccountName [Posting]
-postingsByAccount ps = m'
-    where
-      sortedps = sortBy (comparing paccount) ps
-      groupedps = groupBy (\p1 p2 -> paccount p1 == paccount p2) sortedps
-      m' = Map.fromList [(paccount $ head g, g) | g <- groupedps]
-
 -- debug helpers
 -- traceAmountPrecision a = trace (show $ map (precision . commodity) $ amounts a) a
 -- tracePostingsCommodities ps = trace (show $ map ((map (precision . commodity) . amounts) . pamount) ps) ps
@ -885,11 +679,10 @@ Right samplejournal = journalBalanceTransactions $ Journal
          (TOD 0 0)

 tests_Hledger_Data_Journal = TestList $
-    tests_journalAccountInfo
-  -- [
+ [
  -- "query standard account types" ~:
  --  do
  --   let j = journal1
  --   journalBalanceSheetAccountNames j `is` ["assets","assets:a","equity","equity:q","equity:q:qq","liabilities","liabilities:l"]
  --   journalProfitAndLossAccountNames j `is` ["expenses","expenses:e","income","income:i"]
- -- ]
+ ]
--- a/hledger-lib/Hledger/Data/Ledger.hs
+++ b/hledger-lib/Hledger/Data/Ledger.hs
@ -9,90 +9,73 @@ balances, and postings in each account.

 module Hledger.Data.Ledger
 where
-import Data.Map (Map, findWithDefault, fromList)
-import Data.Tree
+import qualified Data.Map as M
+import Safe (headDef)
 import Test.HUnit
 import Text.Printf

-import Hledger.Utils
 import Hledger.Data.Types
-import Hledger.Data.Account (nullacct)
-import Hledger.Data.AccountName
+import Hledger.Data.Account
 import Hledger.Data.Journal
 import Hledger.Data.Posting
 import Hledger.Query


 instance Show Ledger where
-    show l = printf "Ledger with %d transactions, %d accounts\n%s"
-             (length (jtxns $ ledgerJournal l) +
-              length (jmodifiertxns $ ledgerJournal l) +
-              length (jperiodictxns $ ledgerJournal l))
+    show l = printf "Ledger with %d transactions, %d accounts\n" --"%s"
+             (length (jtxns $ ljournal l) +
+              length (jmodifiertxns $ ljournal l) +
+              length (jperiodictxns $ ljournal l))
             (length $ ledgerAccountNames l)
-             (showtree $ ledgerAccountNameTree l)
+             -- (showtree $ ledgerAccountNameTree l)

 nullledger :: Ledger
-nullledger = Ledger{
-      ledgerJournal = nulljournal,
-      ledgerAccountNameTree = nullaccountnametree,
-      ledgerAccountMap = fromList []
-    }
+nullledger = Ledger {
+  ljournal = nulljournal,
+  laccounts = []
+  }

-- | Filter a journal's transactions as specified, and then process them
-- to derive a ledger containing all balances, the chart of accounts,
-- canonicalised commodities etc.
-journalToLedger :: Query -> Journal -> Ledger
-journalToLedger q j = nullledger{ledgerJournal=j',ledgerAccountNameTree=t,ledgerAccountMap=amap}
-    where j' = filterJournalPostings q j
-          (t, amap) = journalAccountInfo j'
-
-tests_journalToLedger = [
- "journalToLedger" ~: do
-  assertEqual "" (0) (length $ ledgerPostings $ journalToLedger Any nulljournal)
-  assertEqual "" (11) (length $ ledgerPostings $ journalToLedger Any samplejournal)
-  assertEqual "" (6) (length $ ledgerPostings $ journalToLedger (Depth 2) samplejournal)
- ]
+-- | Filter a journal's transactions with the given query, then derive a
+-- ledger containing the chart of accounts and balances. If the query
+-- includes a depth limit, that will affect the ledger's journal but not
+-- the account tree.
+ledgerFromJournal :: Query -> Journal -> Ledger
+ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as}
+  where
+    (q',depthq)  = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q)
+    j' = filterJournalPostings q' j
+    as = accountsFromPostings $ journalPostings j'
+    j'' = filterJournalPostings depthq j'

 -- | List a ledger's account names.
 ledgerAccountNames :: Ledger -> [AccountName]
-ledgerAccountNames = drop 1 . flatten . ledgerAccountNameTree
+ledgerAccountNames = drop 1 . map aname . laccounts

 -- | Get the named account from a ledger.
-ledgerAccount :: Ledger -> AccountName -> Account
-ledgerAccount l a = findWithDefault nullacct a $ ledgerAccountMap l
+ledgerAccount :: Ledger -> AccountName -> Maybe Account
+ledgerAccount l a = lookupAccount a $ laccounts l

-- | List a ledger's accounts, in tree order
-ledgerAccounts :: Ledger -> [Account]
-ledgerAccounts = drop 1 . flatten . ledgerAccountTree 9999
+-- | 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 = headDef nullacct . laccounts

-- | List a ledger's top-level accounts, in tree order
+-- | List a ledger's top-level accounts (the ones below the root), in tree order.
 ledgerTopAccounts :: Ledger -> [Account]
-ledgerTopAccounts = map root . branches . ledgerAccountTree 9999
+ledgerTopAccounts = asubs . head . laccounts

-- | List a ledger's bottom-level (subaccount-less) accounts, in tree order
+-- | List a ledger's bottom-level (subaccount-less) accounts, in tree order.
 ledgerLeafAccounts :: Ledger -> [Account]
-ledgerLeafAccounts = leaves . ledgerAccountTree 9999
+ledgerLeafAccounts = filter (null.asubs) . laccounts

 -- | Accounts in ledger whose name matches the pattern, in tree order.
 ledgerAccountsMatching :: [String] -> Ledger -> [Account]
-ledgerAccountsMatching pats = filter (matchpats pats . aname) . ledgerAccounts
-
-- | List a ledger account's immediate subaccounts
-ledgerSubAccounts :: Ledger -> Account -> [Account]
-ledgerSubAccounts l Account{aname=a} = 
-    map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ ledgerAccountNames l
+ledgerAccountsMatching pats = filter (matchpats pats . aname) . laccounts

 -- | List a ledger's postings, in the order parsed.
 ledgerPostings :: Ledger -> [Posting]
-ledgerPostings = journalPostings . ledgerJournal
-
-- | Get a ledger's tree of accounts to the specified depth.
-ledgerAccountTree :: Int -> Ledger -> Tree Account
-ledgerAccountTree depth l = treemap (ledgerAccount l) $ treeprune depth $ ledgerAccountNameTree l
-
-- | Get a ledger's tree of accounts rooted at the specified account.
-ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account)
-ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
+ledgerPostings = journalPostings . ljournal

 -- | The (fully specified) date span containing all the ledger's (filtered) transactions,
 -- or DateSpan Nothing Nothing if there are none.
@ -100,9 +83,16 @@ ledgerDateSpan :: Ledger -> DateSpan
 ledgerDateSpan = postingsDateSpan . ledgerPostings

 -- | All commodities used in this ledger, as a map keyed by symbol.
-ledgerCommodities :: Ledger -> Map String Commodity
-ledgerCommodities = journalCanonicalCommodities . ledgerJournal
+ledgerCommodities :: Ledger -> M.Map String Commodity
+ledgerCommodities = journalCanonicalCommodities . ljournal
+
+
+tests_ledgerFromJournal = [
+ "ledgerFromJournal" ~: do
+  assertEqual "" (0) (length $ ledgerPostings $ ledgerFromJournal Any nulljournal)
+  assertEqual "" (11) (length $ ledgerPostings $ ledgerFromJournal Any samplejournal)
+  assertEqual "" (6) (length $ ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal)
+ ]

 tests_Hledger_Data_Ledger = TestList $
-    tests_journalToLedger
-
+    tests_ledgerFromJournal
--- a/hledger-lib/Hledger/Data/Types.hs
+++ b/hledger-lib/Hledger/Data/Types.hs
@ -11,23 +11,10 @@ Here is an overview of the hledger data model:
 >
 > Ledger                   -- a ledger is derived from a journal, by applying a filter specification and doing some further processing. It contains..
 >  Journal                 -- a filtered copy of the original journal, containing only the transactions and postings we are interested in
->  Tree AccountName        -- all accounts named by the journal's transactions, as a hierarchy
->  Map AccountName Account -- the postings, and resulting balances, in each account
+>  [Account]               -- all accounts, in tree order beginning with a "root" account", with their balances and sub/parent accounts

 For more detailed documentation on each type, see the corresponding modules.

-Evolution of transaction\/entry\/posting terminology:
-
-  - ledger 2:    entries contain transactions
-
-  - hledger 0.4: Entrys contain RawTransactions (which are flattened to Transactions)
-
-  - ledger 3:    transactions contain postings
-
-  - hledger 0.5: LedgerTransactions contain Postings (which are flattened to Transactions)
-
-  - hledger 0.8: Transactions contain Postings (referencing Transactions..)
-
 -}

 module Hledger.Data.Types
@ -35,9 +22,7 @@ where
 import Control.Monad.Error (ErrorT)
 import Data.Time.Calendar
 import Data.Time.LocalTime
-import Data.Tree
 import Data.Typeable
-import qualified Data.Map as Map
 import System.Time (ClockTime)


@ -99,7 +84,7 @@ data Posting = Posting {
      ptype :: PostingType,
      ptags :: [Tag],
      ptransaction :: Maybe Transaction  -- ^ this posting's parent transaction (co-recursive types).
-                                        -- Tying this knot gets tedious, Maybe makes it easier/optional.
+                                         -- Tying this knot gets tedious, Maybe makes it easier/optional.
    }

 -- The equality test for postings ignores the parent transaction's
@ -115,7 +100,7 @@ data Transaction = Transaction {
      tdescription :: String,
      tcomment :: String, -- ^ this transaction's non-tag comment lines, as a single non-indented string
      ttags :: [Tag],
-      tpostings :: [Posting],            -- ^ this transaction's postings (co-recursive types).
+      tpostings :: [Posting],            -- ^ this transaction's postings
      tpreceding_comment_lines :: String
    } deriving (Eq)

@ -248,15 +233,23 @@ data FormatString =
  deriving (Show, Eq)


-data Ledger = Ledger {
-      ledgerJournal :: Journal,
-      ledgerAccountNameTree :: Tree AccountName,
-      ledgerAccountMap :: Map.Map AccountName Account
-    }
-
+-- | An account, with name, balances and links to parent/subaccounts
+-- which let you walk up or down the account tree.
 data Account = Account {
-      aname :: AccountName,
-      apostings :: [Posting],    -- ^ postings in this account
-      abalance :: MixedAmount    -- ^ sum of postings in this account and subaccounts
-    } -- deriving (Eq)  XXX
+  aname :: AccountName,     -- ^ this account's full name
+  aebalance :: MixedAmount, -- ^ this account's balance, excluding subaccounts
+  asubs :: [Account],       -- ^ sub-accounts
+  -- derived from the above:
+  aibalance :: MixedAmount, -- ^ this account's balance, including subaccounts
+  aparent :: Maybe Account, -- ^ parent account
+  aboring :: Bool           -- ^ used in the accounts report to label elidable parents
+  }

+-- | A Ledger has the journal it derives from, and the accounts
+-- derived from that. Accounts are accessible both list-wise and
+-- tree-wise, since each one knows its parent and subs; the first
+-- account is the root of the tree and always exists.
+data Ledger = Ledger {
+  ljournal :: Journal,
+  laccounts :: [Account]
+}
--- a/hledger-lib/Hledger/Reports.hs
+++ b/hledger-lib/Hledger/Reports.hs
@ -42,7 +42,6 @@ module Hledger.Reports (
  AccountsReport,
  AccountsReportItem,
  accountsReport,
-  isInteresting,
  -- * Tests
  tests_Hledger_Reports
 )
@ -51,6 +50,7 @@ where
 import Control.Monad
 import Data.List
 import Data.Maybe
+-- import qualified Data.Map as M
 import Data.Ord
 import Data.Time.Calendar
 -- import Data.Tree
@ -151,6 +151,9 @@ clearedValueFromOpts ReportOpts{..} | cleared_   = Just True
                                    | uncleared_ = Just False
                                    | otherwise  = Nothing

+-- depthFromOpts :: ReportOpts -> Int
+-- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)
+
 -- | Report which date we will report on based on --effective.
 whichDateFromOpts :: ReportOpts -> WhichDate
 whichDateFromOpts ReportOpts{..} = if effective_ then EffectiveDate else ActualDate
@ -284,6 +287,297 @@ postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $
                 | otherwise = requestedspan `spanIntersect` matchedspan
      startbal = sumPostings precedingps

+totallabel = "Total"
+balancelabel = "Balance"
+
+-- | Generate postings report line items.
+postingsReportItems :: [Posting] -> Posting -> Int -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingsReportItem]
+postingsReportItems [] _ _ _ _ = []
+postingsReportItems (p:ps) pprev d b sumfn = i:(postingsReportItems ps p d b' sumfn)
+    where
+      i = mkpostingsReportItem isfirst p' b'
+      p' = p{paccount=clipAccountName d $ paccount p}
+      isfirst = ptransaction p /= ptransaction pprev
+      b' = b `sumfn` pamount p
+
+-- | Generate one postings report line item, given a flag indicating
+-- whether to include transaction info, the posting, and the current
+-- running balance.
+mkpostingsReportItem :: Bool -> Posting -> MixedAmount -> PostingsReportItem
+mkpostingsReportItem False p b = (Nothing, p, b)
+mkpostingsReportItem True p b = (ds, p, b)
+    where ds = case ptransaction p of Just (Transaction{tdate=da,tdescription=de}) -> Just (da,de)
+                                      Nothing -> Just (nulldate,"")
+
+-- | Date-sort and split a list of postings into three spans - postings matched
+-- by the given display expression, and the preceding and following postings.
+postingsMatchingDisplayExpr :: Maybe String -> [Posting] -> ([Posting],[Posting],[Posting])
+postingsMatchingDisplayExpr d ps = (before, matched, after)
+    where
+      sorted = sortBy (comparing postingDate) ps
+      (before, rest) = break (displayExprMatches d) sorted
+      (matched, after) = span (displayExprMatches d) rest
+
+-- | Does this display expression allow this posting to be displayed ?
+-- Raises an error if the display expression can't be parsed.
+displayExprMatches :: Maybe String -> Posting -> Bool
+displayExprMatches Nothing  _ = True
+displayExprMatches (Just d) p = (fromparse $ parsewith datedisplayexpr d) p
+
+-- | Parse a hledger display expression, which is a simple date test like
+-- "d>[DATE]" or "d<=[DATE]", and return a "Posting"-matching predicate.
+datedisplayexpr :: GenParser Char st (Posting -> Bool)
+datedisplayexpr = do
+  char 'd'
+  op <- compareop
+  char '['
+  (y,m,d) <- smartdate
+  char ']'
+  let date    = parsedate $ printf "%04s/%02s/%02s" y m d
+      test op = return $ (`op` date) . postingDate
+  case op of
+    "<"  -> test (<)
+    "<=" -> test (<=)
+    "="  -> test (==)
+    "==" -> test (==)
+    ">=" -> test (>=)
+    ">"  -> test (>)
+    _    -> mzero
+ where
+  compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
+
+-- -- | Clip the account names to the specified depth in a list of postings.
+-- depthClipPostings :: Maybe Int -> [Posting] -> [Posting]
+-- depthClipPostings depth = map (depthClipPosting depth)
+
+-- -- | Clip a posting's account name to the specified depth.
+-- depthClipPosting :: Maybe Int -> Posting -> Posting
+-- depthClipPosting Nothing p = p
+-- depthClipPosting (Just d) p@Posting{paccount=a} = p{paccount=clipAccountName d a}
+
+-- XXX confusing, refactor
+
+-- | Convert a list of postings into summary postings. Summary postings
+-- are one per account per interval and aggregated to the specified depth
+-- if any.
+summarisePostingsByInterval :: Interval -> Int -> Bool -> DateSpan -> [Posting] -> [Posting]
+summarisePostingsByInterval interval depth empty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan
+    where
+      summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)
+      postingsinspan s = filter (isPostingInDateSpan s) ps
+
+tests_summarisePostingsByInterval = [
+  "summarisePostingsByInterval" ~: do
+    summarisePostingsByInterval (Quarters 1) 99999 False (DateSpan Nothing Nothing) [] ~?= []
+ ]
+
+-- | Given a date span (representing a reporting interval) and a list of
+-- postings within it: aggregate the postings so there is only one per
+-- account, and adjust their date/description so that they will render
+-- as a summary for this interval.
+--
+-- As usual with date spans the end date is exclusive, but for display
+-- purposes we show the previous day as end date, like ledger.
+--
+-- When a depth argument is present, postings to accounts of greater
+-- depth are aggregated where possible.
+--
+-- The showempty flag includes spans with no postings and also postings
+-- with 0 amount.
+summarisePostingsInDateSpan :: DateSpan -> Int -> Bool -> [Posting] -> [Posting]
+summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
+    | null ps && (isNothing b || isNothing e) = []
+    | null ps && showempty = [summaryp]
+    | otherwise = summaryps'
+    where
+      summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e'))
+      b' = fromMaybe (maybe nulldate postingDate $ headMay ps) b
+      e' = fromMaybe (maybe (addDays 1 nulldate) postingDate $ lastMay ps) e
+      summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}
+      summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps
+      summaryps = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]
+      clippedanames = nub $ map (clipAccountName depth) anames
+      anames = sort $ nub $ map paccount ps
+      -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping
+      accts = accountsFromPostings ps
+      balance a = maybe nullmixedamt bal $ lookupAccount a accts 
+        where
+          bal = if isclipped a then aibalance else aebalance
+          isclipped a = accountNameLevel a >= depth
+
+-------------------------------------------------------------------------------
+
+-- | A transactions report includes a list of transactions
+-- (posting-filtered and unfiltered variants), a running balance, and some
+-- other information helpful for rendering a register view (a flag
+-- indicating multiple other accounts and a display string describing
+-- them) with or without a notion of current account(s).
+type TransactionsReport = (String                   -- label for the balance column, eg "balance" or "total"
+                          ,[TransactionsReportItem] -- line items, one per transaction
+                          )
+type TransactionsReportItem = (Transaction -- the corresponding transaction
+                              ,Transaction -- the transaction with postings to the current account(s) removed
+                              ,Bool        -- is this a split, ie more than one other account posting
+                              ,String      -- a display string describing the other account(s), if any
+                              ,MixedAmount -- the amount posted to the current account(s) (or total amount posted)
+                              ,MixedAmount -- the running balance for the current account(s) after this transaction
+                              )
+
+triDate (t,_,_,_,_,_) = tdate t
+triBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"
+                                           (Amount{quantity=q}):_ -> show q
+
+-- | Select transactions from the whole journal for a transactions report,
+-- with no \"current\" account. The end result is similar to
+-- "postingsReport" except it uses queries and transaction-based report
+-- items and the items are most recent first. Used by eg hledger-web's
+-- journal view.
+journalTransactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport
+journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)
+   where
+     ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts
+     items = reverse $ accountTransactionsReportItems m Nothing nullmixedamt id ts'
+     -- XXX items' first element should be the full transaction with all postings
+
+-------------------------------------------------------------------------------
+
+-- | Select transactions within one or more \"current\" accounts, and make a
+-- transactions report relative to those account(s). This means:
+--
+-- 1. it shows transactions from the point of view of the current account(s).
+--    The transaction amount is the amount posted to the current account(s).
+--    The other accounts' names are provided. 
+--
+-- 2. With no transaction filtering in effect other than a start date, it
+--    shows the accurate historical running balance for the current account(s).
+--    Otherwise it shows a running total starting at 0.
+--
+-- Currently, reporting intervals are not supported, and report items are
+-- most recent first. Used by eg hledger-web's account register view.
+--
+accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> TransactionsReport
+accountTransactionsReport opts j m thisacctquery = (label, items)
+ where
+     -- transactions affecting this account, in date order
+     ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctquery) $ jtxns $
+          journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
+     -- starting balance: if we are filtering by a start date and nothing else,
+     -- the sum of postings to this account before that date; otherwise zero.
+     (startbal,label) | queryIsNull m                           = (nullmixedamt,        balancelabel)
+                      | queryIsStartDateOnly (effective_ opts) m = (sumPostings priorps, balancelabel)
+                      | otherwise                                 = (nullmixedamt,        totallabel)
+                      where
+                        priorps = -- ltrace "priorps" $
+                                  filter (matchesPosting
+                                          (-- ltrace "priormatcher" $
+                                           And [thisacctquery, tostartdatequery]))
+                                         $ transactionsPostings ts
+                        tostartdatequery = Date (DateSpan Nothing startdate)
+                        startdate = queryStartDate (effective_ opts) m
+     items = reverse $ accountTransactionsReportItems m (Just thisacctquery) startbal negate ts
+
+-- | Generate transactions report items from a list of transactions,
+-- using the provided query and current account queries, starting balance,
+-- sign-setting function and balance-summing function.
+accountTransactionsReportItems :: Query -> Maybe Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem]
+accountTransactionsReportItems _ _ _ _ [] = []
+accountTransactionsReportItems query thisacctquery bal signfn (t:ts) =
+    -- This is used for both accountTransactionsReport and journalTransactionsReport,
+    -- which makes it a bit overcomplicated
+    case i of Just i' -> i':is
+              Nothing -> is
+    where
+      tmatched@Transaction{tpostings=psmatched} = filterTransactionPostings query t
+      (psthisacct,psotheracct) = case thisacctquery of Just m  -> partition (matchesPosting m) psmatched
+                                                       Nothing -> ([],psmatched)
+      numotheraccts = length $ nub $ map paccount psotheracct
+      amt = negate $ sum $ map pamount psthisacct
+      acct | isNothing thisacctquery = summarisePostings psmatched -- journal register
+           | numotheraccts == 0 = "transfer between " ++ summarisePostingAccounts psthisacct
+           | otherwise          = prefix              ++ summarisePostingAccounts psotheracct
+           where prefix = maybe "" (\b -> if b then "from " else "to ") $ isNegativeMixedAmount amt
+      (i,bal') = case psmatched of
+           [] -> (Nothing,bal)
+           _  -> (Just (t, tmatched, numotheraccts > 1, acct, a, b), b)
+                 where
+                  a = signfn amt
+                  b = bal + a
+      is = accountTransactionsReportItems query thisacctquery bal' signfn ts
+
+-- | Generate a short readable summary of some postings, like
+-- "from (negatives) to (positives)".
+summarisePostings :: [Posting] -> String
+summarisePostings ps =
+    case (summarisePostingAccounts froms, summarisePostingAccounts tos) of
+       ("",t) -> "to "++t
+       (f,"") -> "from "++f
+       (f,t)  -> "from "++f++" to "++t
+    where
+      (froms,tos) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps
+
+-- | Generate a simplified summary of some postings' accounts.
+summarisePostingAccounts :: [Posting] -> String
+summarisePostingAccounts = intercalate ", " . map accountLeafName . nub . map paccount
+
+filterTransactionPostings :: Query -> Transaction -> Transaction
+filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}
+
+-------------------------------------------------------------------------------
+
+-- | An accounts report is a list of account names (full and short
+-- variants) with their balances, appropriate indentation for rendering as
+-- a hierarchy, and grand total.
+type AccountsReport = ([AccountsReportItem] -- line items, one per account
+                      ,MixedAmount          -- total balance of all accounts
+                      )
+type AccountsReportItem = (AccountName  -- full account name
+                          ,AccountName  -- short account name for display (the leaf name, prefixed by any boring parents immediately above)
+                          ,Int          -- how many steps to indent this account (0-based account depth excluding boring parents)
+                          ,MixedAmount) -- account balance, includes subs unless --flat is present
+
+-- | Select accounts, and get their balances at the end of the selected
+-- period, and misc. display information, for an accounts report.
+accountsReport :: ReportOpts -> Query -> Journal -> AccountsReport
+accountsReport opts q j = (items, total)
+    where
+      l =  ledgerFromJournal q $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
+      accts = clipAccounts (queryDepth q) $ ledgerRootAccount l
+      accts'
+          | flat_ opts = filterzeros $ tail $ flattenAccounts accts
+          | otherwise  = filter (not.aboring) $ tail $ flattenAccounts $ markboring $ prunezeros accts
+          where
+            filterzeros | empty_ opts = id
+                        | otherwise = filter (not . isZeroMixedAmount . aebalance)
+            prunezeros | empty_ opts = id
+                       | otherwise   = fromMaybe nullacct . pruneAccounts (isZeroMixedAmount.aibalance)
+            markboring | no_elide_ opts = id
+                       | otherwise      = markBoringParentAccounts
+      items = map (accountsReportItem opts) accts'
+      total = sum [amt | (_,_,depth,amt) <- items, depth==0]
+
+-- | In an account tree with zero-balance leaves removed, mark the
+-- elidable parent accounts (those with one subaccount and no balance
+-- of their own).
+markBoringParentAccounts :: Account -> Account
+markBoringParentAccounts = tieAccountParents . mapAccounts mark
+  where
+    mark a | length (asubs a) == 1 && isZeroMixedAmount (aebalance a) = a{aboring=True}
+           | otherwise = a
+
+accountsReportItem :: ReportOpts -> Account -> AccountsReportItem
+accountsReportItem opts a@Account{aname=name, aibalance=ibal}
+  | flat_ opts = (name, name,       0,     ibal)
+  | otherwise  = (name, elidedname, depth, ibal)
+  where
+    elidedname = accountNameFromComponents (adjacentboringparentnames ++ [accountLeafName name])
+    adjacentboringparentnames = reverse $ map (accountLeafName.aname) $ takeWhile aboring $ parents
+    depth = length $ filter (not.aboring) parents
+    parents = init $ parentAccounts a
+
+
+-------------------------------------------------------------------------------
+-- TESTS
+
 tests_postingsReport = [
  "postingsReport" ~: do

@ -450,284 +744,6 @@ tests_postingsReport = [
 -}
 ]

-totallabel = "Total"
-balancelabel = "Balance"
-
-- | Generate postings report line items.
-postingsReportItems :: [Posting] -> Posting -> Int -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingsReportItem]
-postingsReportItems [] _ _ _ _ = []
-postingsReportItems (p:ps) pprev d b sumfn = i:(postingsReportItems ps p d b' sumfn)
-    where
-      i = mkpostingsReportItem isfirst p' b'
-      p' = p{paccount=clipAccountName d $ paccount p}
-      isfirst = ptransaction p /= ptransaction pprev
-      b' = b `sumfn` pamount p
-
-- | Generate one postings report line item, given a flag indicating
-- whether to include transaction info, the posting, and the current
-- running balance.
-mkpostingsReportItem :: Bool -> Posting -> MixedAmount -> PostingsReportItem
-mkpostingsReportItem False p b = (Nothing, p, b)
-mkpostingsReportItem True p b = (ds, p, b)
-    where ds = case ptransaction p of Just (Transaction{tdate=da,tdescription=de}) -> Just (da,de)
-                                      Nothing -> Just (nulldate,"")
-
-- | Date-sort and split a list of postings into three spans - postings matched
-- by the given display expression, and the preceding and following postings.
-postingsMatchingDisplayExpr :: Maybe String -> [Posting] -> ([Posting],[Posting],[Posting])
-postingsMatchingDisplayExpr d ps = (before, matched, after)
-    where
-      sorted = sortBy (comparing postingDate) ps
-      (before, rest) = break (displayExprMatches d) sorted
-      (matched, after) = span (displayExprMatches d) rest
-
-- | Does this display expression allow this posting to be displayed ?
-- Raises an error if the display expression can't be parsed.
-displayExprMatches :: Maybe String -> Posting -> Bool
-displayExprMatches Nothing  _ = True
-displayExprMatches (Just d) p = (fromparse $ parsewith datedisplayexpr d) p
-
-- | Parse a hledger display expression, which is a simple date test like
-- "d>[DATE]" or "d<=[DATE]", and return a "Posting"-matching predicate.
-datedisplayexpr :: GenParser Char st (Posting -> Bool)
-datedisplayexpr = do
-  char 'd'
-  op <- compareop
-  char '['
-  (y,m,d) <- smartdate
-  char ']'
-  let date    = parsedate $ printf "%04s/%02s/%02s" y m d
-      test op = return $ (`op` date) . postingDate
-  case op of
-    "<"  -> test (<)
-    "<=" -> test (<=)
-    "="  -> test (==)
-    "==" -> test (==)
-    ">=" -> test (>=)
-    ">"  -> test (>)
-    _    -> mzero
- where
-  compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
-
-- -- | Clip the account names to the specified depth in a list of postings.
-- depthClipPostings :: Maybe Int -> [Posting] -> [Posting]
-- depthClipPostings depth = map (depthClipPosting depth)
-
-- -- | Clip a posting's account name to the specified depth.
-- depthClipPosting :: Maybe Int -> Posting -> Posting
-- depthClipPosting Nothing p = p
-- depthClipPosting (Just d) p@Posting{paccount=a} = p{paccount=clipAccountName d a}
-
-- XXX confusing, refactor
-
-- | Convert a list of postings into summary postings. Summary postings
-- are one per account per interval and aggregated to the specified depth
-- if any.
-summarisePostingsByInterval :: Interval -> Int -> Bool -> DateSpan -> [Posting] -> [Posting]
-summarisePostingsByInterval interval depth empty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan
-    where
-      summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)
-      postingsinspan s = filter (isPostingInDateSpan s) ps
-
-tests_summarisePostingsByInterval = [
-  "summarisePostingsByInterval" ~: do
-    summarisePostingsByInterval (Quarters 1) 99999 False (DateSpan Nothing Nothing) [] ~?= []
- ]
-
-- | Given a date span (representing a reporting interval) and a list of
-- postings within it: aggregate the postings so there is only one per
-- account, and adjust their date/description so that they will render
-- as a summary for this interval.
--
-- As usual with date spans the end date is exclusive, but for display
-- purposes we show the previous day as end date, like ledger.
--
-- When a depth argument is present, postings to accounts of greater
-- depth are aggregated where possible.
--
-- The showempty flag includes spans with no postings and also postings
-- with 0 amount.
-summarisePostingsInDateSpan :: DateSpan -> Int -> Bool -> [Posting] -> [Posting]
-summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
-    | null ps && (isNothing b || isNothing e) = []
-    | null ps && showempty = [summaryp]
-    | otherwise = summaryps'
-    where
-      summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e'))
-      b' = fromMaybe (maybe nulldate postingDate $ headMay ps) b
-      e' = fromMaybe (maybe (addDays 1 nulldate) postingDate $ lastMay ps) e
-      summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}
-
-      summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps
-      summaryps = [summaryp{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames]
-      anames = sort $ nub $ map paccount ps
-      -- aggregate balances by account, like journalToLedger, then do depth-clipping
-      (_,_,exclbalof,inclbalof) = groupPostings ps
-      clippedanames = nub $ map (clipAccountName depth) anames
-      isclipped a = accountNameLevel a >= depth
-      balancetoshowfor a =
-          (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)
-
-------------------------------------------------------------------------------
-
-- | A transactions report includes a list of transactions
-- (posting-filtered and unfiltered variants), a running balance, and some
-- other information helpful for rendering a register view (a flag
-- indicating multiple other accounts and a display string describing
-- them) with or without a notion of current account(s).
-type TransactionsReport = (String                   -- label for the balance column, eg "balance" or "total"
-                          ,[TransactionsReportItem] -- line items, one per transaction
-                          )
-type TransactionsReportItem = (Transaction -- the corresponding transaction
-                              ,Transaction -- the transaction with postings to the current account(s) removed
-                              ,Bool        -- is this a split, ie more than one other account posting
-                              ,String      -- a display string describing the other account(s), if any
-                              ,MixedAmount -- the amount posted to the current account(s) (or total amount posted)
-                              ,MixedAmount -- the running balance for the current account(s) after this transaction
-                              )
-
-triDate (t,_,_,_,_,_) = tdate t
-triBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"
-                                           (Amount{quantity=q}):_ -> show q
-
-- | Select transactions from the whole journal for a transactions report,
-- with no \"current\" account. The end result is similar to
-- "postingsReport" except it uses queries and transaction-based report
-- items and the items are most recent first. Used by eg hledger-web's
-- journal view.
-journalTransactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport
-journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)
-   where
-     ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts
-     items = reverse $ accountTransactionsReportItems m Nothing nullmixedamt id ts'
-     -- XXX items' first element should be the full transaction with all postings
-
-------------------------------------------------------------------------------
-
-- | Select transactions within one or more \"current\" accounts, and make a
-- transactions report relative to those account(s). This means:
--
-- 1. it shows transactions from the point of view of the current account(s).
--    The transaction amount is the amount posted to the current account(s).
--    The other accounts' names are provided. 
--
-- 2. With no transaction filtering in effect other than a start date, it
--    shows the accurate historical running balance for the current account(s).
--    Otherwise it shows a running total starting at 0.
--
-- Currently, reporting intervals are not supported, and report items are
-- most recent first. Used by eg hledger-web's account register view.
--
-accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> TransactionsReport
-accountTransactionsReport opts j m thisacctquery = (label, items)
- where
-     -- transactions affecting this account, in date order
-     ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctquery) $ jtxns $
-          journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
-     -- starting balance: if we are filtering by a start date and nothing else,
-     -- the sum of postings to this account before that date; otherwise zero.
-     (startbal,label) | queryIsNull m                           = (nullmixedamt,        balancelabel)
-                      | queryIsStartDateOnly (effective_ opts) m = (sumPostings priorps, balancelabel)
-                      | otherwise                                 = (nullmixedamt,        totallabel)
-                      where
-                        priorps = -- ltrace "priorps" $
-                                  filter (matchesPosting
-                                          (-- ltrace "priormatcher" $
-                                           And [thisacctquery, tostartdatequery]))
-                                         $ transactionsPostings ts
-                        tostartdatequery = Date (DateSpan Nothing startdate)
-                        startdate = queryStartDate (effective_ opts) m
-     items = reverse $ accountTransactionsReportItems m (Just thisacctquery) startbal negate ts
-
-- | Generate transactions report items from a list of transactions,
-- using the provided query and current account queries, starting balance,
-- sign-setting function and balance-summing function.
-accountTransactionsReportItems :: Query -> Maybe Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem]
-accountTransactionsReportItems _ _ _ _ [] = []
-accountTransactionsReportItems query thisacctquery bal signfn (t:ts) =
-    -- This is used for both accountTransactionsReport and journalTransactionsReport,
-    -- which makes it a bit overcomplicated
-    case i of Just i' -> i':is
-              Nothing -> is
-    where
-      tmatched@Transaction{tpostings=psmatched} = filterTransactionPostings query t
-      (psthisacct,psotheracct) = case thisacctquery of Just m  -> partition (matchesPosting m) psmatched
-                                                       Nothing -> ([],psmatched)
-      numotheraccts = length $ nub $ map paccount psotheracct
-      amt = negate $ sum $ map pamount psthisacct
-      acct | isNothing thisacctquery = summarisePostings psmatched -- journal register
-           | numotheraccts == 0 = "transfer between " ++ summarisePostingAccounts psthisacct
-           | otherwise          = prefix              ++ summarisePostingAccounts psotheracct
-           where prefix = maybe "" (\b -> if b then "from " else "to ") $ isNegativeMixedAmount amt
-      (i,bal') = case psmatched of
-           [] -> (Nothing,bal)
-           _  -> (Just (t, tmatched, numotheraccts > 1, acct, a, b), b)
-                 where
-                  a = signfn amt
-                  b = bal + a
-      is = accountTransactionsReportItems query thisacctquery bal' signfn ts
-
-- | Generate a short readable summary of some postings, like
-- "from (negatives) to (positives)".
-summarisePostings :: [Posting] -> String
-summarisePostings ps =
-    case (summarisePostingAccounts froms, summarisePostingAccounts tos) of
-       ("",t) -> "to "++t
-       (f,"") -> "from "++f
-       (f,t)  -> "from "++f++" to "++t
-    where
-      (froms,tos) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps
-
-- | Generate a simplified summary of some postings' accounts.
-summarisePostingAccounts :: [Posting] -> String
-summarisePostingAccounts = intercalate ", " . map accountLeafName . nub . map paccount
-
-filterTransactionPostings :: Query -> Transaction -> Transaction
-filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}
-
-------------------------------------------------------------------------------
-
-- | An accounts report is a list of account names (full and short
-- variants) with their balances, appropriate indentation for rendering as
-- a hierarchy, and grand total.
-type AccountsReport = ([AccountsReportItem] -- line items, one per account
-                      ,MixedAmount          -- total balance of all accounts
-                      )
-type AccountsReportItem = (AccountName  -- full account name
-                          ,AccountName  -- short account name for display (the leaf name, prefixed by any boring parents immediately above)
-                          ,Int          -- how many steps to indent this account (0-based account depth excluding boring parents)
-                          ,MixedAmount) -- account balance, includes subs unless --flat is present
-
-- | Select accounts, and get their balances at the end of the selected
-- period, and misc. display information, for an accounts report.
-accountsReport :: ReportOpts -> Query -> Journal -> AccountsReport
-accountsReport opts q j = (items, total)
-    where
-      -- don't do depth filtering until the end
-      q1 = filterQuery (not . queryIsDepth) q
-      q2 = filterQuery queryIsDepth q
-      l =  journalToLedger q1 $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
-      acctnames = filter (q2 `matchesAccount`) $ ledgerAccountNames l
-      interestingaccts | no_elide_ opts = acctnames
-                       | otherwise = filter (isInteresting opts l) acctnames
-      items = map mkitem interestingaccts
-      total = sum $ map abalance $ ledgerTopAccounts l
-
-      -- | Get data for one balance report line item.
-      mkitem :: AccountName -> AccountsReportItem
-      mkitem a = (a, adisplay, indent, abal)
-          where
-            adisplay | flat_ opts = a
-                     | otherwise = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
-                where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
-            indent | flat_ opts = 0
-                   | otherwise = length interestingparents
-            interestingparents = filter (`elem` interestingaccts) parents
-            parents = parentAccountNames a
-            abal | flat_ opts = exclusiveBalance acct
-                 | otherwise = abalance acct
-                 where acct = ledgerAccount l a
-
 tests_accountsReport =
  let (opts,journal) `gives` r = do
         let (eitems, etotal) = r
@ -971,53 +987,13 @@ Right samplejournal2 = journalBalanceTransactions $ Journal
          []
          (TOD 0 0)

-exclusiveBalance :: Account -> MixedAmount
-exclusiveBalance = sumPostings . apostings
-
-- | Is the named account considered interesting for this ledger's accounts report,
-- following the eliding style of ledger's balance command ?
-isInteresting :: ReportOpts -> Ledger -> AccountName -> Bool
-isInteresting opts l a | flat_ opts = isInterestingFlat opts l a
-                       | otherwise = isInterestingIndented opts l a
-
-- | Determine whether an account should get its own line in the --flat balance report.
-isInterestingFlat :: ReportOpts -> Ledger -> AccountName -> Bool
-isInterestingFlat opts l a = notempty || emptyflag
-    where
-      acct = ledgerAccount l a
-      notempty = not $ isZeroMixedAmount $ exclusiveBalance acct
-      emptyflag = empty_ opts
-
-- | Determine whether an account should get its own line in the indented
-- balance report.  Cf Balance module doc.
-isInterestingIndented :: ReportOpts -> Ledger -> AccountName -> Bool
-isInterestingIndented opts l a
-    | numinterestingsubs == 1 && samebalanceassub && not atmaxdepth = False
-    | numinterestingsubs < 2 && zerobalance && not emptyflag = False
-    | otherwise = True
-    where
-      atmaxdepth = accountNameLevel a == depthFromOpts opts
-      emptyflag = empty_ opts
-      acct = ledgerAccount l a
-      zerobalance = isZeroMixedAmount inclbalance where inclbalance = abalance acct
-      samebalanceassub = isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct
-      numinterestingsubs = length $ filter isInterestingTree subtrees
-          where
-            isInterestingTree = treeany (isInteresting opts l . aname)
-            subtrees = map (fromJust . ledgerAccountTreeAt l) $ ledgerSubAccounts l $ ledgerAccount l a
-
-tests_isInterestingIndented = [
-  "isInterestingIndented" ~: do 
-   let (opts, journal, acctname) `gives` r = isInterestingIndented opts l acctname `is` r
-          where l = journalToLedger (queryFromOpts nulldate opts) journal
+-- tests_isInterestingIndented = [
+--   "isInterestingIndented" ~: do 
+--    let (opts, journal, acctname) `gives` r = isInterestingIndented opts l acctname `is` r
+--           where l = ledgerFromJournal (queryFromOpts nulldate opts) journal
     
-   (defreportopts, samplejournal, "expenses") `gives` True
- ]
-
-depthFromOpts :: ReportOpts -> Int
-depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)
-
-------------------------------------------------------------------------------
+--    (defreportopts, samplejournal, "expenses") `gives` True
+--  ]

 tests_Hledger_Reports :: Test
 tests_Hledger_Reports = TestList $
@ -1026,7 +1002,7 @@ tests_Hledger_Reports = TestList $
 ++ tests_entriesReport
 ++ tests_summarisePostingsByInterval
 ++ tests_postingsReport
- ++ tests_isInterestingIndented
+ -- ++ tests_isInterestingIndented
 ++ tests_accountsReport
 ++ [
  -- ,"summarisePostingsInDateSpan" ~: do
--- a/hledger-lib/Hledger/Utils.hs
+++ b/hledger-lib/Hledger/Utils.hs
@ -31,6 +31,7 @@ import Control.Monad.Error (MonadIO)
 import Control.Monad.IO.Class (liftIO)
 import Data.Char
 import Data.List
+import qualified Data.Map as M
 import Data.Maybe
 import Data.Time.Clock
 import Data.Time.LocalTime
@ -237,6 +238,8 @@ splitAtElement e l =

 -- trees

+-- standard tree helpers
+
 root = rootLabel
 subs = subForest
 branches = subForest
@ -291,6 +294,25 @@ showtree = unlines . filter (regexMatches "[^ \\|]") . lines . drawTree . treema
 showforest :: Show a => Forest a -> String
 showforest = concatMap showtree

+
+-- | An efficient-to-build tree suggested by Cale Gibbard, probably
+-- better than accountNameTreeFrom.
+newtype FastTree a = T (M.Map a (FastTree a))
+  deriving (Show, Eq, Ord)
+
+emptyTree = T M.empty
+
+mergeTrees :: (Ord a) => FastTree a -> FastTree a -> FastTree a
+mergeTrees (T m) (T m') = T (M.unionWith mergeTrees m m')
+
+treeFromPath :: [a] -> FastTree a
+treeFromPath []     = T M.empty
+treeFromPath (x:xs) = T (M.singleton x (treeFromPath xs))
+
+treeFromPaths :: (Ord a) => [[a]] -> FastTree a
+treeFromPaths = foldl' mergeTrees emptyTree . map treeFromPath
+
+
 -- debugging

 -- | trace (print on stdout at runtime) a showable expression
--- a/hledger-web/Hledger/Web/Handlers.hs
+++ b/hledger-web/Hledger/Web/Handlers.hs
@ -269,7 +269,7 @@ accountsReportAsHtml _ vd@VD{..} (items',total) =
   <td>
 |]
 where
-   l = journalToLedger Any j
+   l = ledgerFromJournal Any j
   inacctmatcher = inAccountQuery qopts
   allaccts = isNothing inacctmatcher
   items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher
--- a/hledger/Hledger/Cli.hs
+++ b/hledger/Hledger/Cli.hs
@ -133,11 +133,6 @@ tests_Hledger_Cli = TestList

  ,"show hours" ~: showAmount (hours 1) ~?= "1.0h"

-  ,"subAccounts" ~: do
-    let l = journalToLedger Any samplejournal
-        a = ledgerAccount l "assets"
-    map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
-
 ]

  
@ -539,7 +534,7 @@ journal7 = Journal
          []
          (TOD 0 0)

-ledger7 = journalToLedger Any journal7
+ledger7 = ledgerFromJournal Any journal7

 -- journal8_str = unlines
 --  ["2008/1/1 test           "
--- a/hledger/Hledger/Cli/Add.hs
+++ b/hledger/Hledger/Cli/Add.hs
@ -24,7 +24,6 @@ import System.IO ( stderr, hPutStrLn, hPutStr )
 import System.IO.Error
 import Text.ParserCombinators.Parsec
 import Text.Printf
-import qualified Data.Foldable as Foldable (find)
 import qualified Data.Set as Set

 import Hledger
@ -88,9 +87,9 @@ getTransaction j opts defaultDate = do
      date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr
      accept x = x == "." || (not . null) x &&
        if no_new_accounts_ opts
-            then isJust $ Foldable.find (== x) ant
+            then x `elem` existingaccts
            else True
-        where (ant,_,_,_) = groupPostings $ journalPostings j
+      existingaccts = journalAccountNames j
      getpostingsandvalidate = do
        ps <- getPostings (PostingState j accept True bestmatchpostings) []
        let t = nulltransaction{tdate=date
--- a/hledger/Hledger/Cli/Stats.hs
+++ b/hledger/Hledger/Cli/Stats.hs
@ -25,7 +25,7 @@ stats :: CliOpts -> Journal -> IO ()
 stats CliOpts{reportopts_=reportopts_} j = do
  d <- getCurrentDay
  let q = queryFromOpts d reportopts_
-      l = journalToLedger q j
+      l = ledgerFromJournal q j
      reportspan = (ledgerDateSpan l) `orDatesFrom` (queryDateSpan False q)
      intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan
      showstats = showLedgerStats l d
@ -58,7 +58,7 @@ showLedgerStats l today span =
      -- Days since last transaction : %(recentelapsed)s
       ]
           where
-             j = ledgerJournal l
+             j = ljournal l
             path = journalFilePath j
             ts = sortBy (comparing tdate) $ filter (spanContainsDate span . tdate) $ jtxns j
             as = nub $ map paccount $ concatMap tpostings ts