a first cut at mixed amounts. Accounts have a MixedAmount balance, displayed on one line
This commit is contained in:
		
							parent
							
								
									d31ba41703
								
							
						
					
					
						commit
						c444b02349
					
				| @ -122,16 +122,16 @@ showBalanceReport :: [Opt] -> [String] -> Ledger -> String | |||||||
| showBalanceReport opts args l = acctsstr ++ totalstr | showBalanceReport opts args l = acctsstr ++ totalstr | ||||||
|     where  |     where  | ||||||
|       acctsstr = concatMap (showAccountTreeWithBalances acctnamestoshow) $ subs treetoshow |       acctsstr = concatMap (showAccountTreeWithBalances acctnamestoshow) $ subs treetoshow | ||||||
|       totalstr = if isZeroAmount total  |       totalstr = if isZeroMixedAmount total  | ||||||
|                  then ""  |                  then ""  | ||||||
|                  else printf "--------------------\n%20s\n" $ showAmount total |                  else printf "--------------------\n%20s\n" $ showMixedAmount total | ||||||
|       showingsubs = ShowSubs `elem` opts |       showingsubs = ShowSubs `elem` opts | ||||||
|       pats@(apats,dpats) = parseAccountDescriptionArgs args |       pats@(apats,dpats) = parseAccountDescriptionArgs args | ||||||
|       maxdepth = if null args && not showingsubs then 1 else 9999 |       maxdepth = if null args && not showingsubs then 1 else 9999 | ||||||
|       acctstoshow = balancereportaccts showingsubs apats l |       acctstoshow = balancereportaccts showingsubs apats l | ||||||
|       acctnamestoshow = map aname acctstoshow |       acctnamestoshow = map aname acctstoshow | ||||||
|       treetoshow = pruneZeroBalanceLeaves $ pruneUnmatchedAccounts $ treeprune maxdepth $ ledgerAccountTree 9999 l |       treetoshow = pruneZeroBalanceLeaves $ pruneUnmatchedAccounts $ treeprune maxdepth $ ledgerAccountTree 9999 l | ||||||
|       total = sumAmounts $ map abalance $ nonredundantaccts |       total = sumMixedAmounts $ map abalance $ nonredundantaccts | ||||||
|       nonredundantaccts = filter (not . hasparentshowing) acctstoshow |       nonredundantaccts = filter (not . hasparentshowing) acctstoshow | ||||||
|       hasparentshowing a = (parentAccountName $ aname a) `elem` acctnamestoshow |       hasparentshowing a = (parentAccountName $ aname a) `elem` acctnamestoshow | ||||||
| 
 | 
 | ||||||
| @ -158,7 +158,7 @@ showBalanceReport opts args l = acctsstr ++ totalstr | |||||||
| 
 | 
 | ||||||
|       -- remove zero-balance leaf accounts (recursively) |       -- remove zero-balance leaf accounts (recursively) | ||||||
|       pruneZeroBalanceLeaves :: Tree Account -> Tree Account |       pruneZeroBalanceLeaves :: Tree Account -> Tree Account | ||||||
|       pruneZeroBalanceLeaves = treefilter (not . isZeroAmount . abalance) |       pruneZeroBalanceLeaves = treefilter (not . isZeroMixedAmount . abalance) | ||||||
| 
 | 
 | ||||||
| -- | Show a tree of accounts with balances, for the balance report, | -- | Show a tree of accounts with balances, for the balance report, | ||||||
| -- eliding boring parent accounts. Requires a list of the account names we | -- eliding boring parent accounts. Requires a list of the account names we | ||||||
| @ -176,7 +176,7 @@ showAccountTreeWithBalances matchednames = | |||||||
|             subswithprefix = showsubs indent (prefix++leafname++":") |             subswithprefix = showsubs indent (prefix++leafname++":") | ||||||
|             showsubs i p = concatMap (showAccountTreeWithBalances' matchednames i p) subs |             showsubs i p = concatMap (showAccountTreeWithBalances' matchednames i p) subs | ||||||
|             this = showbal ++ spaces ++ prefix ++ leafname ++ "\n" |             this = showbal ++ spaces ++ prefix ++ leafname ++ "\n" | ||||||
|             showbal = printf "%20s" $ show bal |             showbal = printf "%20s" $ showMixedAmount bal | ||||||
|             spaces = "  " ++ replicate (indent * 2) ' ' |             spaces = "  " ++ replicate (indent * 2) ' ' | ||||||
|             leafname = accountLeafName fullname |             leafname = accountLeafName fullname | ||||||
|             isboringparent = numsubs >= 1 && (bal == subbal || not matched) |             isboringparent = numsubs >= 1 && (bal == subbal || not matched) | ||||||
|  | |||||||
| @ -14,7 +14,7 @@ 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) (show b) |     show (Account a ts b) = printf "Account %s with %d txns and %s balance" a (length ts) (showMixedAmount b) | ||||||
| 
 | 
 | ||||||
| nullacct = Account "" [] nullamt | nullacct = Account "" [] [] | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -38,13 +38,31 @@ examples: | |||||||
| 
 | 
 | ||||||
| module Ledger.Amount | module Ledger.Amount | ||||||
| where | where | ||||||
|  | import qualified Data.Map as Map | ||||||
| import Ledger.Utils | import Ledger.Utils | ||||||
| import Ledger.Types | import Ledger.Types | ||||||
| import Ledger.Commodity | import Ledger.Commodity | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| instance Show Amount where show = showAmount | instance Show Amount where show = showAmount | ||||||
|  | -- instance Show MixedAmount where show = showMixedAmount | ||||||
| 
 | 
 | ||||||
|  | showMixedAmount :: MixedAmount -> String | ||||||
|  | showMixedAmount as = concat $ intersperse ", " $ map show $ normaliseMixedAmount as | ||||||
|  | 
 | ||||||
|  | normaliseMixedAmount :: MixedAmount -> MixedAmount | ||||||
|  | normaliseMixedAmount as = map sumAmounts $ groupAmountsByCommodity as | ||||||
|  | 
 | ||||||
|  | groupAmountsByCommodity :: [Amount] -> [[Amount]] | ||||||
|  | groupAmountsByCommodity as = grouped | ||||||
|  |     where | ||||||
|  |       grouped = [filter (hassymbol s) as | s <- symbols] | ||||||
|  |       hassymbol s a = s == (symbol $ commodity a) | ||||||
|  |       symbols = sort $ nub $ map (symbol . commodity) as | ||||||
|  | 
 | ||||||
|  | -- samecommoditysymbol Amount{commodity=c1} Amount{commodity=c2} = samesymbol c1 c2 | ||||||
|  | -- samesymbol Commodity{symbol=s1} Commodity{symbol=s2} = s1==s2 | ||||||
|  |        | ||||||
| -- | Get the string representation of an amount, based on its commodity's | -- | Get the string representation of an amount, based on its commodity's | ||||||
| -- display settings. | -- display settings. | ||||||
| showAmount :: Amount -> String | showAmount :: Amount -> String | ||||||
| @ -78,6 +96,9 @@ isZeroAmount :: Amount -> Bool | |||||||
| isZeroAmount a@(Amount c _ ) = nonzerodigits == "" | isZeroAmount a@(Amount c _ ) = nonzerodigits == "" | ||||||
|     where nonzerodigits = filter (`elem` "123456789") $ showAmount a |     where nonzerodigits = filter (`elem` "123456789") $ showAmount a | ||||||
| 
 | 
 | ||||||
|  | isZeroMixedAmount :: MixedAmount -> Bool | ||||||
|  | isZeroMixedAmount = all isZeroAmount . normaliseMixedAmount | ||||||
|  | 
 | ||||||
| instance Num Amount where | instance Num Amount where | ||||||
|     abs (Amount c q) = Amount c (abs q) |     abs (Amount c q) = Amount c (abs q) | ||||||
|     signum (Amount c q) = Amount c (signum q) |     signum (Amount c q) = Amount c (signum q) | ||||||
| @ -104,6 +125,9 @@ convertAmountTo c2 (Amount c1 q) = Amount c2 (q * conversionRate c1 c2) | |||||||
| sumAmounts :: [Amount] -> Amount | sumAmounts :: [Amount] -> Amount | ||||||
| sumAmounts = sum . filter (not . isZeroAmount) | sumAmounts = sum . filter (not . isZeroAmount) | ||||||
| 
 | 
 | ||||||
|  | sumMixedAmounts :: [MixedAmount] -> MixedAmount | ||||||
|  | sumMixedAmounts = concat | ||||||
|  | 
 | ||||||
| nullamt = Amount (comm "") 0 | nullamt = Amount (comm "") 0 | ||||||
| 
 | 
 | ||||||
| -- temporary value for partial entries | -- temporary value for partial entries | ||||||
|  | |||||||
| @ -43,8 +43,8 @@ cacheLedger l = | |||||||
|         subacctsof a = filter (a `isAccountNamePrefixOf`) anames |         subacctsof a = filter (a `isAccountNamePrefixOf`) anames | ||||||
|         subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a] |         subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a] | ||||||
|         balmap = Map.union  |         balmap = Map.union  | ||||||
|                (Map.fromList [(a, (sumTransactions $ subtxnsof a)) | a <- anames]) |                (Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- anames]) | ||||||
|                (Map.fromList [(a,nullamt) | 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 |     in | ||||||
|       Ledger l ant amap |       Ledger l ant amap | ||||||
|  | |||||||
| @ -29,7 +29,8 @@ flattenEntry (Entry d _ _ desc _ ts _, e) = | |||||||
| accountNamesFromTransactions :: [Transaction] -> [AccountName] | accountNamesFromTransactions :: [Transaction] -> [AccountName] | ||||||
| accountNamesFromTransactions ts = nub $ map account ts | accountNamesFromTransactions ts = nub $ map account ts | ||||||
| 
 | 
 | ||||||
| sumTransactions :: [Transaction] -> Amount | sumTransactions :: [Transaction] -> MixedAmount | ||||||
| sumTransactions = sum . map amount | -- sumTransactions = sum . map amount | ||||||
|  | sumTransactions = map amount | ||||||
| 
 | 
 | ||||||
| nulltxn = Transaction 0 "" "" "" nullamt RegularTransaction | nulltxn = Transaction 0 "" "" "" nullamt RegularTransaction | ||||||
|  | |||||||
| @ -97,7 +97,7 @@ data Transaction = Transaction { | |||||||
| data Account = Account { | data Account = Account { | ||||||
|       aname :: AccountName, |       aname :: AccountName, | ||||||
|       atransactions :: [Transaction], |       atransactions :: [Transaction], | ||||||
|       abalance :: Amount |       abalance :: MixedAmount | ||||||
|     } |     } | ||||||
| 
 | 
 | ||||||
| data Ledger = Ledger { | data Ledger = Ledger { | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user