mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-08 07:09:28 +03:00
fix non-display of single-child accounts when balance report depth is restricted, test support
This commit is contained in:
parent
7ff1b758c5
commit
255e061e6f
23
Ledger.hs
23
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
|
||||
|
||||
|
2
NOTES
2
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
|
||||
|
@ -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
|
||||
|
12
Tests.hs
12
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
|
||||
@ -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
|
||||
|
||||
|
16
hledger.hs
16
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
|
||||
|
||||
-}
|
||||
|
Loading…
Reference in New Issue
Block a user