diff --git a/Ledger/Amount.hs b/Ledger/Amount.hs index 7997df838..6ca89c492 100644 --- a/Ledger/Amount.hs +++ b/Ledger/Amount.hs @@ -47,6 +47,22 @@ 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) + signum (Amount c q) = Amount c (signum q) + fromInteger i = Amount (comm "") (fromInteger i) + (+) = amountop (+) + (-) = amountop (-) + (*) = amountop (*) + +instance Num MixedAmount where + 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" + showMixedAmount :: MixedAmount -> String showMixedAmount as = concat $ intersperse ", " $ map show $ normaliseMixedAmount as @@ -60,9 +76,6 @@ groupAmountsByCommodity as = grouped 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 -- display settings. showAmount :: Amount -> String @@ -91,6 +104,12 @@ showAmountOrZero a | isZeroAmount a = "0" | otherwise = showAmount a +-- | Get the string representation of an amount, rounded, or showing just "0" if it's zero. +showMixedAmountOrZero :: MixedAmount -> String +showMixedAmountOrZero a + | isZeroMixedAmount a = "0" + | otherwise = showMixedAmount a + -- | is this amount zero, when displayed with its given precision ? isZeroAmount :: Amount -> Bool isZeroAmount a@(Amount c _ ) = nonzerodigits == "" @@ -99,14 +118,6 @@ isZeroAmount a@(Amount c _ ) = nonzerodigits == "" isZeroMixedAmount :: MixedAmount -> Bool isZeroMixedAmount = all isZeroAmount . normaliseMixedAmount -instance Num Amount where - abs (Amount c q) = Amount c (abs q) - signum (Amount c q) = Amount c (signum q) - fromInteger i = Amount (comm "") (fromInteger i) - (+) = amountop (+) - (-) = amountop (-) - (*) = amountop (*) - -- | Apply a binary arithmetic operator to two amounts, converting to the -- second one's commodity and adopting the lowest precision. (Using the -- second commodity means that folds (like sum [Amount]) will preserve the @@ -128,7 +139,7 @@ sumAmounts = sum . filter (not . isZeroAmount) sumMixedAmounts :: [MixedAmount] -> MixedAmount sumMixedAmounts = concat -nullamt = Amount (comm "") 0 +nullamt = [] -- temporary value for partial entries -autoamt = Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0,rate=1}) 0 +autoamt = [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 457ba4e2a..72e9168b6 100644 --- a/Ledger/Entry.hs +++ b/Ledger/Entry.hs @@ -53,7 +53,7 @@ showEntry e = showtxn t = showacct t ++ " " ++ (showamount $ tamount t) ++ (showcomment $ tcomment t) showtxnnoamt t = showacct t ++ " " ++ (showcomment $ tcomment t) showacct t = " " ++ (showaccountname $ taccount t) - showamount = printf "%12s" . showAmount + showamount = printf "%12s" . showMixedAmount showaccountname s = printf "%-34s" s showcomment s = if (length s) > 0 then " ; "++s else "" @@ -77,9 +77,9 @@ balanceEntry e@(Entry{etransactions=ts}) = e{etransactions=ts'} 1 -> map balance ts otherwise -> error $ "could not balance this entry, too many missing amounts:\n" ++ show e otherstotal = sumRawTransactions withamounts - simpleotherstotal - | length otherstotal == 1 = head otherstotal - | otherwise = error $ "sorry, can't balance a mixed-commodity entry yet:\n" ++ show e +-- simpleotherstotal +-- | length otherstotal == 1 = head otherstotal +-- | otherwise = error $ "sorry, can't balance a mixed-commodity entry yet:\n" ++ show e balance t - | isReal t && not (hasAmount t) = t{tamount = -simpleotherstotal} + | isReal t && not (hasAmount t) = t{tamount = -otherstotal} | otherwise = t diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index 7fe6236f7..b63c22307 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -301,7 +301,7 @@ ledgeraccountname = do accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace "account name character (non-bracket, non-parenthesis, non-whitespace)" -transactionamount :: Parser Amount +transactionamount :: Parser MixedAmount transactionamount = try (do many1 spacenonewline @@ -309,29 +309,29 @@ transactionamount = return a ) <|> return autoamt -leftsymbolamount :: Parser Amount +leftsymbolamount :: Parser MixedAmount leftsymbolamount = do sym <- commoditysymbol 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 [Amount c q] "left-symbol amount" -rightsymbolamount :: Parser Amount +rightsymbolamount :: Parser MixedAmount rightsymbolamount = do (q,p,comma) <- amountquantity 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 [Amount c q] "right-symbol amount" -nosymbolamount :: Parser 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 [Amount c q] "no-symbol amount" commoditysymbol :: Parser String diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index b983dfb60..9f999e1fe 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -11,6 +11,7 @@ import qualified Data.Map as Map import Ledger.Utils import Ledger.Types import Ledger.AccountName +import Ledger.Amount import Ledger.Entry import Ledger.Transaction @@ -104,10 +105,9 @@ normaliseRawLedgerAmounts l@(RawLedger ms ps es f) = RawLedger ms ps es' f normaliseEntryAmounts (Entry d s c desc comm ts pre) = Entry d s c desc comm ts' pre where ts' = map normaliseRawTransactionAmounts ts normaliseRawTransactionAmounts (RawTransaction acct a c t) = RawTransaction acct a' c t - where a' = normaliseAmount a - normaliseAmount (Amount c q) = Amount (firstoccurrenceof c) q + where a' = normaliseMixedAmount a firstcommodities = nubBy samesymbol $ allcommodities - allcommodities = map (commodity . amount) $ rawLedgerTransactions l + allcommodities = map commodity $ concat $ map amount $ rawLedgerTransactions l samesymbol (Commodity {symbol=s1}) (Commodity {symbol=s2}) = s1==s2 firstoccurrenceof c@(Commodity {symbol=s}) = fromMaybe diff --git a/Ledger/RawTransaction.hs b/Ledger/RawTransaction.hs index 863263ed3..1a47984ba 100644 --- a/Ledger/RawTransaction.hs +++ b/Ledger/RawTransaction.hs @@ -20,7 +20,7 @@ showRawTransaction (RawTransaction a amt _ ttype) = showaccountname a ++ " " ++ (showamount amt) where showaccountname = printf "%-22s" . bracket . elideAccountName width - showamount = printf "%12s" . showAmountOrZero + showamount = printf "%12s" . showMixedAmountOrZero (bracket,width) = case ttype of BalancedVirtualTransaction -> (\s -> "["++s++"]", 20) VirtualTransaction -> (\s -> "("++s++")", 20) @@ -30,7 +30,7 @@ isReal :: RawTransaction -> Bool isReal t = rttype t == RegularTransaction hasAmount :: RawTransaction -> Bool -hasAmount = ("AUTO" /=) . symbol . commodity . tamount +hasAmount = (/= autoamt) . tamount sumRawTransactions :: [RawTransaction] -> MixedAmount -sumRawTransactions = normaliseMixedAmount . map tamount +sumRawTransactions = normaliseMixedAmount . sumMixedAmounts . map tamount diff --git a/Ledger/TimeLog.hs b/Ledger/TimeLog.hs index 90c5e3f8c..18c5089b2 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 = [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 2a2effb67..1ab69a271 100644 --- a/Ledger/Transaction.hs +++ b/Ledger/Transaction.hs @@ -30,7 +30,6 @@ accountNamesFromTransactions :: [Transaction] -> [AccountName] accountNamesFromTransactions ts = nub $ map account ts sumTransactions :: [Transaction] -> MixedAmount --- sumTransactions = sum . map amount -sumTransactions = map amount +sumTransactions = sumMixedAmounts . map amount nulltxn = Transaction 0 "" "" "" nullamt RegularTransaction diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 2ab131cb8..462f03d71 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -41,7 +41,7 @@ data TransactionType = RegularTransaction | VirtualTransaction | BalancedVirtual data RawTransaction = RawTransaction { taccount :: AccountName, - tamount :: Amount, + tamount :: MixedAmount, tcomment :: String, rttype :: TransactionType } deriving (Eq) @@ -90,7 +90,7 @@ data Transaction = Transaction { date :: Date, description :: String, account :: AccountName, - amount :: Amount, + amount :: MixedAmount, ttype :: TransactionType } deriving (Eq) diff --git a/RegisterCommand.hs b/RegisterCommand.hs index f052b04d5..12e70b9d3 100644 --- a/RegisterCommand.hs +++ b/RegisterCommand.hs @@ -35,19 +35,19 @@ showRegisterReport opts args l = showtxns ts nulltxn nullamt -- show transactions, one per line, with a running balance showtxns [] _ _ = "" showtxns (t@Transaction{amount=a}:ts) tprev bal = - (if isZeroAmount a then "" else this) ++ showtxns ts t bal' + (if isZeroMixedAmount a then "" else this) ++ showtxns ts t bal' where this = showtxn (t `issame` tprev) t bal' issame t1 t2 = entryno t1 == entryno t2 bal' = bal + amount t -- show one transaction line, with or without the entry details - showtxn :: Bool -> Transaction -> Amount -> String + showtxn :: Bool -> Transaction -> MixedAmount -> String showtxn omitdesc t b = entrydesc ++ txn ++ bal ++ "\n" where entrydesc = if omitdesc then replicate 32 ' ' else printf "%s %s " date desc date = showDate $ da desc = printf "%-20s" $ elideRight 20 de :: String txn = showRawTransaction $ RawTransaction a amt "" tt - bal = printf " %12s" (showAmountOrZero b) + bal = printf " %12s" (showMixedAmountOrZero b) Transaction{date=da,description=de,account=a,amount=amt,ttype=tt} = t diff --git a/Tests.hs b/Tests.hs index 42c84b636..4287992c0 100644 --- a/Tests.hs +++ b/Tests.hs @@ -78,7 +78,7 @@ unittests = TestList [ , "balanceEntry" ~: do assertequal - (dollars (-47.18)) + [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 [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.") ] ------------------------------------------------------------------------------ @@ -215,7 +215,7 @@ balancecommandtests = TestList [ ] registercommandtests = TestList [ - "register does something" ~: + "register report" ~: do l <- ledgerfromfile "sample.ledger" assertequal ( @@ -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" [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" [dollars 47.18] "" RegularTransaction, + RawTransaction "assets:checking" [dollars (-47.18)] "" RegularTransaction] "") entry2_str = "\ @@ -398,13 +398,13 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="assets:cash", - tamount=dollars 4.82, + tamount=[dollars 4.82], tcomment="", rttype=RegularTransaction }, RawTransaction { taccount="equity:opening balances", - tamount=dollars (-4.82), + tamount=[dollars (-4.82)], tcomment="", rttype=RegularTransaction } @@ -421,13 +421,13 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="expenses:vacation", - tamount=dollars 179.92, + tamount=[dollars 179.92], tcomment="", rttype=RegularTransaction }, RawTransaction { taccount="assets:checking", - tamount=dollars (-179.92), + tamount=[dollars (-179.92)], tcomment="", rttype=RegularTransaction } @@ -444,13 +444,13 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="assets:saving", - tamount=dollars 200, + tamount=[dollars 200], tcomment="", rttype=RegularTransaction }, RawTransaction { taccount="assets:checking", - tamount=dollars (-200), + tamount=[dollars (-200)], tcomment="", rttype=RegularTransaction } @@ -467,13 +467,13 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="expenses:food:dining", - tamount=dollars 4.82, + tamount=[dollars 4.82], tcomment="", rttype=RegularTransaction }, RawTransaction { taccount="assets:cash", - tamount=dollars (-4.82), + tamount=[dollars (-4.82)], tcomment="", rttype=RegularTransaction } @@ -490,13 +490,13 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="expenses:phone", - tamount=dollars 95.11, + tamount=[dollars 95.11], tcomment="", rttype=RegularTransaction }, RawTransaction { taccount="assets:checking", - tamount=dollars (-95.11), + tamount=[dollars (-95.11)], tcomment="", rttype=RegularTransaction } @@ -513,13 +513,13 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="liabilities:credit cards:discover", - tamount=dollars 80, + tamount=[dollars 80], tcomment="", rttype=RegularTransaction }, RawTransaction { taccount="assets:checking", - tamount=dollars (-80), + tamount=[dollars (-80)], tcomment="", rttype=RegularTransaction }