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
|
An 'Account' stores, for efficiency: an 'AccountName', all transactions in
|
||||||
(excluding any subaccounts), and the total balance (including any
|
the account (excluding subaccounts), and the account balance (including
|
||||||
subaccounts).
|
subaccounts).
|
||||||
|
|
||||||
-}
|
-}
|
||||||
@ -16,5 +16,8 @@ import Ledger.Amount
|
|||||||
instance Show Account where
|
instance Show Account where
|
||||||
show (Account a ts b) = printf "Account %s with %d txns and %s balance" a (length ts) (showMixedAmount b)
|
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 "" [] []
|
nullacct = Account "" [] []
|
||||||
|
|
||||||
|
|||||||
@ -1,8 +1,8 @@
|
|||||||
{-|
|
{-|
|
||||||
|
|
||||||
A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of
|
A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of account
|
||||||
account names, a map from account names to 'Account's. Typically it
|
names, and a map from account names to 'Account's. Typically it also has
|
||||||
also has had uninteresting 'Entry's filtered out.
|
had uninteresting 'Entry's filtered out.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
@ -14,6 +14,7 @@ import Ledger.Utils
|
|||||||
import Ledger.Types
|
import Ledger.Types
|
||||||
import Ledger.Amount
|
import Ledger.Amount
|
||||||
import Ledger.AccountName
|
import Ledger.AccountName
|
||||||
|
import Ledger.Account
|
||||||
import Ledger.Transaction
|
import Ledger.Transaction
|
||||||
import Ledger.RawLedger
|
import Ledger.RawLedger
|
||||||
import Ledger.Entry
|
import Ledger.Entry
|
||||||
@ -29,8 +30,8 @@ instance Show Ledger where
|
|||||||
|
|
||||||
-- | Convert a raw ledger to a more efficient cached type, described above.
|
-- | Convert a raw ledger to a more efficient cached type, described above.
|
||||||
cacheLedger :: RawLedger -> Ledger
|
cacheLedger :: RawLedger -> Ledger
|
||||||
cacheLedger l =
|
cacheLedger l = Ledger l ant amap
|
||||||
let
|
where
|
||||||
ant = rawLedgerAccountNameTree l
|
ant = rawLedgerAccountNameTree l
|
||||||
anames = flatten ant
|
anames = flatten ant
|
||||||
ts = rawLedgerTransactions l
|
ts = rawLedgerTransactions l
|
||||||
@ -46,10 +47,8 @@ cacheLedger l =
|
|||||||
(Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- anames])
|
(Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- anames])
|
||||||
(Map.fromList [(a,[]) | a <- anames])
|
(Map.fromList [(a,[]) | a <- anames])
|
||||||
amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
|
amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
|
||||||
in
|
|
||||||
Ledger l ant amap
|
|
||||||
|
|
||||||
-- | List a 'Ledger' 's account names.
|
-- | List a ledger's account names.
|
||||||
accountnames :: Ledger -> [AccountName]
|
accountnames :: Ledger -> [AccountName]
|
||||||
accountnames l = drop 1 $ flatten $ accountnametree l
|
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
|
-- | List a ledger account's immediate subaccounts
|
||||||
subAccounts :: Ledger -> Account -> [Account]
|
subAccounts :: Ledger -> Account -> [Account]
|
||||||
subAccounts l a = map (ledgerAccount l) subacctnames
|
subAccounts l Account{aname=a} =
|
||||||
where
|
map (ledgerAccount l) $ filter (a `isAccountNamePrefixOf`) $ accountnames l
|
||||||
allnames = accountnames l
|
|
||||||
name = aname a
|
|
||||||
subacctnames = filter (name `isAccountNamePrefixOf`) allnames
|
|
||||||
|
|
||||||
-- | List a ledger's transactions.
|
-- | List a ledger's transactions.
|
||||||
ledgerTransactions :: Ledger -> [Transaction]
|
ledgerTransactions :: Ledger -> [Transaction]
|
||||||
@ -85,22 +81,8 @@ ledgerTransactions l = rawLedgerTransactions $ rawledger l
|
|||||||
|
|
||||||
-- | Get a ledger's tree of accounts to the specified depth.
|
-- | Get a ledger's tree of accounts to the specified depth.
|
||||||
ledgerAccountTree :: Int -> Ledger -> Tree Account
|
ledgerAccountTree :: Int -> Ledger -> Tree Account
|
||||||
ledgerAccountTree depth l =
|
ledgerAccountTree depth l = treemap (ledgerAccount l) $ treeprune depth $ accountnametree 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
|
|
||||||
|
|
||||||
-- | Get a ledger's tree of accounts rooted at the specified account.
|
-- | Get a ledger's tree of accounts rooted at the specified account.
|
||||||
ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account)
|
ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account)
|
||||||
ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
|
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
|
where accounts = flatten $ rawLedgerAccountNameTree l
|
||||||
|
|
||||||
rawLedgerTransactions :: RawLedger -> [Transaction]
|
rawLedgerTransactions :: RawLedger -> [Transaction]
|
||||||
rawLedgerTransactions = txns . entries
|
rawLedgerTransactions = txnsof . entries
|
||||||
where
|
where txnsof es = concat $ map flattenEntry $ zip es [1..]
|
||||||
txns :: [Entry] -> [Transaction]
|
|
||||||
txns es = concat $ map flattenEntry $ zip es (iterate (+1) 1)
|
|
||||||
|
|
||||||
rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]
|
rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]
|
||||||
rawLedgerAccountNamesUsed = accountNamesFromTransactions . rawLedgerTransactions
|
rawLedgerAccountNamesUsed = accountNamesFromTransactions . rawLedgerTransactions
|
||||||
@ -55,9 +53,7 @@ filterRawLedger begin end pats =
|
|||||||
filterRawLedgerEntriesByDescription :: [String] -> RawLedger -> RawLedger
|
filterRawLedgerEntriesByDescription :: [String] -> RawLedger -> RawLedger
|
||||||
filterRawLedgerEntriesByDescription pats (RawLedger ms ps es f) =
|
filterRawLedgerEntriesByDescription pats (RawLedger ms ps es f) =
|
||||||
RawLedger ms ps (filter matchdesc es) f
|
RawLedger ms ps (filter matchdesc es) f
|
||||||
where
|
where matchdesc = matchLedgerPatterns False pats . edescription
|
||||||
matchdesc :: Entry -> Bool
|
|
||||||
matchdesc = matchLedgerPatterns False pats . edescription
|
|
||||||
|
|
||||||
-- | Keep only entries which fall between begin and end dates.
|
-- | Keep only entries which fall between begin and end dates.
|
||||||
-- We include entries on the begin date and exclude entries on the end
|
-- We include entries on the begin date and exclude entries on the end
|
||||||
@ -66,13 +62,10 @@ filterRawLedgerEntriesByDate :: String -> String -> RawLedger -> RawLedger
|
|||||||
filterRawLedgerEntriesByDate begin end (RawLedger ms ps es f) =
|
filterRawLedgerEntriesByDate begin end (RawLedger ms ps es f) =
|
||||||
RawLedger ms ps (filter matchdate es) f
|
RawLedger ms ps (filter matchdate es) f
|
||||||
where
|
where
|
||||||
matchdate :: Entry -> Bool
|
d1 = parsedate begin :: UTCTime
|
||||||
matchdate e = (begin == "" || entrydate >= begindate) &&
|
d2 = parsedate end
|
||||||
(end == "" || entrydate < enddate)
|
matchdate e = (null begin || d >= d1) && (null end || d < d2)
|
||||||
where
|
where d = parsedate $ edate e
|
||||||
begindate = parsedate begin :: UTCTime
|
|
||||||
enddate = parsedate end
|
|
||||||
entrydate = parsedate $ edate e
|
|
||||||
|
|
||||||
|
|
||||||
-- | Check if a set of ledger account/description patterns matches the
|
-- | 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.
|
-- matches only the leaf name.
|
||||||
matchLedgerPatterns :: Bool -> [String] -> String -> Bool
|
matchLedgerPatterns :: Bool -> [String] -> String -> Bool
|
||||||
matchLedgerPatterns forbalancereport pats str =
|
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
|
where
|
||||||
isnegative = (== negativepatternchar) . head
|
isnegative = (== negativepatternchar) . head
|
||||||
(negatives,positives) = partition isnegative pats
|
(negatives,positives) = partition isnegative pats
|
||||||
ismatch pat = containsRegex (mkRegexWithOpts pat' True True) matchee
|
ismatch pat = containsRegex (mkRegexWithOpts pat' True True) matchee
|
||||||
where
|
where
|
||||||
pat' = if isnegative pat then drop 1 pat else pat
|
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
|
then accountLeafName str
|
||||||
else str
|
else str
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user