From 80beac7d4383d8d8a35e394e42fdee595efb01ca Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 18 Oct 2008 10:38:01 +0000 Subject: [PATCH] try making MixedAmount a full newtype, to avoid TypeSynonymInstances error --- BalanceCommand.hs | 2 +- Ledger/Account.hs | 2 +- Ledger/Amount.hs | 35 +++++++++++++++++------------------ Ledger/Entry.hs | 4 ++-- Ledger/Ledger.hs | 2 +- Ledger/Parse.hs | 6 +++--- Ledger/RawLedger.hs | 2 +- Ledger/TimeLog.hs | 2 +- Ledger/Transaction.hs | 2 +- Ledger/Types.hs | 6 +++--- Tests.hs | 36 ++++++++++++++++++------------------ 11 files changed, 49 insertions(+), 50 deletions(-) diff --git a/BalanceCommand.hs b/BalanceCommand.hs index 758968ec5..07bda7f17 100644 --- a/BalanceCommand.hs +++ b/BalanceCommand.hs @@ -131,7 +131,7 @@ showBalanceReport opts args l = acctsstr ++ totalstr acctstoshow = balancereportaccts showingsubs apats l acctnamestoshow = map aname acctstoshow treetoshow = pruneZeroBalanceLeaves $ pruneUnmatchedAccounts $ treeprune maxdepth $ ledgerAccountTree 9999 l - total = sumMixedAmounts $ map abalance $ nonredundantaccts + total = sum $ map abalance $ nonredundantaccts nonredundantaccts = filter (not . hasparentshowing) acctstoshow hasparentshowing a = (parentAccountName $ aname a) `elem` acctnamestoshow diff --git a/Ledger/Account.hs b/Ledger/Account.hs index f5b7d5dd0..ccb3dbed7 100644 --- a/Ledger/Account.hs +++ b/Ledger/Account.hs @@ -19,5 +19,5 @@ instance Show Account where instance Eq Account where (==) (Account n1 t1 b1) (Account n2 t2 b2) = n1 == n2 && t1 == t2 && b1 == b2 -nullacct = Account "" [] [] +nullacct = Account "" [] nullamt diff --git a/Ledger/Amount.hs b/Ledger/Amount.hs index 8846dcf29..8606081a3 100644 --- a/Ledger/Amount.hs +++ b/Ledger/Amount.hs @@ -45,6 +45,7 @@ import Ledger.Commodity instance Show Amount where show = showAmount +instance Show MixedAmount where show = showMixedAmount instance Num Amount where abs (Amount c q) = Amount c (abs q) @@ -55,18 +56,22 @@ instance Num Amount where (*) = amountop (*) 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" - fromInteger i = [Amount (comm "") (fromInteger i)] - negate = map negate - (+) = (++) - (*) = error "programming error, mixed amounts do not support multiplication" + +amounts :: MixedAmount -> [Amount] +amounts (Mixed as) = as 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 as = map sumAmounts $ groupAmountsByCommodity as +normaliseMixedAmount (Mixed as) = Mixed $ map sum $ groupAmountsByCommodity as groupAmountsByCommodity :: [Amount] -> [[Amount]] groupAmountsByCommodity as = grouped @@ -115,7 +120,7 @@ isZeroAmount a@(Amount c _ ) = nonzerodigits == "" where nonzerodigits = filter (`elem` "123456789") $ showAmount a isZeroMixedAmount :: MixedAmount -> Bool -isZeroMixedAmount = all isZeroAmount . normaliseMixedAmount +isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount -- | Apply a binary arithmetic operator to two amounts, converting to 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 c2 (Amount c1 q) = Amount c2 (q * conversionRate c1 c2) --- | Sum a list of amounts. This is still needed because a final zero --- amount will discard the sum's commodity. -sumAmounts :: [Amount] -> Amount -sumAmounts = sum . filter (not . isZeroAmount) - -sumMixedAmounts :: [MixedAmount] -> MixedAmount -sumMixedAmounts = normaliseMixedAmount . concat - -nullamt = [] +nullamt :: MixedAmount +nullamt = Mixed [] -- 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] diff --git a/Ledger/Entry.hs b/Ledger/Entry.hs index 2143237c6..cdd8efab0 100644 --- a/Ledger/Entry.hs +++ b/Ledger/Entry.hs @@ -61,7 +61,7 @@ showDate = printf "%-10s" isEntryBalanced :: Entry -> Bool 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 -- information to do that. Excluding virtual transactions, there should be @@ -74,7 +74,7 @@ balanceEntry e@(Entry{etransactions=ts}) = e{etransactions=ts'} 0 -> ts 1 -> map balance ts 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 | isReal t && not (hasAmount t) = t{tamount = -otherstotal} | otherwise = t diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index cb4c155df..bd2de0ca8 100644 --- a/Ledger/Ledger.hs +++ b/Ledger/Ledger.hs @@ -45,7 +45,7 @@ cacheLedger l = Ledger l ant amap 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]) + (Map.fromList [(a,Mixed []) | a <- anames]) amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames] -- | List a ledger's account names. diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index b63c22307..a58cf96e9 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -315,7 +315,7 @@ leftsymbolamount = do sp <- many spacenonewline (q,p,comma) <- amountquantity 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" rightsymbolamount :: Parser MixedAmount @@ -324,14 +324,14 @@ rightsymbolamount = do sp <- many spacenonewline sym <- commoditysymbol 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" nosymbolamount :: Parser MixedAmount nosymbolamount = do (q,p,comma) <- amountquantity 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" commoditysymbol :: Parser String diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 1c6c4c753..2f7a3652b 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -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 where a' = normaliseMixedAmount a 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 firstoccurrenceof c@(Commodity {symbol=s}) = fromMaybe diff --git a/Ledger/TimeLog.hs b/Ledger/TimeLog.hs index 18c5089b2..96f0c1a2b 100644 --- a/Ledger/TimeLog.hs +++ b/Ledger/TimeLog.hs @@ -57,7 +57,7 @@ entryFromTimeLogInOut i o = showdate = formatTime defaultTimeLocale "%Y/%m/%d" intime = parsedatetime $ tldatetime i outtime = parsedatetime $ tldatetime o - amount = [hours $ realToFrac (diffUTCTime outtime intime) / 3600] + amount = Mixed [hours $ realToFrac (diffUTCTime outtime intime) / 3600] txns = [RawTransaction acctname amount "" RegularTransaction --,RawTransaction "assets:time" (-amount) "" RegularTransaction ] diff --git a/Ledger/Transaction.hs b/Ledger/Transaction.hs index 1ab69a271..ab595c680 100644 --- a/Ledger/Transaction.hs +++ b/Ledger/Transaction.hs @@ -30,6 +30,6 @@ accountNamesFromTransactions :: [Transaction] -> [AccountName] accountNamesFromTransactions ts = nub $ map account ts sumTransactions :: [Transaction] -> MixedAmount -sumTransactions = sumMixedAmounts . map amount +sumTransactions = sum . map amount nulltxn = Transaction 0 "" "" "" nullamt RegularTransaction diff --git a/Ledger/Types.hs b/Ledger/Types.hs index de34fdbf5..d62a60123 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -15,6 +15,8 @@ type Date = String type DateTime = String +type AccountName = String + data Side = L | R deriving (Eq,Show) data Commodity = Commodity { @@ -34,9 +36,7 @@ data Amount = Amount { quantity :: Double } deriving (Eq) -type MixedAmount = [Amount] - -type AccountName = String +newtype MixedAmount = Mixed [Amount] deriving (Eq) data TransactionType = RegularTransaction | VirtualTransaction | BalancedVirtualTransaction deriving (Eq,Show) diff --git a/Tests.hs b/Tests.hs index 4287992c0..ec2514a60 100644 --- a/Tests.hs +++ b/Tests.hs @@ -78,7 +78,7 @@ unittests = TestList [ , "balanceEntry" ~: do assertequal - [dollars (-47.18)] + (Mixed [dollars (-47.18)]) (tamount $ last $ etransactions $ balanceEntry entry1) , "punctuatethousands" ~: punctuatethousands "" @?= "" @@ -103,8 +103,8 @@ unittests = TestList [ assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger rawledger7) , "transactionamount" ~: do - assertparseequal [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 [dollars 47.18]) (parsewith transactionamount " $47.18") + 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 = RawTransaction "expenses:food:dining" [dollars 10] "" RegularTransaction +rawtransaction1 = RawTransaction "expenses:food:dining"(Mixed [dollars 10]) "" RegularTransaction entry1_str = "\ \2007/01/28 coopportunity\n\ @@ -253,8 +253,8 @@ entry1_str = "\ entry1 = (Entry "2007/01/28" False "" "coopportunity" "" - [RawTransaction "expenses:food:groceries" [dollars 47.18] "" RegularTransaction, - RawTransaction "assets:checking" [dollars (-47.18)] "" RegularTransaction] "") + [RawTransaction "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularTransaction, + RawTransaction "assets:checking" (Mixed [dollars (-47.18)]) "" RegularTransaction] "") entry2_str = "\ @@ -398,13 +398,13 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="assets:cash", - tamount=[dollars 4.82], + tamount=(Mixed [dollars 4.82]), tcomment="", rttype=RegularTransaction }, RawTransaction { taccount="equity:opening balances", - tamount=[dollars (-4.82)], + tamount=(Mixed [dollars (-4.82)]), tcomment="", rttype=RegularTransaction } @@ -421,13 +421,13 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="expenses:vacation", - tamount=[dollars 179.92], + tamount=(Mixed [dollars 179.92]), tcomment="", rttype=RegularTransaction }, RawTransaction { taccount="assets:checking", - tamount=[dollars (-179.92)], + tamount=(Mixed [dollars (-179.92)]), tcomment="", rttype=RegularTransaction } @@ -444,13 +444,13 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="assets:saving", - tamount=[dollars 200], + tamount=(Mixed [dollars 200]), tcomment="", rttype=RegularTransaction }, RawTransaction { taccount="assets:checking", - tamount=[dollars (-200)], + tamount=(Mixed [dollars (-200)]), tcomment="", rttype=RegularTransaction } @@ -467,13 +467,13 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="expenses:food:dining", - tamount=[dollars 4.82], + tamount=(Mixed [dollars 4.82]), tcomment="", rttype=RegularTransaction }, RawTransaction { taccount="assets:cash", - tamount=[dollars (-4.82)], + tamount=(Mixed [dollars (-4.82)]), tcomment="", rttype=RegularTransaction } @@ -490,13 +490,13 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="expenses:phone", - tamount=[dollars 95.11], + tamount=(Mixed [dollars 95.11]), tcomment="", rttype=RegularTransaction }, RawTransaction { taccount="assets:checking", - tamount=[dollars (-95.11)], + tamount=(Mixed [dollars (-95.11)]), tcomment="", rttype=RegularTransaction } @@ -513,13 +513,13 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="liabilities:credit cards:discover", - tamount=[dollars 80], + tamount=(Mixed [dollars 80]), tcomment="", rttype=RegularTransaction }, RawTransaction { taccount="assets:checking", - tamount=[dollars (-80)], + tamount=(Mixed [dollars (-80)]), tcomment="", rttype=RegularTransaction }