simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-11-08 07:09:28 +03:00
Code Issues Projects Releases Wiki Activity

more optimisation

Browse Source
This commit is contained in:
Simon Michael 2007-07-03 05:43:00 +00:00
parent 8074907ef8
commit 78a506e85a
2 changed files with 16 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
Ledger.hs
View File

@ -2,9 +2,11 @@ module Ledger
where where
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Map ((!)) import Data.Map ((!))
import Data.Ord (comparing)
import Utils import Utils
import Types import Types
import Amount
import Account import Account
import AccountName import AccountName
import EntryTransaction import EntryTransaction
@ -14,17 +16,20 @@ import RawLedger
cacheLedger :: RawLedger -> Ledger cacheLedger :: RawLedger -> Ledger
cacheLedger l = cacheLedger l =
let let
ant = rawLedgerAccountNameTree l ant = trace "caching" $ rawLedgerAccountNameTree l
ans = flatten ant ans = flatten ant
ts = rawLedgerTransactions l ts = rawLedgerTransactions l
amap = Map.fromList [ sortedts = sortBy (comparing account) ts
(a, groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
Account a tmap = Map.union
(transactionsWithAccountName a ts) (Map.fromList [(account $ head g, g) | g <- groupedts])
(sumEntryTransactions $ transactionsWithOrBelowAccountName a ts) (Map.fromList [(a,[]) | a <- ans])
) | a <- ans] bmap = Map.union
(Map.fromList [(a, sumEntryTransactions $ transactionsWithOrBelowAccountName a ts) | a <- ans])
(Map.fromList [(a,nullamt) | a <- ans])
amap = Map.fromList [(a, Account a (tmap ! a) (bmap ! a)) | a <- ans]
in in
Ledger l ant amap Ledger l ant amap
ledgerAccount :: Ledger -> AccountName -> Account ledgerAccount :: Ledger -> AccountName -> Account
-- wtf ledgerAccount l = ((accounts l) (!)) -- wtf ledgerAccount l = ((accounts l) (!))
@ -33,11 +38,9 @@ ledgerAccount l aname = head [a | (n,a) <- Map.toList $ accounts l, n == aname]
ledgerTransactions :: Ledger -> [EntryTransaction] ledgerTransactions :: Ledger -> [EntryTransaction]
ledgerTransactions l = concatMap atransactions $ Map.elems $ accounts l ledgerTransactions l = concatMap atransactions $ Map.elems $ accounts l
-- XXX optimise
ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction]
ledgerTransactionsMatching pats l = rawLedgerTransactionsMatching pats $ rawledger l ledgerTransactionsMatching pats l = rawLedgerTransactionsMatching pats $ rawledger l
-- XXX optimise (in progress)
showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String
showLedgerAccounts l acctpats showsubs maxdepth = showLedgerAccounts l acctpats showsubs maxdepth =
concatMap concatMap
@ -83,8 +86,8 @@ isBoringInnerAccountName2 l name
| (length txns == 0) && ((length subs) == 1) = True | (length txns == 0) && ((length subs) == 1) = True
| otherwise = False | otherwise = False
where where
txns = transactionsInAccountNamed2 l name txns = atransactions $ ledgerAccount l name
subs = subAccountNamesFrom (rawLedgerAccountNames (rawledger l)) name subs = subAccountNamesFrom (accountnames l) name
transactionsInAccountNamed2 :: Ledger -> AccountName -> [EntryTransaction] transactionsInAccountNamed2 :: Ledger -> AccountName -> [EntryTransaction]
transactionsInAccountNamed2 l a = atransactions $ ledgerAccount l a transactionsInAccountNamed2 l a = atransactions $ ledgerAccount l a

2
hledger.hs
View File

@ -65,7 +65,7 @@ selftest = do
doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO () doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO ()
doWithLedger opts cmd = do doWithLedger opts cmd = do
ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd ledgerFilePath opts >>= (trace "parsing" $ parseLedgerFile) >>= doWithParsed cmd
doWithParsed :: (Ledger -> IO ()) -> (Either ParseError RawLedger) -> IO () doWithParsed :: (Ledger -> IO ()) -> (Either ParseError RawLedger) -> IO ()
doWithParsed cmd parsed = do doWithParsed cmd parsed = do