try making MixedAmount a full newtype, to avoid TypeSynonymInstances error

This commit is contained in:
Simon Michael 2008-10-18 10:38:01 +00:00
parent 2d41368b8b
commit 80beac7d43
11 changed files with 49 additions and 50 deletions

View File

@ -131,7 +131,7 @@ showBalanceReport opts args l = acctsstr ++ totalstr
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 = sumMixedAmounts $ map abalance $ nonredundantaccts total = sum $ 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

View File

@ -19,5 +19,5 @@ instance Show Account where
instance Eq Account where instance Eq Account where
(==) (Account n1 t1 b1) (Account n2 t2 b2) = n1 == n2 && t1 == t2 && b1 == b2 (==) (Account n1 t1 b1) (Account n2 t2 b2) = n1 == n2 && t1 == t2 && b1 == b2
nullacct = Account "" [] [] nullacct = Account "" [] nullamt

View File

@ -45,6 +45,7 @@ import Ledger.Commodity
instance Show Amount where show = showAmount instance Show Amount where show = showAmount
instance Show MixedAmount where show = showMixedAmount
instance Num Amount where instance Num Amount where
abs (Amount c q) = Amount c (abs q) abs (Amount c q) = Amount c (abs q)
@ -55,18 +56,22 @@ instance Num Amount where
(*) = amountop (*) (*) = amountop (*)
instance Num MixedAmount where instance Num MixedAmount where
abs = error "programming error, mixed amounts do not support abs" fromInteger i = Mixed [Amount (comm "") (fromInteger i)]
negate (Mixed as) = Mixed $ map negate as
(+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ filter (not . isZeroAmount) $ as ++ bs
(*) = error "programming error, mixed amounts do not support multiplication"
abs = error "programming error, mixed amounts do not support abs"
signum = error "programming error, mixed amounts do not support signum" signum = error "programming error, mixed amounts do not support signum"
fromInteger i = [Amount (comm "") (fromInteger i)]
negate = map negate amounts :: MixedAmount -> [Amount]
(+) = (++) amounts (Mixed as) = as
(*) = error "programming error, mixed amounts do not support multiplication"
showMixedAmount :: MixedAmount -> String showMixedAmount :: MixedAmount -> String
showMixedAmount as = concat $ intersperse ", " $ map show $ normaliseMixedAmount as showMixedAmount m = concat $ intersperse ", " $ map show as
where (Mixed as) = normaliseMixedAmount m
normaliseMixedAmount :: MixedAmount -> MixedAmount normaliseMixedAmount :: MixedAmount -> MixedAmount
normaliseMixedAmount as = map sumAmounts $ groupAmountsByCommodity as normaliseMixedAmount (Mixed as) = Mixed $ map sum $ groupAmountsByCommodity as
groupAmountsByCommodity :: [Amount] -> [[Amount]] groupAmountsByCommodity :: [Amount] -> [[Amount]]
groupAmountsByCommodity as = grouped groupAmountsByCommodity as = grouped
@ -115,7 +120,7 @@ isZeroAmount a@(Amount c _ ) = nonzerodigits == ""
where nonzerodigits = filter (`elem` "123456789") $ showAmount a where nonzerodigits = filter (`elem` "123456789") $ showAmount a
isZeroMixedAmount :: MixedAmount -> Bool isZeroMixedAmount :: MixedAmount -> Bool
isZeroMixedAmount = all isZeroAmount . normaliseMixedAmount isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount
-- | Apply a binary arithmetic operator to two amounts, converting to the -- | Apply a binary arithmetic operator to two amounts, converting to the
-- second one's commodity and adopting the lowest precision. (Using the -- second one's commodity and adopting the lowest precision. (Using the
@ -130,15 +135,9 @@ amountop op a@(Amount ac aq) b@(Amount bc bq) =
convertAmountTo :: Commodity -> Amount -> Amount convertAmountTo :: Commodity -> Amount -> Amount
convertAmountTo c2 (Amount c1 q) = Amount c2 (q * conversionRate c1 c2) convertAmountTo c2 (Amount c1 q) = Amount c2 (q * conversionRate c1 c2)
-- | Sum a list of amounts. This is still needed because a final zero nullamt :: MixedAmount
-- amount will discard the sum's commodity. nullamt = Mixed []
sumAmounts :: [Amount] -> Amount
sumAmounts = sum . filter (not . isZeroAmount)
sumMixedAmounts :: [MixedAmount] -> MixedAmount
sumMixedAmounts = normaliseMixedAmount . concat
nullamt = []
-- temporary value for partial entries -- temporary value for partial entries
autoamt = [Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0,rate=1}) 0] autoamt :: MixedAmount
autoamt = Mixed [Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0,rate=1}) 0]

View File

@ -61,7 +61,7 @@ showDate = printf "%-10s"
isEntryBalanced :: Entry -> Bool isEntryBalanced :: Entry -> Bool
isEntryBalanced (Entry {etransactions=ts}) = isEntryBalanced (Entry {etransactions=ts}) =
isZeroMixedAmount $ sumMixedAmounts $ map tamount $ filter isReal ts isZeroMixedAmount $ sum $ map tamount $ filter isReal ts
-- | Fill in a missing balance in this entry, if we have enough -- | Fill in a missing balance in this entry, if we have enough
-- information to do that. Excluding virtual transactions, there should be -- information to do that. Excluding virtual transactions, there should be
@ -74,7 +74,7 @@ balanceEntry e@(Entry{etransactions=ts}) = e{etransactions=ts'}
0 -> ts 0 -> ts
1 -> map balance ts 1 -> map balance ts
otherwise -> error $ "could not balance this entry, too many missing amounts:\n" ++ show e otherwise -> error $ "could not balance this entry, too many missing amounts:\n" ++ show e
otherstotal = sumMixedAmounts $ map tamount withamounts otherstotal = sum $ map tamount withamounts
balance t balance t
| isReal t && not (hasAmount t) = t{tamount = -otherstotal} | isReal t && not (hasAmount t) = t{tamount = -otherstotal}
| otherwise = t | otherwise = t

View File

@ -45,7 +45,7 @@ cacheLedger l = Ledger l ant amap
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,[]) | a <- anames]) (Map.fromList [(a,Mixed []) | 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]
-- | List a ledger's account names. -- | List a ledger's account names.

View File

@ -315,7 +315,7 @@ leftsymbolamount = do
sp <- many spacenonewline sp <- many spacenonewline
(q,p,comma) <- amountquantity (q,p,comma) <- amountquantity
let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,comma=comma,precision=p,rate=1} let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,comma=comma,precision=p,rate=1}
return [Amount c q] return $ Mixed [Amount c q]
<?> "left-symbol amount" <?> "left-symbol amount"
rightsymbolamount :: Parser MixedAmount rightsymbolamount :: Parser MixedAmount
@ -324,14 +324,14 @@ rightsymbolamount = do
sp <- many spacenonewline sp <- many spacenonewline
sym <- commoditysymbol sym <- commoditysymbol
let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,comma=comma,precision=p,rate=1} let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,comma=comma,precision=p,rate=1}
return [Amount c q] return $ Mixed [Amount c q]
<?> "right-symbol amount" <?> "right-symbol amount"
nosymbolamount :: Parser MixedAmount nosymbolamount :: Parser MixedAmount
nosymbolamount = do nosymbolamount = do
(q,p,comma) <- amountquantity (q,p,comma) <- amountquantity
let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p,rate=1} let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p,rate=1}
return [Amount c q] return $ Mixed [Amount c q]
<?> "no-symbol amount" <?> "no-symbol amount"
commoditysymbol :: Parser String commoditysymbol :: Parser String

View File

@ -100,7 +100,7 @@ normaliseRawLedgerAmounts l@(RawLedger ms ps es f) = RawLedger ms ps es' f
normaliseRawTransactionAmounts (RawTransaction acct a c t) = RawTransaction acct a' c t normaliseRawTransactionAmounts (RawTransaction acct a c t) = RawTransaction acct a' c t
where a' = normaliseMixedAmount a where a' = normaliseMixedAmount a
firstcommodities = nubBy samesymbol $ allcommodities firstcommodities = nubBy samesymbol $ allcommodities
allcommodities = map commodity $ concat $ map amount $ rawLedgerTransactions l allcommodities = map commodity $ concat $ map (amounts . amount) $ rawLedgerTransactions l
samesymbol (Commodity {symbol=s1}) (Commodity {symbol=s2}) = s1==s2 samesymbol (Commodity {symbol=s1}) (Commodity {symbol=s2}) = s1==s2
firstoccurrenceof c@(Commodity {symbol=s}) = firstoccurrenceof c@(Commodity {symbol=s}) =
fromMaybe fromMaybe

View File

@ -57,7 +57,7 @@ entryFromTimeLogInOut i o =
showdate = formatTime defaultTimeLocale "%Y/%m/%d" showdate = formatTime defaultTimeLocale "%Y/%m/%d"
intime = parsedatetime $ tldatetime i intime = parsedatetime $ tldatetime i
outtime = parsedatetime $ tldatetime o outtime = parsedatetime $ tldatetime o
amount = [hours $ realToFrac (diffUTCTime outtime intime) / 3600] amount = Mixed [hours $ realToFrac (diffUTCTime outtime intime) / 3600]
txns = [RawTransaction acctname amount "" RegularTransaction txns = [RawTransaction acctname amount "" RegularTransaction
--,RawTransaction "assets:time" (-amount) "" RegularTransaction --,RawTransaction "assets:time" (-amount) "" RegularTransaction
] ]

View File

@ -30,6 +30,6 @@ accountNamesFromTransactions :: [Transaction] -> [AccountName]
accountNamesFromTransactions ts = nub $ map account ts accountNamesFromTransactions ts = nub $ map account ts
sumTransactions :: [Transaction] -> MixedAmount sumTransactions :: [Transaction] -> MixedAmount
sumTransactions = sumMixedAmounts . map amount sumTransactions = sum . map amount
nulltxn = Transaction 0 "" "" "" nullamt RegularTransaction nulltxn = Transaction 0 "" "" "" nullamt RegularTransaction

View File

@ -15,6 +15,8 @@ type Date = String
type DateTime = String type DateTime = String
type AccountName = String
data Side = L | R deriving (Eq,Show) data Side = L | R deriving (Eq,Show)
data Commodity = Commodity { data Commodity = Commodity {
@ -34,9 +36,7 @@ data Amount = Amount {
quantity :: Double quantity :: Double
} deriving (Eq) } deriving (Eq)
type MixedAmount = [Amount] newtype MixedAmount = Mixed [Amount] deriving (Eq)
type AccountName = String
data TransactionType = RegularTransaction | VirtualTransaction | BalancedVirtualTransaction data TransactionType = RegularTransaction | VirtualTransaction | BalancedVirtualTransaction
deriving (Eq,Show) deriving (Eq,Show)

View File

@ -78,7 +78,7 @@ unittests = TestList [
, ,
"balanceEntry" ~: do "balanceEntry" ~: do
assertequal assertequal
[dollars (-47.18)] (Mixed [dollars (-47.18)])
(tamount $ last $ etransactions $ balanceEntry entry1) (tamount $ last $ etransactions $ balanceEntry entry1)
, ,
"punctuatethousands" ~: punctuatethousands "" @?= "" "punctuatethousands" ~: punctuatethousands "" @?= ""
@ -103,8 +103,8 @@ unittests = TestList [
assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger rawledger7) assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger rawledger7)
, ,
"transactionamount" ~: do "transactionamount" ~: do
assertparseequal [dollars 47.18] (parsewith transactionamount " $47.18") assertparseequal (Mixed [dollars 47.18]) (parsewith transactionamount " $47.18")
assertparseequal [Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0,rate=1}) 1] (parsewith transactionamount " $1.") assertparseequal (Mixed [Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0,rate=1}) 1]) (parsewith transactionamount " $1.")
] ]
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
@ -243,7 +243,7 @@ assertparseequal expected parsed = either printParseError (assertequal expected)
rawtransaction1_str = " expenses:food:dining $10.00\n" rawtransaction1_str = " expenses:food:dining $10.00\n"
rawtransaction1 = RawTransaction "expenses:food:dining" [dollars 10] "" RegularTransaction rawtransaction1 = RawTransaction "expenses:food:dining"(Mixed [dollars 10]) "" RegularTransaction
entry1_str = "\ entry1_str = "\
\2007/01/28 coopportunity\n\ \2007/01/28 coopportunity\n\
@ -253,8 +253,8 @@ entry1_str = "\
entry1 = entry1 =
(Entry "2007/01/28" False "" "coopportunity" "" (Entry "2007/01/28" False "" "coopportunity" ""
[RawTransaction "expenses:food:groceries" [dollars 47.18] "" RegularTransaction, [RawTransaction "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularTransaction,
RawTransaction "assets:checking" [dollars (-47.18)] "" RegularTransaction] "") RawTransaction "assets:checking" (Mixed [dollars (-47.18)]) "" RegularTransaction] "")
entry2_str = "\ entry2_str = "\
@ -398,13 +398,13 @@ rawledger7 = RawLedger
etransactions=[ etransactions=[
RawTransaction { RawTransaction {
taccount="assets:cash", taccount="assets:cash",
tamount=[dollars 4.82], tamount=(Mixed [dollars 4.82]),
tcomment="", tcomment="",
rttype=RegularTransaction rttype=RegularTransaction
}, },
RawTransaction { RawTransaction {
taccount="equity:opening balances", taccount="equity:opening balances",
tamount=[dollars (-4.82)], tamount=(Mixed [dollars (-4.82)]),
tcomment="", tcomment="",
rttype=RegularTransaction rttype=RegularTransaction
} }
@ -421,13 +421,13 @@ rawledger7 = RawLedger
etransactions=[ etransactions=[
RawTransaction { RawTransaction {
taccount="expenses:vacation", taccount="expenses:vacation",
tamount=[dollars 179.92], tamount=(Mixed [dollars 179.92]),
tcomment="", tcomment="",
rttype=RegularTransaction rttype=RegularTransaction
}, },
RawTransaction { RawTransaction {
taccount="assets:checking", taccount="assets:checking",
tamount=[dollars (-179.92)], tamount=(Mixed [dollars (-179.92)]),
tcomment="", tcomment="",
rttype=RegularTransaction rttype=RegularTransaction
} }
@ -444,13 +444,13 @@ rawledger7 = RawLedger
etransactions=[ etransactions=[
RawTransaction { RawTransaction {
taccount="assets:saving", taccount="assets:saving",
tamount=[dollars 200], tamount=(Mixed [dollars 200]),
tcomment="", tcomment="",
rttype=RegularTransaction rttype=RegularTransaction
}, },
RawTransaction { RawTransaction {
taccount="assets:checking", taccount="assets:checking",
tamount=[dollars (-200)], tamount=(Mixed [dollars (-200)]),
tcomment="", tcomment="",
rttype=RegularTransaction rttype=RegularTransaction
} }
@ -467,13 +467,13 @@ rawledger7 = RawLedger
etransactions=[ etransactions=[
RawTransaction { RawTransaction {
taccount="expenses:food:dining", taccount="expenses:food:dining",
tamount=[dollars 4.82], tamount=(Mixed [dollars 4.82]),
tcomment="", tcomment="",
rttype=RegularTransaction rttype=RegularTransaction
}, },
RawTransaction { RawTransaction {
taccount="assets:cash", taccount="assets:cash",
tamount=[dollars (-4.82)], tamount=(Mixed [dollars (-4.82)]),
tcomment="", tcomment="",
rttype=RegularTransaction rttype=RegularTransaction
} }
@ -490,13 +490,13 @@ rawledger7 = RawLedger
etransactions=[ etransactions=[
RawTransaction { RawTransaction {
taccount="expenses:phone", taccount="expenses:phone",
tamount=[dollars 95.11], tamount=(Mixed [dollars 95.11]),
tcomment="", tcomment="",
rttype=RegularTransaction rttype=RegularTransaction
}, },
RawTransaction { RawTransaction {
taccount="assets:checking", taccount="assets:checking",
tamount=[dollars (-95.11)], tamount=(Mixed [dollars (-95.11)]),
tcomment="", tcomment="",
rttype=RegularTransaction rttype=RegularTransaction
} }
@ -513,13 +513,13 @@ rawledger7 = RawLedger
etransactions=[ etransactions=[
RawTransaction { RawTransaction {
taccount="liabilities:credit cards:discover", taccount="liabilities:credit cards:discover",
tamount=[dollars 80], tamount=(Mixed [dollars 80]),
tcomment="", tcomment="",
rttype=RegularTransaction rttype=RegularTransaction
}, },
RawTransaction { RawTransaction {
taccount="assets:checking", taccount="assets:checking",
tamount=[dollars (-80)], tamount=(Mixed [dollars (-80)]),
tcomment="", tcomment="",
rttype=RegularTransaction rttype=RegularTransaction
} }