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