mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
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 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]
|
||||
|
||||
|
@ -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]
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
20
Tests.hs
20
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"]
|
||||
|
Loading…
Reference in New Issue
Block a user