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