diff --git a/Account.hs b/Account.hs index 0cb262e39..fe3475b33 100644 --- a/Account.hs +++ b/Account.hs @@ -9,7 +9,7 @@ import Amount import Entry import Transaction import EntryTransaction -import Ledger +import RawLedger -- an Account caches an account's name, balance (including sub-accounts) @@ -20,7 +20,7 @@ instance Show Account where nullacct = Account "" [] nullamt -ledgerAccount :: Ledger -> AccountName -> Account +ledgerAccount :: RawLedger -> AccountName -> Account ledgerAccount l a = Account a @@ -29,24 +29,24 @@ ledgerAccount l a = -- queries -balanceInAccountNamed :: Ledger -> AccountName -> Amount +balanceInAccountNamed :: RawLedger -> AccountName -> Amount balanceInAccountNamed l a = sumEntryTransactions (transactionsInAccountNamed l a) -aggregateBalanceInAccountNamed :: Ledger -> AccountName -> Amount +aggregateBalanceInAccountNamed :: RawLedger -> AccountName -> Amount aggregateBalanceInAccountNamed l a = sumEntryTransactions (aggregateTransactionsInAccountNamed l a) -transactionsInAccountNamed :: Ledger -> AccountName -> [EntryTransaction] +transactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction] transactionsInAccountNamed l a = ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l -aggregateTransactionsInAccountNamed :: Ledger -> AccountName -> [EntryTransaction] +aggregateTransactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction] aggregateTransactionsInAccountNamed l a = ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l -- build a tree of Accounts -addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account +addDataToAccountNameTree :: RawLedger -> Tree AccountName -> Tree Account addDataToAccountNameTree l ant = Node (ledgerAccount l $ root ant) @@ -92,13 +92,13 @@ addDataToAccountNameTree l ant = -- $ checking -- $ saving -showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String +showLedgerAccounts :: RawLedger -> [String] -> Bool -> Int -> String showLedgerAccounts l acctpats showsubs maxdepth = concatMap (showAccountTree l) (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth)) -ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account +ledgerAccountTreeMatching :: RawLedger -> [String] -> Bool -> Int -> Tree Account ledgerAccountTreeMatching l [] showsubs maxdepth = ledgerAccountTreeMatching l [".*"] showsubs maxdepth ledgerAccountTreeMatching l acctpats showsubs maxdepth = @@ -130,7 +130,7 @@ ledgerAccountTreeMatching l acctpats showsubs maxdepth = -- e -- f -- g -showAccountTree :: Ledger -> Tree Account -> String +showAccountTree :: RawLedger -> Tree Account -> String showAccountTree l = showAccountTree' l 0 . interestingAccountsFrom showAccountTree' l indentlevel t @@ -149,7 +149,7 @@ showAccountTree' l indentlevel t boringparents = takeWhile (isBoringInnerAccountName l) $ parentAccountNames $ aname acct leafname = accountLeafName $ aname acct -isBoringInnerAccount :: Ledger -> Account -> Bool +isBoringInnerAccount :: RawLedger -> Account -> Bool isBoringInnerAccount l a | name == "top" = False | (length txns == 0) && ((length subs) == 1) = True @@ -160,7 +160,7 @@ isBoringInnerAccount l a subs = subAccountNamesFrom (ledgerAccountNames l) name -- darnit, still need this -isBoringInnerAccountName :: Ledger -> AccountName -> Bool +isBoringInnerAccountName :: RawLedger -> AccountName -> Bool isBoringInnerAccountName l name | name == "top" = False | (length txns == 0) && ((length subs) == 1) = True @@ -176,5 +176,5 @@ interestingAccountsFrom = hasbalance = (/= 0) . abalance hastxns = (> 0) . length . atransactions -ledgerAccountTree :: Ledger -> Tree Account +ledgerAccountTree :: RawLedger -> Tree Account ledgerAccountTree l = addDataToAccountNameTree l (ledgerAccountNameTree l) diff --git a/CachedLedger.hs b/CachedLedger.hs deleted file mode 100644 index 3fb87449f..000000000 --- a/CachedLedger.hs +++ /dev/null @@ -1,49 +0,0 @@ -module CachedLedger -where -import qualified Data.Map as Map - -import Utils -import Types -import Account -import AccountName -import EntryTransaction -import Ledger - - -cacheLedger :: Ledger -> CachedLedger -cacheLedger l = - CachedLedger - l - (ledgerAccountNameTree l) - (Map.fromList [(a, ledgerAccount l a) | a <- ledgerAccountNames l]) - -cLedgerTransactions :: CachedLedger -> [EntryTransaction] -cLedgerTransactions l = concatMap atransactions $ Map.elems $ accounts l - --- unoptimised -cLedgerTransactionsMatching :: ([String],[String]) -> CachedLedger -> [EntryTransaction] -cLedgerTransactionsMatching pats l = ledgerTransactionsMatching pats $ uncached_ledger l - --- XXX optimise -cLedgerTransactionsMatching1 :: ([String],[String]) -> CachedLedger -> [EntryTransaction] -cLedgerTransactionsMatching1 ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) (uncached_ledger l) -cLedgerTransactionsMatching1 (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) (uncached_ledger l) -cLedgerTransactionsMatching1 ([],rs) l = ledgerTransactionsMatching ([".*"],rs) (uncached_ledger l) -cLedgerTransactionsMatching1 (acctregexps,descregexps) l = - intersect - (concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) - (concat [filter (matchTransactionDescription r) ts | r <- descregexps]) - where ts = cLedgerTransactions l - --- unoptimised -showCLedgerAccounts :: CachedLedger -> [String] -> Bool -> Int -> String -showCLedgerAccounts l acctpats showsubs maxdepth = - showLedgerAccounts (uncached_ledger l) acctpats showsubs maxdepth - --- XXX optimise -showCLedgerAccounts1 :: CachedLedger -> [String] -> Bool -> Int -> String -showCLedgerAccounts1 l acctpats showsubs maxdepth = - concatMap - (showAccountTree (uncached_ledger l)) - (branches (ledgerAccountTreeMatching (uncached_ledger l) acctpats showsubs maxdepth)) - diff --git a/Ledger.hs b/Ledger.hs index 1a0ebf34c..3e0584a9d 100644 --- a/Ledger.hs +++ b/Ledger.hs @@ -3,54 +3,47 @@ where import qualified Data.Map as Map import Utils -import AccountName import Types -import Entry +import Account +import AccountName import EntryTransaction +import RawLedger -instance Show Ledger where - show l = printf "Ledger with %d entries" - ((length $ entries l) + - (length $ modifier_entries l) + - (length $ periodic_entries l)) +cacheLedger :: RawLedger -> Ledger +cacheLedger l = + Ledger + l + (ledgerAccountNameTree l) + (Map.fromList [(a, ledgerAccount l a) | a <- ledgerAccountNames l]) -ledgerTransactions :: Ledger -> [EntryTransaction] -ledgerTransactions l = entryTransactionsFrom $ entries l +cLedgerTransactions :: Ledger -> [EntryTransaction] +cLedgerTransactions l = concatMap atransactions $ Map.elems $ accounts l -ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] -ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l -ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l -ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l -ledgerTransactionsMatching (acctregexps,descregexps) l = +-- unoptimised +cLedgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] +cLedgerTransactionsMatching pats l = ledgerTransactionsMatching pats $ rawledger l + +-- XXX optimise +cLedgerTransactionsMatching1 :: ([String],[String]) -> Ledger -> [EntryTransaction] +cLedgerTransactionsMatching1 ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) (rawledger l) +cLedgerTransactionsMatching1 (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) (rawledger l) +cLedgerTransactionsMatching1 ([],rs) l = ledgerTransactionsMatching ([".*"],rs) (rawledger l) +cLedgerTransactionsMatching1 (acctregexps,descregexps) l = intersect (concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) (concat [filter (matchTransactionDescription r) ts | r <- descregexps]) - where ts = ledgerTransactions l - -ledgerAccountTransactions :: Ledger -> AccountName -> [EntryTransaction] -ledgerAccountTransactions l a = ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l - -accountNamesFromTransactions :: [EntryTransaction] -> [AccountName] -accountNamesFromTransactions ts = nub $ map account ts - -ledgerAccountNamesUsed :: Ledger -> [AccountName] -ledgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l - -ledgerAccountNames :: Ledger -> [AccountName] -ledgerAccountNames = sort . expandAccountNames . ledgerAccountNamesUsed - -ledgerTopAccountNames :: Ledger -> [AccountName] -ledgerTopAccountNames l = filter (notElem ':') (ledgerAccountNames l) - -ledgerAccountNamesMatching :: [String] -> Ledger -> [AccountName] -ledgerAccountNamesMatching [] l = ledgerAccountNamesMatching [".*"] l -ledgerAccountNamesMatching acctregexps l = - concat [filter (matchAccountName r) accountNames | r <- acctregexps] - where accountNames = ledgerTopAccountNames l - -ledgerAccountNameTree :: Ledger -> Tree AccountName -ledgerAccountNameTree l = accountNameTreeFrom $ ledgerAccountNames l + where ts = cLedgerTransactions l +-- unoptimised +showCLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String +showCLedgerAccounts l acctpats showsubs maxdepth = + showLedgerAccounts (rawledger l) acctpats showsubs maxdepth +-- XXX optimise +showCLedgerAccounts1 :: Ledger -> [String] -> Bool -> Int -> String +showCLedgerAccounts1 l acctpats showsubs maxdepth = + concatMap + (showAccountTree (rawledger l)) + (branches (ledgerAccountTreeMatching (rawledger l) acctpats showsubs maxdepth)) diff --git a/Models.hs b/Models.hs index 255f0a1d3..2e4883823 100644 --- a/Models.hs +++ b/Models.hs @@ -8,9 +8,9 @@ module Models ( module Entry, module TimeLog, module EntryTransaction, - module Ledger, + module RawLedger, module Account, - module CachedLedger, + module Ledger, ) where import qualified Data.Map as Map @@ -23,7 +23,7 @@ import Transaction import Entry import TimeLog import EntryTransaction -import Ledger +import RawLedger import Account -import CachedLedger +import Ledger diff --git a/Parse.hs b/Parse.hs index 985cedb65..44511de8c 100644 --- a/Parse.hs +++ b/Parse.hs @@ -36,7 +36,7 @@ reserved = P.reserved lexer reservedOp = P.reservedOp lexer -ledgerfile :: Parser Ledger +ledgerfile :: Parser RawLedger ledgerfile = ledger <|> ledgerfromtimelog @@ -141,7 +141,7 @@ i, o, b, h -- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs -- sample data in Tests.hs -ledger :: Parser Ledger +ledger :: Parser RawLedger ledger = do ledgernondatalines -- for now these must come first, unlike ledger @@ -150,7 +150,7 @@ ledger = do -- entries <- (many ledgerentry) "entry" eof - return $ Ledger modifier_entries periodic_entries entries + return $ RawLedger modifier_entries periodic_entries entries ledgernondatalines :: Parser [String] ledgernondatalines = many (ledgerdirective <|> ledgercomment <|> do {whiteSpace1; return []}) @@ -287,7 +287,7 @@ o 2007/03/10 17:26:02 -} -ledgerfromtimelog :: Parser Ledger +ledgerfromtimelog :: Parser RawLedger ledgerfromtimelog = do tl <- timelog return $ ledgerFromTimeLog tl @@ -320,7 +320,7 @@ printParseResult :: Show v => Either ParseError v -> IO () printParseResult r = case r of Left e -> parseError e Right v -> print v -parseLedgerFile :: String -> IO (Either ParseError Ledger) +parseLedgerFile :: String -> IO (Either ParseError RawLedger) parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin parseLedgerFile f = parseFromFile ledgerfile f diff --git a/RawLedger.hs b/RawLedger.hs new file mode 100644 index 000000000..d1498e545 --- /dev/null +++ b/RawLedger.hs @@ -0,0 +1,56 @@ +module RawLedger +where +import qualified Data.Map as Map + +import Utils +import AccountName +import Types +import Entry +import EntryTransaction + + +instance Show RawLedger where + show l = printf "RawLedger with %d entries" + ((length $ entries l) + + (length $ modifier_entries l) + + (length $ periodic_entries l)) + +ledgerTransactions :: RawLedger -> [EntryTransaction] +ledgerTransactions l = entryTransactionsFrom $ entries l + +ledgerTransactionsMatching :: ([String],[String]) -> RawLedger -> [EntryTransaction] +ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l +ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l +ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l +ledgerTransactionsMatching (acctregexps,descregexps) l = + intersect + (concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) + (concat [filter (matchTransactionDescription r) ts | r <- descregexps]) + where ts = ledgerTransactions l + +ledgerAccountTransactions :: RawLedger -> AccountName -> [EntryTransaction] +ledgerAccountTransactions l a = ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l + +accountNamesFromTransactions :: [EntryTransaction] -> [AccountName] +accountNamesFromTransactions ts = nub $ map account ts + +ledgerAccountNamesUsed :: RawLedger -> [AccountName] +ledgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l + +ledgerAccountNames :: RawLedger -> [AccountName] +ledgerAccountNames = sort . expandAccountNames . ledgerAccountNamesUsed + +ledgerTopAccountNames :: RawLedger -> [AccountName] +ledgerTopAccountNames l = filter (notElem ':') (ledgerAccountNames l) + +ledgerAccountNamesMatching :: [String] -> RawLedger -> [AccountName] +ledgerAccountNamesMatching [] l = ledgerAccountNamesMatching [".*"] l +ledgerAccountNamesMatching acctregexps l = + concat [filter (matchAccountName r) accountNames | r <- acctregexps] + where accountNames = ledgerTopAccountNames l + +ledgerAccountNameTree :: RawLedger -> Tree AccountName +ledgerAccountNameTree l = accountNameTreeFrom $ ledgerAccountNames l + + + diff --git a/Tests.hs b/Tests.hs index d39a8cf4d..0a38d9dd8 100644 --- a/Tests.hs +++ b/Tests.hs @@ -155,7 +155,7 @@ ledger7_str = "\ \\n" --" l = ledger7 -ledger7 = Ledger +ledger7 = RawLedger [] [] [ diff --git a/TimeLog.hs b/TimeLog.hs index d30c3c50f..e8cf037ba 100644 --- a/TimeLog.hs +++ b/TimeLog.hs @@ -6,7 +6,7 @@ import Currency import Amount import Transaction import Entry -import Ledger +import RawLedger instance Show TimeLogEntry where show t = printf "%s %s %s" (show $ tcode t) (tdatetime t) (tcomment t) @@ -14,9 +14,9 @@ instance Show TimeLogEntry where instance Show TimeLog where show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl -ledgerFromTimeLog :: TimeLog -> Ledger +ledgerFromTimeLog :: TimeLog -> RawLedger ledgerFromTimeLog tl = - Ledger [] [] (entriesFromTimeLogEntries $ timelog_entries tl) + RawLedger [] [] (entriesFromTimeLogEntries $ timelog_entries tl) entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry] diff --git a/Types.hs b/Types.hs index c7cf38c23..c201b3762 100644 --- a/Types.hs +++ b/Types.hs @@ -17,9 +17,9 @@ hledger Models TimeLog TimeLogEntry - CachedLedger + Ledger Account - Ledger + RawLedger EntryTransaction Entry Transaction @@ -92,7 +92,7 @@ data TimeLog = TimeLog { } deriving (Eq) -- a parsed ledger file -data Ledger = Ledger { +data RawLedger = RawLedger { modifier_entries :: [ModifierEntry], periodic_entries :: [PeriodicEntry], entries :: [Entry] @@ -104,7 +104,7 @@ data Ledger = Ledger { -- "transactions" in modules above EntryTransaction. type EntryTransaction = (Entry,Transaction) --- all information for a particular account, derived from a Ledger +-- all information for a particular account, derived from a RawLedger data Account = Account { aname :: AccountName, atransactions :: [EntryTransaction], -- excludes sub-accounts @@ -112,8 +112,8 @@ data Account = Account { } -- a ledger with account info cached for faster queries -data CachedLedger = CachedLedger { - uncached_ledger :: Ledger, +data Ledger = Ledger { + rawledger :: RawLedger, accountnames :: Tree AccountName, accounts :: Map.Map AccountName Account } diff --git a/hledger.hs b/hledger.hs index c73ad6fbf..737cd18b6 100644 --- a/hledger.hs +++ b/hledger.hs @@ -63,11 +63,11 @@ selftest = do -- utils -doWithLedger :: [Flag] -> (CachedLedger -> IO ()) -> IO () +doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO () doWithLedger opts cmd = do ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd -doWithParsed :: (CachedLedger -> IO ()) -> (Either ParseError Ledger) -> IO () +doWithParsed :: (Ledger -> IO ()) -> (Either ParseError RawLedger) -> IO () doWithParsed cmd parsed = do case parsed of Left e -> parseError e Right l -> cmd $ cacheLedger l @@ -75,7 +75,7 @@ doWithParsed cmd parsed = do -- interactive testing: -- -- p <- ledgerFilePath [] >>= parseLedgerFile --- let l = either (\_ -> Ledger [] [] []) id p +-- let l = either (\_ -> RawLedger [] [] []) id p -- let ant = ledgerAccountNameTree l -- let at = ledgerAccountTreeMatching l [] True 999 -- putStr $ drawTree $ treemap show $ ledgerAccountTreeMatching l ["a"] False 999