fix non-display of single-child accounts when balance report depth is restricted, test support

Ledger.hs

@@ -13,6 +13,13 @@ import EntryTransaction
 import RawLedger
 
 
+instance Show Ledger where
+    show l = printf "Ledger with %d entries, %d accounts"
+             ((length $ entries $ rawledger l) +
+              (length $ modifier_entries $ rawledger l) +
+              (length $ periodic_entries $ rawledger l))
+             (length $ accountnames l)
+
 cacheLedger :: RawLedger -> Ledger
 cacheLedger l = 
     let 
@@ -136,19 +143,20 @@ showLedgerAccounts l acctpats showsubs maxdepth =
     (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth))
 
 showAccountTree :: Ledger -> Tree Account -> String
-showAccountTree l = showAccountTree' l 0 . interestingAccountsFrom
+showAccountTree l = showAccountTree' l 0 . pruneBoringBranches
 
 showAccountTree' :: Ledger -> Int -> Tree Account -> String
 showAccountTree' l indentlevel t
-    -- if this acct is boring, don't show it
-    | isBoringAccount l acct = subacctsindented 0
+    -- skip a boring inner account
+    | length subs > 0 && isBoringAccount l acct = subsindented 0
     -- otherwise show normal indented account name with balance, 
     -- prefixing the names of any boring parents
     | otherwise = 
-        bal ++ "  " ++ indent ++ prefix ++ leafname ++ "\n" ++ (subacctsindented 1)
+        bal ++ "  " ++ indent ++ prefix ++ leafname ++ "\n" ++ (subsindented 1)
     where
       acct = root t
-      subacctsindented i = concatMap (showAccountTree' l (indentlevel+i)) $ branches t
+      subs = branches t
+      subsindented i = concatMap (showAccountTree' l (indentlevel+i)) subs
       bal = printf "%20s" $ show $ abalance $ acct
       indent = replicate (indentlevel * 2) ' '
       prefix = concatMap (++ ":") $ map accountLeafName boringparents
@@ -168,9 +176,10 @@ isBoringAccount l a
 isBoringAccountName :: Ledger -> AccountName -> Bool
 isBoringAccountName l = isBoringAccount l . ledgerAccount l
 
-interestingAccountsFrom :: Tree Account -> Tree Account
-interestingAccountsFrom =
+pruneBoringBranches :: Tree Account -> Tree Account
+pruneBoringBranches =
     treefilter hastxns . treefilter hasbalance
     where 
       hasbalance = (/= 0) . abalance
       hastxns = (> 0) . length . atransactions
+

NOTES

@@ -2,8 +2,6 @@ hledger project notes
 
 * TO DO
 ** bugs
-*** space after account makes it a new account
-*** comments with numbers after transactions don't work
 ** basic features
 *** print
 *** !include

Options.hs

@@ -11,7 +11,6 @@ import Utils
 usagehdr       = "Usage: hledger [OPTIONS] "++commands++" [ACCTPATTERNS] [-- DESCPATTERNS]\nOptions:"
 commands       = "register|balance"
 defaultcmd     = "register"
-ledgerFilePath = findFileFromOpts "~/ledger.dat" "LEDGER"
 
 options :: [OptDescr Flag]
 options = [
@@ -48,6 +47,9 @@ testoptions order cmdline = putStr $
 
 usage = usageInfo usagehdr options
 
+ledgerFilePath :: [Flag] -> IO String
+ledgerFilePath = findFileFromOpts "~/ledger.dat" "LEDGER"
+
 -- find a file path from options, an env var or a default value
 findFileFromOpts :: FilePath -> String -> [Flag] -> IO String
 findFileFromOpts defaultpath envvar opts = do

Tests.hs

@@ -154,7 +154,6 @@ ledger7_str = "\
 \    assets:checking                                 \n\
 \\n" --"
 
-l = ledger7
 ledger7 = RawLedger
           [] 
           [] 
@@ -220,6 +219,8 @@ ledger7 = RawLedger
                  }
           ]
 
+l7 = cacheLedger ledger7
+
 timelogentry1_str  = "i 2007/03/11 16:19:00 hledger\n"
 timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger"
 
@@ -257,13 +258,14 @@ parseEquals parsed other =
 -- hunit tests
 
 tests = runTestTT $ test [
-         test_ledgertransaction
+         2 @=? 2
+        , test_ledgertransaction
         , test_ledgerentry
         , test_autofillEntry
         , test_expandAccountNames
         , test_ledgerAccountNames
         , test_cacheLedger
-        , 2 @=? 2
+        , test_showLedgerAccounts
         ]
 
 test_ledgertransaction :: Assertion
@@ -293,6 +295,8 @@ test_ledgerAccountNames =
 test_cacheLedger =
     assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger ledger7)
 
+test_showLedgerAccounts = 
+    assertEqual' 4 (length $ lines $ showLedgerAccounts l7 [] False 1)
 
 -- quickcheck properties
 

hledger.hs

@@ -71,3 +71,19 @@ doWithParsed :: (Ledger -> IO ()) -> (Either ParseError RawLedger) -> IO ()
 doWithParsed cmd parsed = do
   case parsed of Left e -> parseError e
                  Right l -> cmd $ cacheLedger l
+
+
+{-
+interactive testing:
+
+*Main> p <- ledgerFilePath [File "./test.dat"] >>= parseLedgerFile
+*Main> let r = either (\_ -> RawLedger [] [] []) id p
+*Main> let l = cacheLedger r
+*Main> let ant = accountnametree l
+*Main> let at = accounts l
+*Main> putStr $ drawTree $ treemap show $ ant
+*Main> putStr $ showLedgerAccounts l [] False 1
+*Main> :m +Tests
+*Main Tests> l7
+
+-}