hledger-lib 0.18.2 → 0.19

raw patch · 8 files changed

+475/−633 lines, 8 filesdep ~cmdargsdep ~splitPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: cmdargs, split

API changes (from Hackage documentation)

Files

• Hledger/Data/Account.hs +144/−9
• Hledger/Data/AccountName.hs +12/−79
• Hledger/Data/Journal.hs +3/−210
• Hledger/Data/Ledger.hs +48/−58
• Hledger/Data/Types.hs +21/−28
• Hledger/Reports.hs +221/−245
• Hledger/Utils.hs +22/−0
• hledger-lib.cabal +4/−4

@@ -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 "" [] nullmixedamt+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 " ")+  tests_Hledger_Data_Account = TestList [  ]

@@ -10,11 +10,9 @@ 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,9 +40,12 @@  -- | ["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] topAccountNames as = [a | a <- expandAccountNames as, accountNameLevel a == 1]@@ -72,83 +73,15 @@  -- | 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 @@ 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`

@@ -23,7 +23,6 @@   filterJournalPostings,   filterJournalTransactions,   -- * Querying-  journalAccountInfo,   journalAccountNames,   journalAccountNamesUsed,   journalAmountAndPriceCommodities,@@ -43,7 +42,6 @@   journalEquityAccountQuery,   journalCashAccountQuery,   -- * Misc-  groupPostings,   matchpats,   nullctx,   nulljournal,@@ -53,7 +51,7 @@ ) 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 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 @@  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 @@           (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"]- -- ]+ ]

@@ -9,90 +9,73 @@  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 []-    }---- | 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'+nullledger = Ledger {+  ljournal = nulljournal,+  laccounts = []+  } -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 = 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_Hledger_Data_Ledger = TestList $-    tests_journalToLedger +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_ledgerFromJournal

@@ -11,23 +11,10 @@ > > 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 @@ 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 @@       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 @@       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 @@   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]+}

@@ -42,7 +42,6 @@   AccountsReport,   AccountsReportItem,   accountsReport,-  isInteresting,   -- * Tests   tests_Hledger_Reports )@@ -51,6 +50,7 @@ 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 @@                                     | 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,172 +287,6 @@                  | otherwise = requestedspan `spanIntersect` matchedspan       startbal = sumPostings precedingps -tests_postingsReport = [-  "postingsReport" ~: do--   -- with the query specified explicitly-   let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) `is` n-   (Any, nulljournal) `gives` 0-   (Any, samplejournal) `gives` 11-   -- register --depth just clips account names-   (Depth 2, samplejournal) `gives` 11-   (And [Depth 1, Status True, Acct "expenses"], samplejournal) `gives` 2-   (And [And [Depth 1, Status True], Acct "expenses"], samplejournal) `gives` 2--   -- with query and/or command-line options-   assertEqual "" 11 (length $ snd $ postingsReport defreportopts Any samplejournal)-   assertEqual ""  9 (length $ snd $ postingsReport defreportopts{monthly_=True} Any samplejournal)-   assertEqual "" 19 (length $ snd $ postingsReport defreportopts{monthly_=True} (Empty True) samplejournal)-   assertEqual ""  4 (length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal)--   -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0-   -- [(Just (parsedate "2008-01-01","income"),assets:bank:checking             $1,$1)-   -- ,(Nothing,income:salary                   $-1,0)-   -- ,(Just (2008-06-01,"gift"),assets:bank:checking             $1,$1)-   -- ,(Nothing,income:gifts                    $-1,0)-   -- ,(Just (2008-06-02,"save"),assets:bank:saving               $1,$1)-   -- ,(Nothing,assets:bank:checking            $-1,0)-   -- ,(Just (2008-06-03,"eat & shop"),expenses:food                    $1,$1)-   -- ,(Nothing,expenses:supplies                $1,$2)-   -- ,(Nothing,assets:cash                     $-2,0)-   -- ,(Just (2008-12-31,"pay off"),liabilities:debts                $1,$1)-   -- ,(Nothing,assets:bank:checking            $-1,0)-   -- ]--{--    let opts = defreportopts-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/01/01 income               assets:bank:checking             $1           $1"-     ,"                                income:salary                   $-1            0"-     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"-     ,"                                income:gifts                    $-1            0"-     ,"2008/06/02 save                 assets:bank:saving               $1           $1"-     ,"                                assets:bank:checking            $-1            0"-     ,"2008/06/03 eat & shop           expenses:food                    $1           $1"-     ,"                                expenses:supplies                $1           $2"-     ,"                                assets:cash                     $-2            0"-     ,"2008/12/31 pay off              liabilities:debts                $1           $1"-     ,"                                assets:bank:checking            $-1            0"-     ]--  ,"postings report with cleared option" ~:-   do -    let opts = defreportopts{cleared_=True}-    j <- readJournal' sample_journal_str-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/06/03 eat & shop           expenses:food                    $1           $1"-     ,"                                expenses:supplies                $1           $2"-     ,"                                assets:cash                     $-2            0"-     ,"2008/12/31 pay off              liabilities:debts                $1           $1"-     ,"                                assets:bank:checking            $-1            0"-     ]--  ,"postings report with uncleared option" ~:-   do -    let opts = defreportopts{uncleared_=True}-    j <- readJournal' sample_journal_str-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/01/01 income               assets:bank:checking             $1           $1"-     ,"                                income:salary                   $-1            0"-     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"-     ,"                                income:gifts                    $-1            0"-     ,"2008/06/02 save                 assets:bank:saving               $1           $1"-     ,"                                assets:bank:checking            $-1            0"-     ]--  ,"postings report sorts by date" ~:-   do -    j <- readJournal' $ unlines-        ["2008/02/02 a"-        ,"  b  1"-        ,"  c"-        ,""-        ,"2008/01/01 d"-        ,"  e  1"-        ,"  f"-        ]-    let opts = defreportopts-    registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/02/02"]--  ,"postings report with account pattern" ~:-   do-    j <- samplejournal-    let opts = defreportopts{patterns_=["cash"]}-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"-     ]--  ,"postings report with account pattern, case insensitive" ~:-   do -    j <- samplejournal-    let opts = defreportopts{patterns_=["cAsH"]}-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"-     ]--  ,"postings report with display expression" ~:-   do -    j <- samplejournal-    let gives displayexpr = -            (registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is`)-                where opts = defreportopts{display_=Just displayexpr}-    "d<[2008/6/2]"  `gives` ["2008/01/01","2008/06/01"]-    "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]-    "d=[2008/6/2]"  `gives` ["2008/06/02"]-    "d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"]-    "d>[2008/6/2]"  `gives` ["2008/06/03","2008/12/31"]--  ,"postings report with period expression" ~:-   do -    j <- samplejournal-    let periodexpr `gives` dates = do-          j' <- samplejournal-          registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j') `is` dates-              where opts = defreportopts{period_=maybePeriod date1 periodexpr}-    ""     `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]-    "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]-    "2007" `gives` []-    "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]-    "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]-    "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]-    let opts = defreportopts{period_=maybePeriod date1 "yearly"}-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"-     ,"                                assets:cash                     $-2          $-1"-     ,"                                expenses:food                    $1            0"-     ,"                                expenses:supplies                $1           $1"-     ,"                                income:gifts                    $-1            0"-     ,"                                income:salary                   $-1          $-1"-     ,"                                liabilities:debts                $1            0"-     ]-    let opts = defreportopts{period_=maybePeriod date1 "quarterly"}-    registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]-    let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True}-    registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]--  ]--  , "postings report with depth arg" ~:-   do -    j <- samplejournal-    let opts = defreportopts{depth_=Just 2}-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/01/01 income               assets:bank                      $1           $1"-     ,"                                income:salary                   $-1            0"-     ,"2008/06/01 gift                 assets:bank                      $1           $1"-     ,"                                income:gifts                    $-1            0"-     ,"2008/06/02 save                 assets:bank                      $1           $1"-     ,"                                assets:bank                     $-1            0"-     ,"2008/06/03 eat & shop           expenses:food                    $1           $1"-     ,"                                expenses:supplies                $1           $2"-     ,"                                assets:cash                     $-2            0"-     ,"2008/12/31 pay off              liabilities:debts                $1           $1"-     ,"                                assets:bank                     $-1            0"-     ]---}- ]- totallabel = "Total" balancelabel = "Balance" @@ -557,16 +394,16 @@       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+      summaryps = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]       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)+      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  ------------------------------------------------------------------------------- @@ -703,31 +540,210 @@ 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)+      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-            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+            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++   -- with the query specified explicitly+   let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) `is` n+   (Any, nulljournal) `gives` 0+   (Any, samplejournal) `gives` 11+   -- register --depth just clips account names+   (Depth 2, samplejournal) `gives` 11+   (And [Depth 1, Status True, Acct "expenses"], samplejournal) `gives` 2+   (And [And [Depth 1, Status True], Acct "expenses"], samplejournal) `gives` 2++   -- with query and/or command-line options+   assertEqual "" 11 (length $ snd $ postingsReport defreportopts Any samplejournal)+   assertEqual ""  9 (length $ snd $ postingsReport defreportopts{monthly_=True} Any samplejournal)+   assertEqual "" 19 (length $ snd $ postingsReport defreportopts{monthly_=True} (Empty True) samplejournal)+   assertEqual ""  4 (length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal)++   -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0+   -- [(Just (parsedate "2008-01-01","income"),assets:bank:checking             $1,$1)+   -- ,(Nothing,income:salary                   $-1,0)+   -- ,(Just (2008-06-01,"gift"),assets:bank:checking             $1,$1)+   -- ,(Nothing,income:gifts                    $-1,0)+   -- ,(Just (2008-06-02,"save"),assets:bank:saving               $1,$1)+   -- ,(Nothing,assets:bank:checking            $-1,0)+   -- ,(Just (2008-06-03,"eat & shop"),expenses:food                    $1,$1)+   -- ,(Nothing,expenses:supplies                $1,$2)+   -- ,(Nothing,assets:cash                     $-2,0)+   -- ,(Just (2008-12-31,"pay off"),liabilities:debts                $1,$1)+   -- ,(Nothing,assets:bank:checking            $-1,0)+   -- ]++{-+    let opts = defreportopts+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/01/01 income               assets:bank:checking             $1           $1"+     ,"                                income:salary                   $-1            0"+     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"+     ,"                                income:gifts                    $-1            0"+     ,"2008/06/02 save                 assets:bank:saving               $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ,"2008/06/03 eat & shop           expenses:food                    $1           $1"+     ,"                                expenses:supplies                $1           $2"+     ,"                                assets:cash                     $-2            0"+     ,"2008/12/31 pay off              liabilities:debts                $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ]++  ,"postings report with cleared option" ~:+   do +    let opts = defreportopts{cleared_=True}+    j <- readJournal' sample_journal_str+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/06/03 eat & shop           expenses:food                    $1           $1"+     ,"                                expenses:supplies                $1           $2"+     ,"                                assets:cash                     $-2            0"+     ,"2008/12/31 pay off              liabilities:debts                $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ]++  ,"postings report with uncleared option" ~:+   do +    let opts = defreportopts{uncleared_=True}+    j <- readJournal' sample_journal_str+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/01/01 income               assets:bank:checking             $1           $1"+     ,"                                income:salary                   $-1            0"+     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"+     ,"                                income:gifts                    $-1            0"+     ,"2008/06/02 save                 assets:bank:saving               $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ]++  ,"postings report sorts by date" ~:+   do +    j <- readJournal' $ unlines+        ["2008/02/02 a"+        ,"  b  1"+        ,"  c"+        ,""+        ,"2008/01/01 d"+        ,"  e  1"+        ,"  f"+        ]+    let opts = defreportopts+    registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/02/02"]++  ,"postings report with account pattern" ~:+   do+    j <- samplejournal+    let opts = defreportopts{patterns_=["cash"]}+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"+     ]++  ,"postings report with account pattern, case insensitive" ~:+   do +    j <- samplejournal+    let opts = defreportopts{patterns_=["cAsH"]}+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"+     ]++  ,"postings report with display expression" ~:+   do +    j <- samplejournal+    let gives displayexpr = +            (registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is`)+                where opts = defreportopts{display_=Just displayexpr}+    "d<[2008/6/2]"  `gives` ["2008/01/01","2008/06/01"]+    "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]+    "d=[2008/6/2]"  `gives` ["2008/06/02"]+    "d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"]+    "d>[2008/6/2]"  `gives` ["2008/06/03","2008/12/31"]++  ,"postings report with period expression" ~:+   do +    j <- samplejournal+    let periodexpr `gives` dates = do+          j' <- samplejournal+          registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j') `is` dates+              where opts = defreportopts{period_=maybePeriod date1 periodexpr}+    ""     `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]+    "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]+    "2007" `gives` []+    "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]+    "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]+    "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]+    let opts = defreportopts{period_=maybePeriod date1 "yearly"}+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"+     ,"                                assets:cash                     $-2          $-1"+     ,"                                expenses:food                    $1            0"+     ,"                                expenses:supplies                $1           $1"+     ,"                                income:gifts                    $-1            0"+     ,"                                income:salary                   $-1          $-1"+     ,"                                liabilities:debts                $1            0"+     ]+    let opts = defreportopts{period_=maybePeriod date1 "quarterly"}+    registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]+    let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True}+    registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]++  ]++  , "postings report with depth arg" ~:+   do +    j <- samplejournal+    let opts = defreportopts{depth_=Just 2}+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/01/01 income               assets:bank                      $1           $1"+     ,"                                income:salary                   $-1            0"+     ,"2008/06/01 gift                 assets:bank                      $1           $1"+     ,"                                income:gifts                    $-1            0"+     ,"2008/06/02 save                 assets:bank                      $1           $1"+     ,"                                assets:bank                     $-1            0"+     ,"2008/06/03 eat & shop           expenses:food                    $1           $1"+     ,"                                expenses:supplies                $1           $2"+     ,"                                assets:cash                     $-2            0"+     ,"2008/12/31 pay off              liabilities:debts                $1           $1"+     ,"                                assets:bank                     $-1            0"+     ]++-}+ ]+ tests_accountsReport =   let (opts,journal) `gives` r = do          let (eitems, etotal) = r@@ -971,53 +987,13 @@           []           (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_entriesReport  ++ tests_summarisePostingsByInterval  ++ tests_postingsReport- ++ tests_isInterestingIndented+ -- ++ tests_isInterestingIndented  ++ tests_accountsReport  ++ [   -- ,"summarisePostingsInDateSpan" ~: do

@@ -31,6 +31,7 @@ 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 @@  -- trees +-- standard tree helpers+ root = rootLabel subs = subForest branches = subForest@@ -290,6 +293,25 @@ -- | show a compact ascii representation of a forest 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 

@@ -1,5 +1,5 @@ name:           hledger-lib-version: 0.18.2+version: 0.19 category:       Finance synopsis:       Core data types, parsers and utilities for the hledger accounting tool. description:@@ -17,7 +17,7 @@ homepage:       http://hledger.org bug-reports:    http://code.google.com/p/hledger/issues stability:      beta-tested-with:    GHC==7.0.4, GHC==7.2.2, GHC==7.4.1+tested-with:    GHC==7.0.4, GHC==7.2.2, GHC==7.4.1, GHC==7.6.1 cabal-version:  >= 1.8 build-type:     Simple -- data-dir:       data@@ -57,7 +57,7 @@   Build-Depends:                   base >= 4.3 && < 5                  ,bytestring-                 ,cmdargs >= 0.9.1   && < 0.10+                 ,cmdargs >= 0.10 && < 0.11                  ,containers                  ,csv                  ,directory@@ -69,7 +69,7 @@                  ,regexpr >= 0.5.1                  ,safe >= 0.2                  ,shakespeare-text >= 1.0 && < 1.1-                 ,split == 0.1.*+                 ,split >= 0.1 && < 0.3                  ,time                  ,transformers >= 0.2 && < 0.4                  ,utf8-string >= 0.3.5 && < 0.4