diff --git a/Ledger/Amount.hs b/Ledger/Amount.hs index fafca78e9..7bc860fc2 100644 --- a/Ledger/Amount.hs +++ b/Ledger/Amount.hs @@ -48,45 +48,47 @@ 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) + abs (Amount c q p) = Amount c (abs q) p + signum (Amount c q p) = Amount c (signum q) p + fromInteger i = Amount (comm "") (fromInteger i) Nothing (+) = amountop (+) (-) = amountop (-) (*) = amountop (*) instance Num MixedAmount where - fromInteger i = Mixed [Amount (comm "") (fromInteger i)] + fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing] 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" --- | Apply a binary arithmetic operator to two amounts, converting --- to the second one's commodity and adopting the lowest --- precision. (Using the second commodity is best since sum and --- other folds start with a no-commodity amount.) +-- | Apply a binary arithmetic operator to two amounts - converting to the +-- second one's commodity, adopting the lowest precision, and discarding +-- any price information. (Using the second commodity is best since sum +-- and other folds start with a no-commodity amount.) amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount -amountop op a@(Amount ac aq) b@(Amount bc bq) = - Amount bc ((quantity $ convertAmountTo bc a) `op` bq) +amountop op a@(Amount ac aq ap) b@(Amount bc bq bp) = + Amount bc ((quantity $ convertAmountTo bc a) `op` bq) Nothing -- | Convert an amount to the specified commodity using the appropriate -- exchange rate (which is currently always 1). convertAmountTo :: Commodity -> Amount -> Amount -convertAmountTo c2 (Amount c1 q) = Amount c2 (q * conversionRate c1 c2) +convertAmountTo c2 (Amount c1 q p) = Amount c2 (q * conversionRate c1 c2) Nothing -- | Get the string representation of an amount, based on its commodity's -- display settings. showAmount :: Amount -> String -showAmount (Amount (Commodity {symbol=sym,side=side,spaced=spaced,comma=comma,precision=p}) q) +showAmount (Amount (Commodity {symbol=sym,side=side,spaced=spaced,comma=comma,precision=p}) q pri) | sym=="AUTO" = "" -- can display one of these in an error message - | side==L = printf "%s%s%s" sym space quantity - | side==R = printf "%s%s%s" quantity space sym + | side==L = printf "%s%s%s%s" sym space quantity price + | side==R = printf "%s%s%s%s" quantity space sym price where space = if spaced then " " else "" quantity = commad $ printf ("%."++show p++"f") q commad = if comma then punctuatethousands else id + price = case pri of (Just pamt) -> " @ " ++ showMixedAmount pamt + Nothing -> "" -- | Add thousands-separating commas to a decimal number string punctuatethousands :: String -> String @@ -101,7 +103,7 @@ punctuatethousands s = -- | Does this amount appear to be zero when displayed with its given precision ? isZeroAmount :: Amount -> Bool -isZeroAmount a@(Amount c _ ) = nonzerodigits == "" +isZeroAmount a = nonzerodigits == "" where nonzerodigits = filter (`elem` "123456789") $ showAmount a -- | Access a mixed amount's components. @@ -114,8 +116,7 @@ isZeroMixedAmount :: MixedAmount -> Bool isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount -- | Get the string representation of a mixed amount, showing each of --- its component amounts. We currently display them on one line but --- will need to change to ledger's vertical layout. +-- its component amounts. showMixedAmount :: MixedAmount -> String showMixedAmount m = concat $ intersperse ", " $ map show as where (Mixed as) = normaliseMixedAmount m @@ -142,5 +143,5 @@ nullamt = Mixed [] -- | A temporary value for parsed transactions which had no amount specified. missingamt :: MixedAmount -missingamt = Mixed [Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0}) 0] +missingamt = Mixed [Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0}) 0 Nothing] diff --git a/Ledger/Commodity.hs b/Ledger/Commodity.hs index 5bf94ccc9..8de407e5f 100644 --- a/Ledger/Commodity.hs +++ b/Ledger/Commodity.hs @@ -23,10 +23,10 @@ euro = Commodity {symbol="EUR",side=L,spaced=False,comma=False,precision=2} pound = Commodity {symbol="£",side=L,spaced=False,comma=False,precision=2} hour = Commodity {symbol="h",side=R,spaced=False,comma=False,precision=1} -dollars = Amount dollar -euros = Amount euro -pounds = Amount pound -hours = Amount hour +dollars n = Amount dollar n Nothing +euros n = Amount euro n Nothing +pounds n = Amount pound n Nothing +hours n = Amount hour n Nothing defaultcommodities = [dollar, euro, pound, hour, unknown] diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index 948f547a1..946438e50 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -305,17 +305,20 @@ transactionamount :: Parser MixedAmount transactionamount = try (do many1 spacenonewline - a <- try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount <|> return missingamt + a <- someamount <|> return missingamt return a ) <|> return missingamt +someamount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount + leftsymbolamount :: Parser MixedAmount leftsymbolamount = do sym <- commoditysymbol sp <- many spacenonewline (q,p,comma) <- amountquantity + pri <- priceamount let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,comma=comma,precision=p} - return $ Mixed [Amount c q] + return $ Mixed [Amount c q pri] "left-symbol amount" rightsymbolamount :: Parser MixedAmount @@ -323,20 +326,32 @@ rightsymbolamount = do (q,p,comma) <- amountquantity sp <- many spacenonewline sym <- commoditysymbol + pri <- priceamount let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,comma=comma,precision=p} - return $ Mixed [Amount c q] + return $ Mixed [Amount c q pri] "right-symbol amount" nosymbolamount :: Parser MixedAmount nosymbolamount = do (q,p,comma) <- amountquantity + pri <- priceamount let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p} - return $ Mixed [Amount c q] + return $ Mixed [Amount c q pri] "no-symbol amount" commoditysymbol :: Parser String commoditysymbol = many1 (noneOf "-.0123456789;\n ") "commodity symbol" +priceamount :: Parser (Maybe MixedAmount) +priceamount = + try (do + many spacenonewline + char '@' + many spacenonewline + a <- someamount + return $ Just a + ) <|> return Nothing + -- gawd.. trying to parse a ledger number without error: -- | parse a ledger-style numeric quantity and also return the number of diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 80e684985..82e404802 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -93,7 +93,7 @@ setAmountDisplayPrefs l@(RawLedger ms ps es f) = RawLedger ms ps (map fixEntryAm fixEntryAmounts (Entry d s c de co ts pr) = Entry d s c de co (map fixRawTransactionAmounts ts) pr fixRawTransactionAmounts (RawTransaction ac a c t) = RawTransaction ac (fixMixedAmount a) c t fixMixedAmount (Mixed as) = Mixed $ map fixAmount as - fixAmount (Amount c q) = Amount (canonicalcommodity c) q + fixAmount (Amount c q pri) = Amount (canonicalcommodity c) q pri canonicalcommodity c@(Commodity {symbol=s}) = (firstoccurrenceof c){precision=maximum $ map precision $ commoditieswithsymbol s} firstoccurrenceof Commodity{symbol=s} = head $ commoditieswithsymbol s diff --git a/Ledger/Types.hs b/Ledger/Types.hs index aa9a23834..6f8597802 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -31,7 +31,8 @@ data Commodity = Commodity { data Amount = Amount { commodity :: Commodity, - quantity :: Double + quantity :: Double, + price :: Maybe MixedAmount -- ^ optional per-unit price for this amount at the time of entry } deriving (Eq) newtype MixedAmount = Mixed [Amount] deriving (Eq) diff --git a/Tests.hs b/Tests.hs index fa09e1380..008baea7d 100644 --- a/Tests.hs +++ b/Tests.hs @@ -34,15 +34,15 @@ unittests = TestList [ , "amount arithmetic" ~: do let a1 = dollars 1.23 - let a2 = Amount (comm "$") (-1.23) - let a3 = Amount (comm "$") (-1.23) - assertequal (Amount (comm "$") 0) (a1 + a2) - assertequal (Amount (comm "$") 0) (a1 + a3) - assertequal (Amount (comm "$") (-2.46)) (a2 + a3) - assertequal (Amount (comm "$") (-2.46)) (a3 + a3) - assertequal (Amount (comm "$") (-2.46)) (sum [a2,a3]) - assertequal (Amount (comm "$") (-2.46)) (sum [a3,a3]) - assertequal (Amount (comm "$") 0) (sum [a1,a2,a3,-a3]) + let a2 = Amount (comm "$") (-1.23) Nothing + let a3 = Amount (comm "$") (-1.23) Nothing + assertequal (Amount (comm "$") 0 Nothing) (a1 + a2) + assertequal (Amount (comm "$") 0 Nothing) (a1 + a3) + assertequal (Amount (comm "$") (-2.46) Nothing) (a2 + a3) + assertequal (Amount (comm "$") (-2.46) Nothing) (a3 + a3) + assertequal (Amount (comm "$") (-2.46) Nothing) (sum [a2,a3]) + assertequal (Amount (comm "$") (-2.46) Nothing) (sum [a3,a3]) + assertequal (Amount (comm "$") 0 Nothing) (sum [a1,a2,a3,-a3]) , "ledgertransaction" ~: do assertparseequal rawtransaction1 (parsewith ledgertransaction rawtransaction1_str) @@ -78,7 +78,7 @@ unittests = TestList [ , "transactionamount" ~: do assertparseequal (Mixed [dollars 47.18]) (parsewith transactionamount " $47.18") - assertparseequal (Mixed [Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0}) 1]) (parsewith transactionamount " $1.") + assertparseequal (Mixed [Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0}) 1 Nothing]) (parsewith transactionamount " $1.") , "setAmountDisplayPrefs" ~: do let l = setAmountDisplayPrefs $ rawLedgerWithAmounts ["1","2.00"]