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

This commit is contained in:
Simon Michael 2007-07-03 17:25:16 +00:00
parent 7ff1b758c5
commit 255e061e6f
5 changed files with 43 additions and 14 deletions

View File

@ -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

2
NOTES
View File

@ -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

View File

@ -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

View File

@ -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
@ -292,7 +294,9 @@ test_ledgerAccountNames =
test_cacheLedger =
assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger ledger7)
test_showLedgerAccounts =
assertEqual' 4 (length $ lines $ showLedgerAccounts l7 [] False 1)
-- quickcheck properties

View File

@ -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
-}