mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-09 00:15:48 +03:00
code cleanups
This commit is contained in:
parent
db8b00d6e5
commit
f865ab1c1c
@ -1,7 +1,7 @@
|
||||
{-|
|
||||
|
||||
An 'Account' stores an account name, all transactions in the account
|
||||
(excluding any subaccounts), and the total balance (including any
|
||||
An 'Account' stores, for efficiency: an 'AccountName', all transactions in
|
||||
the account (excluding subaccounts), and the account balance (including
|
||||
subaccounts).
|
||||
|
||||
-}
|
||||
@ -16,5 +16,8 @@ import Ledger.Amount
|
||||
instance Show Account where
|
||||
show (Account a ts b) = printf "Account %s with %d txns and %s balance" a (length ts) (showMixedAmount b)
|
||||
|
||||
instance Eq Account where
|
||||
(==) (Account n1 t1 b1) (Account n2 t2 b2) = n1 == n2 && t1 == t2 && b1 == b2
|
||||
|
||||
nullacct = Account "" [] []
|
||||
|
||||
|
@ -1,8 +1,8 @@
|
||||
{-|
|
||||
|
||||
A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of
|
||||
account names, a map from account names to 'Account's. Typically it
|
||||
also has had uninteresting 'Entry's filtered out.
|
||||
A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of account
|
||||
names, and a map from account names to 'Account's. Typically it also has
|
||||
had uninteresting 'Entry's filtered out.
|
||||
|
||||
-}
|
||||
|
||||
@ -14,6 +14,7 @@ import Ledger.Utils
|
||||
import Ledger.Types
|
||||
import Ledger.Amount
|
||||
import Ledger.AccountName
|
||||
import Ledger.Account
|
||||
import Ledger.Transaction
|
||||
import Ledger.RawLedger
|
||||
import Ledger.Entry
|
||||
@ -29,27 +30,25 @@ instance Show Ledger where
|
||||
|
||||
-- | Convert a raw ledger to a more efficient cached type, described above.
|
||||
cacheLedger :: RawLedger -> Ledger
|
||||
cacheLedger l =
|
||||
let
|
||||
ant = rawLedgerAccountNameTree l
|
||||
anames = flatten ant
|
||||
ts = rawLedgerTransactions l
|
||||
sortedts = sortBy (comparing account) ts
|
||||
groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
|
||||
txnmap = Map.union
|
||||
cacheLedger l = Ledger l ant amap
|
||||
where
|
||||
ant = rawLedgerAccountNameTree l
|
||||
anames = flatten ant
|
||||
ts = rawLedgerTransactions l
|
||||
sortedts = sortBy (comparing account) ts
|
||||
groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
|
||||
txnmap = Map.union
|
||||
(Map.fromList [(account $ head g, g) | g <- groupedts])
|
||||
(Map.fromList [(a,[]) | a <- anames])
|
||||
txnsof = (txnmap !)
|
||||
subacctsof a = filter (a `isAccountNamePrefixOf`) anames
|
||||
subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a]
|
||||
balmap = Map.union
|
||||
txnsof = (txnmap !)
|
||||
subacctsof a = filter (a `isAccountNamePrefixOf`) anames
|
||||
subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a]
|
||||
balmap = Map.union
|
||||
(Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- anames])
|
||||
(Map.fromList [(a,[]) | a <- anames])
|
||||
amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
|
||||
in
|
||||
Ledger l ant amap
|
||||
amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
|
||||
|
||||
-- | List a 'Ledger' 's account names.
|
||||
-- | List a ledger's account names.
|
||||
accountnames :: Ledger -> [AccountName]
|
||||
accountnames l = drop 1 $ flatten $ accountnametree l
|
||||
|
||||
@ -73,11 +72,8 @@ accountsMatching pats l = filter (matchLedgerPatterns True pats . aname) $ accou
|
||||
|
||||
-- | List a ledger account's immediate subaccounts
|
||||
subAccounts :: Ledger -> Account -> [Account]
|
||||
subAccounts l a = map (ledgerAccount l) subacctnames
|
||||
where
|
||||
allnames = accountnames l
|
||||
name = aname a
|
||||
subacctnames = filter (name `isAccountNamePrefixOf`) allnames
|
||||
subAccounts l Account{aname=a} =
|
||||
map (ledgerAccount l) $ filter (a `isAccountNamePrefixOf`) $ accountnames l
|
||||
|
||||
-- | List a ledger's transactions.
|
||||
ledgerTransactions :: Ledger -> [Transaction]
|
||||
@ -85,22 +81,8 @@ ledgerTransactions l = rawLedgerTransactions $ rawledger l
|
||||
|
||||
-- | Get a ledger's tree of accounts to the specified depth.
|
||||
ledgerAccountTree :: Int -> Ledger -> Tree Account
|
||||
ledgerAccountTree depth l =
|
||||
addDataToAccountNameTree l depthpruned
|
||||
where
|
||||
nametree = accountnametree l
|
||||
depthpruned = treeprune depth nametree
|
||||
|
||||
-- that's weird.. why can't this be in Account.hs ?
|
||||
instance Eq Account where
|
||||
(==) (Account n1 t1 b1) (Account n2 t2 b2) = n1 == n2 && t1 == t2 && b1 == b2
|
||||
ledgerAccountTree depth l = treemap (ledgerAccount l) $ treeprune depth $ accountnametree l
|
||||
|
||||
-- | Get a ledger's tree of accounts rooted at the specified account.
|
||||
ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account)
|
||||
ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
|
||||
|
||||
-- | Convert a tree of account names into a tree of accounts, using their
|
||||
-- parent ledger.
|
||||
addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
|
||||
addDataToAccountNameTree = treemap . ledgerAccount
|
||||
|
||||
|
@ -29,10 +29,8 @@ instance Show RawLedger where
|
||||
where accounts = flatten $ rawLedgerAccountNameTree l
|
||||
|
||||
rawLedgerTransactions :: RawLedger -> [Transaction]
|
||||
rawLedgerTransactions = txns . entries
|
||||
where
|
||||
txns :: [Entry] -> [Transaction]
|
||||
txns es = concat $ map flattenEntry $ zip es (iterate (+1) 1)
|
||||
rawLedgerTransactions = txnsof . entries
|
||||
where txnsof es = concat $ map flattenEntry $ zip es [1..]
|
||||
|
||||
rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]
|
||||
rawLedgerAccountNamesUsed = accountNamesFromTransactions . rawLedgerTransactions
|
||||
@ -55,9 +53,7 @@ filterRawLedger begin end pats =
|
||||
filterRawLedgerEntriesByDescription :: [String] -> RawLedger -> RawLedger
|
||||
filterRawLedgerEntriesByDescription pats (RawLedger ms ps es f) =
|
||||
RawLedger ms ps (filter matchdesc es) f
|
||||
where
|
||||
matchdesc :: Entry -> Bool
|
||||
matchdesc = matchLedgerPatterns False pats . edescription
|
||||
where matchdesc = matchLedgerPatterns False pats . edescription
|
||||
|
||||
-- | Keep only entries which fall between begin and end dates.
|
||||
-- We include entries on the begin date and exclude entries on the end
|
||||
@ -65,14 +61,11 @@ filterRawLedgerEntriesByDescription pats (RawLedger ms ps es f) =
|
||||
filterRawLedgerEntriesByDate :: String -> String -> RawLedger -> RawLedger
|
||||
filterRawLedgerEntriesByDate begin end (RawLedger ms ps es f) =
|
||||
RawLedger ms ps (filter matchdate es) f
|
||||
where
|
||||
matchdate :: Entry -> Bool
|
||||
matchdate e = (begin == "" || entrydate >= begindate) &&
|
||||
(end == "" || entrydate < enddate)
|
||||
where
|
||||
begindate = parsedate begin :: UTCTime
|
||||
enddate = parsedate end
|
||||
entrydate = parsedate $ edate e
|
||||
where
|
||||
d1 = parsedate begin :: UTCTime
|
||||
d2 = parsedate end
|
||||
matchdate e = (null begin || d >= d1) && (null end || d < d2)
|
||||
where d = parsedate $ edate e
|
||||
|
||||
|
||||
-- | Check if a set of ledger account/description patterns matches the
|
||||
@ -86,14 +79,14 @@ filterRawLedgerEntriesByDate begin end (RawLedger ms ps es f) =
|
||||
-- matches only the leaf name.
|
||||
matchLedgerPatterns :: Bool -> [String] -> String -> Bool
|
||||
matchLedgerPatterns forbalancereport pats str =
|
||||
(null positives || any ismatch positives) && (null negatives || (not $ any ismatch negatives))
|
||||
(null positives || any ismatch positives) && (null negatives || not (any ismatch negatives))
|
||||
where
|
||||
isnegative = (== negativepatternchar) . head
|
||||
(negatives,positives) = partition isnegative pats
|
||||
ismatch pat = containsRegex (mkRegexWithOpts pat' True True) matchee
|
||||
where
|
||||
pat' = if isnegative pat then drop 1 pat else pat
|
||||
matchee = if forbalancereport && (not $ ':' `elem` pat) && (not $ isnegative pat)
|
||||
matchee = if forbalancereport && not (':' `elem` pat) && not (isnegative pat)
|
||||
then accountLeafName str
|
||||
else str
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user