first attempt at storing per-amount price

This commit is contained in:
Simon Michael 2008-11-22 16:26:01 +00:00
parent 8e412b1be3
commit 33f06f334e
6 changed files with 55 additions and 38 deletions

View File

@ -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]

View File

@ -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]

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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"]