rename Ledger -> RawLedger, CachedLedger -> Ledger

This commit is contained in:
Simon Michael 2007-07-02 19:15:39 +00:00
parent df55743697
commit bd84e95f5e
10 changed files with 123 additions and 123 deletions

View File

@ -9,7 +9,7 @@ import Amount
import Entry import Entry
import Transaction import Transaction
import EntryTransaction import EntryTransaction
import Ledger import RawLedger
-- an Account caches an account's name, balance (including sub-accounts) -- an Account caches an account's name, balance (including sub-accounts)
@ -20,7 +20,7 @@ instance Show Account where
nullacct = Account "" [] nullamt nullacct = Account "" [] nullamt
ledgerAccount :: Ledger -> AccountName -> Account ledgerAccount :: RawLedger -> AccountName -> Account
ledgerAccount l a = ledgerAccount l a =
Account Account
a a
@ -29,24 +29,24 @@ ledgerAccount l a =
-- queries -- queries
balanceInAccountNamed :: Ledger -> AccountName -> Amount balanceInAccountNamed :: RawLedger -> AccountName -> Amount
balanceInAccountNamed l a = balanceInAccountNamed l a =
sumEntryTransactions (transactionsInAccountNamed l a) sumEntryTransactions (transactionsInAccountNamed l a)
aggregateBalanceInAccountNamed :: Ledger -> AccountName -> Amount aggregateBalanceInAccountNamed :: RawLedger -> AccountName -> Amount
aggregateBalanceInAccountNamed l a = aggregateBalanceInAccountNamed l a =
sumEntryTransactions (aggregateTransactionsInAccountNamed l a) sumEntryTransactions (aggregateTransactionsInAccountNamed l a)
transactionsInAccountNamed :: Ledger -> AccountName -> [EntryTransaction] transactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction]
transactionsInAccountNamed l a = transactionsInAccountNamed l a =
ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l
aggregateTransactionsInAccountNamed :: Ledger -> AccountName -> [EntryTransaction] aggregateTransactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction]
aggregateTransactionsInAccountNamed l a = aggregateTransactionsInAccountNamed l a =
ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l
-- build a tree of Accounts -- build a tree of Accounts
addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account addDataToAccountNameTree :: RawLedger -> Tree AccountName -> Tree Account
addDataToAccountNameTree l ant = addDataToAccountNameTree l ant =
Node Node
(ledgerAccount l $ root ant) (ledgerAccount l $ root ant)
@ -92,13 +92,13 @@ addDataToAccountNameTree l ant =
-- $ checking -- $ checking
-- $ saving -- $ saving
showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String showLedgerAccounts :: RawLedger -> [String] -> Bool -> Int -> String
showLedgerAccounts l acctpats showsubs maxdepth = showLedgerAccounts l acctpats showsubs maxdepth =
concatMap concatMap
(showAccountTree l) (showAccountTree l)
(branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth)) (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 [".*"] showsubs maxdepth ledgerAccountTreeMatching l [".*"] showsubs maxdepth
ledgerAccountTreeMatching l acctpats showsubs maxdepth = ledgerAccountTreeMatching l acctpats showsubs maxdepth =
@ -130,7 +130,7 @@ ledgerAccountTreeMatching l acctpats showsubs maxdepth =
-- e -- e
-- f -- f
-- g -- g
showAccountTree :: Ledger -> Tree Account -> String showAccountTree :: RawLedger -> Tree Account -> String
showAccountTree l = showAccountTree' l 0 . interestingAccountsFrom showAccountTree l = showAccountTree' l 0 . interestingAccountsFrom
showAccountTree' l indentlevel t showAccountTree' l indentlevel t
@ -149,7 +149,7 @@ showAccountTree' l indentlevel t
boringparents = takeWhile (isBoringInnerAccountName l) $ parentAccountNames $ aname acct boringparents = takeWhile (isBoringInnerAccountName l) $ parentAccountNames $ aname acct
leafname = accountLeafName $ aname acct leafname = accountLeafName $ aname acct
isBoringInnerAccount :: Ledger -> Account -> Bool isBoringInnerAccount :: RawLedger -> Account -> Bool
isBoringInnerAccount l a isBoringInnerAccount l a
| name == "top" = False | name == "top" = False
| (length txns == 0) && ((length subs) == 1) = True | (length txns == 0) && ((length subs) == 1) = True
@ -160,7 +160,7 @@ isBoringInnerAccount l a
subs = subAccountNamesFrom (ledgerAccountNames l) name subs = subAccountNamesFrom (ledgerAccountNames l) name
-- darnit, still need this -- darnit, still need this
isBoringInnerAccountName :: Ledger -> AccountName -> Bool isBoringInnerAccountName :: RawLedger -> AccountName -> Bool
isBoringInnerAccountName l name isBoringInnerAccountName l name
| name == "top" = False | name == "top" = False
| (length txns == 0) && ((length subs) == 1) = True | (length txns == 0) && ((length subs) == 1) = True
@ -176,5 +176,5 @@ interestingAccountsFrom =
hasbalance = (/= 0) . abalance hasbalance = (/= 0) . abalance
hastxns = (> 0) . length . atransactions hastxns = (> 0) . length . atransactions
ledgerAccountTree :: Ledger -> Tree Account ledgerAccountTree :: RawLedger -> Tree Account
ledgerAccountTree l = addDataToAccountNameTree l (ledgerAccountNameTree l) ledgerAccountTree l = addDataToAccountNameTree l (ledgerAccountNameTree l)

View File

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

View File

@ -3,54 +3,47 @@ where
import qualified Data.Map as Map import qualified Data.Map as Map
import Utils import Utils
import AccountName
import Types import Types
import Entry import Account
import AccountName
import EntryTransaction import EntryTransaction
import RawLedger
instance Show Ledger where cacheLedger :: RawLedger -> Ledger
show l = printf "Ledger with %d entries" cacheLedger l =
((length $ entries l) + Ledger
(length $ modifier_entries l) + l
(length $ periodic_entries l)) (ledgerAccountNameTree l)
(Map.fromList [(a, ledgerAccount l a) | a <- ledgerAccountNames l])
ledgerTransactions :: Ledger -> [EntryTransaction] cLedgerTransactions :: Ledger -> [EntryTransaction]
ledgerTransactions l = entryTransactionsFrom $ entries l cLedgerTransactions l = concatMap atransactions $ Map.elems $ accounts l
ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] -- unoptimised
ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l cLedgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction]
ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l cLedgerTransactionsMatching pats l = ledgerTransactionsMatching pats $ rawledger l
ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l
ledgerTransactionsMatching (acctregexps,descregexps) 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 intersect
(concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) (concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
(concat [filter (matchTransactionDescription r) ts | r <- descregexps]) (concat [filter (matchTransactionDescription r) ts | r <- descregexps])
where ts = ledgerTransactions l where ts = cLedgerTransactions 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
-- 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))

View File

@ -8,9 +8,9 @@ module Models (
module Entry, module Entry,
module TimeLog, module TimeLog,
module EntryTransaction, module EntryTransaction,
module Ledger, module RawLedger,
module Account, module Account,
module CachedLedger, module Ledger,
) )
where where
import qualified Data.Map as Map import qualified Data.Map as Map
@ -23,7 +23,7 @@ import Transaction
import Entry import Entry
import TimeLog import TimeLog
import EntryTransaction import EntryTransaction
import Ledger import RawLedger
import Account import Account
import CachedLedger import Ledger

View File

@ -36,7 +36,7 @@ reserved = P.reserved lexer
reservedOp = P.reservedOp lexer reservedOp = P.reservedOp lexer
ledgerfile :: Parser Ledger ledgerfile :: Parser RawLedger
ledgerfile = ledger <|> ledgerfromtimelog 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 -- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs
-- sample data in Tests.hs -- sample data in Tests.hs
ledger :: Parser Ledger ledger :: Parser RawLedger
ledger = do ledger = do
ledgernondatalines ledgernondatalines
-- for now these must come first, unlike ledger -- for now these must come first, unlike ledger
@ -150,7 +150,7 @@ ledger = do
-- --
entries <- (many ledgerentry) <?> "entry" entries <- (many ledgerentry) <?> "entry"
eof eof
return $ Ledger modifier_entries periodic_entries entries return $ RawLedger modifier_entries periodic_entries entries
ledgernondatalines :: Parser [String] ledgernondatalines :: Parser [String]
ledgernondatalines = many (ledgerdirective <|> ledgercomment <|> do {whiteSpace1; return []}) 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 ledgerfromtimelog = do
tl <- timelog tl <- timelog
return $ ledgerFromTimeLog tl return $ ledgerFromTimeLog tl
@ -320,7 +320,7 @@ printParseResult :: Show v => Either ParseError v -> IO ()
printParseResult r = case r of Left e -> parseError e printParseResult r = case r of Left e -> parseError e
Right v -> print v Right v -> print v
parseLedgerFile :: String -> IO (Either ParseError Ledger) parseLedgerFile :: String -> IO (Either ParseError RawLedger)
parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin
parseLedgerFile f = parseFromFile ledgerfile f parseLedgerFile f = parseFromFile ledgerfile f

56
RawLedger.hs Normal file
View File

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

View File

@ -155,7 +155,7 @@ ledger7_str = "\
\\n" --" \\n" --"
l = ledger7 l = ledger7
ledger7 = Ledger ledger7 = RawLedger
[] []
[] []
[ [

View File

@ -6,7 +6,7 @@ import Currency
import Amount import Amount
import Transaction import Transaction
import Entry import Entry
import Ledger import RawLedger
instance Show TimeLogEntry where instance Show TimeLogEntry where
show t = printf "%s %s %s" (show $ tcode t) (tdatetime t) (tcomment t) 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 instance Show TimeLog where
show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl
ledgerFromTimeLog :: TimeLog -> Ledger ledgerFromTimeLog :: TimeLog -> RawLedger
ledgerFromTimeLog tl = ledgerFromTimeLog tl =
Ledger [] [] (entriesFromTimeLogEntries $ timelog_entries tl) RawLedger [] [] (entriesFromTimeLogEntries $ timelog_entries tl)
entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry] entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry]

View File

@ -17,9 +17,9 @@ hledger
Models Models
TimeLog TimeLog
TimeLogEntry TimeLogEntry
CachedLedger Ledger
Account Account
Ledger RawLedger
EntryTransaction EntryTransaction
Entry Entry
Transaction Transaction
@ -92,7 +92,7 @@ data TimeLog = TimeLog {
} deriving (Eq) } deriving (Eq)
-- a parsed ledger file -- a parsed ledger file
data Ledger = Ledger { data RawLedger = RawLedger {
modifier_entries :: [ModifierEntry], modifier_entries :: [ModifierEntry],
periodic_entries :: [PeriodicEntry], periodic_entries :: [PeriodicEntry],
entries :: [Entry] entries :: [Entry]
@ -104,7 +104,7 @@ data Ledger = Ledger {
-- "transactions" in modules above EntryTransaction. -- "transactions" in modules above EntryTransaction.
type EntryTransaction = (Entry,Transaction) 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 { data Account = Account {
aname :: AccountName, aname :: AccountName,
atransactions :: [EntryTransaction], -- excludes sub-accounts atransactions :: [EntryTransaction], -- excludes sub-accounts
@ -112,8 +112,8 @@ data Account = Account {
} }
-- a ledger with account info cached for faster queries -- a ledger with account info cached for faster queries
data CachedLedger = CachedLedger { data Ledger = Ledger {
uncached_ledger :: Ledger, rawledger :: RawLedger,
accountnames :: Tree AccountName, accountnames :: Tree AccountName,
accounts :: Map.Map AccountName Account accounts :: Map.Map AccountName Account
} }

View File

@ -63,11 +63,11 @@ selftest = do
-- utils -- utils
doWithLedger :: [Flag] -> (CachedLedger -> IO ()) -> IO () doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO ()
doWithLedger opts cmd = do doWithLedger opts cmd = do
ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd
doWithParsed :: (CachedLedger -> IO ()) -> (Either ParseError Ledger) -> IO () doWithParsed :: (Ledger -> IO ()) -> (Either ParseError RawLedger) -> IO ()
doWithParsed cmd parsed = do doWithParsed cmd parsed = do
case parsed of Left e -> parseError e case parsed of Left e -> parseError e
Right l -> cmd $ cacheLedger l Right l -> cmd $ cacheLedger l
@ -75,7 +75,7 @@ doWithParsed cmd parsed = do
-- interactive testing: -- interactive testing:
-- --
-- p <- ledgerFilePath [] >>= parseLedgerFile -- p <- ledgerFilePath [] >>= parseLedgerFile
-- let l = either (\_ -> Ledger [] [] []) id p -- let l = either (\_ -> RawLedger [] [] []) id p
-- let ant = ledgerAccountNameTree l -- let ant = ledgerAccountNameTree l
-- let at = ledgerAccountTreeMatching l [] True 999 -- let at = ledgerAccountTreeMatching l [] True 999
-- putStr $ drawTree $ treemap show $ ledgerAccountTreeMatching l ["a"] False 999 -- putStr $ drawTree $ treemap show $ ledgerAccountTreeMatching l ["a"] False 999