diff --git a/Ledger.hs b/Ledger.hs index 3532d4719..cfa72ec86 100644 --- a/Ledger.hs +++ b/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 + diff --git a/NOTES b/NOTES index 341bb7a35..b654be4f7 100644 --- a/NOTES +++ b/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 diff --git a/Options.hs b/Options.hs index 36cb31126..8f5487eac 100644 --- a/Options.hs +++ b/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 diff --git a/Tests.hs b/Tests.hs index 36f155ad0..80181345a 100644 --- a/Tests.hs +++ b/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 diff --git a/hledger.hs b/hledger.hs index 3292536e4..c2b3ac20c 100644 --- a/hledger.hs +++ b/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 + +-}