mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
refactor: make amount price a non-maybe, reducing noise
This commit is contained in:
parent
4567e91409
commit
8c06553e3b
@ -125,8 +125,8 @@ instance Num Amount where
|
|||||||
(*) = similarAmountsOp (*)
|
(*) = similarAmountsOp (*)
|
||||||
|
|
||||||
-- | The empty simple amount.
|
-- | The empty simple amount.
|
||||||
amount :: Amount
|
amount, nullamt :: Amount
|
||||||
amount = Amount{acommodity="", aquantity=0, aprice=Nothing, astyle=amountstyle}
|
amount = Amount{acommodity="", aquantity=0, aprice=NoPrice, astyle=amountstyle}
|
||||||
nullamt = amount
|
nullamt = amount
|
||||||
|
|
||||||
-- handy amount constructors for tests
|
-- handy amount constructors for tests
|
||||||
@ -154,7 +154,7 @@ similarAmountsOp op Amount{acommodity=_, aquantity=aq, astyle=AmountStyle{aspre
|
|||||||
-- | Convert an amount to the specified commodity, ignoring and discarding
|
-- | Convert an amount to the specified commodity, ignoring and discarding
|
||||||
-- any assigned prices and assuming an exchange rate of 1.
|
-- any assigned prices and assuming an exchange rate of 1.
|
||||||
amountWithCommodity :: Commodity -> Amount -> Amount
|
amountWithCommodity :: Commodity -> Amount -> Amount
|
||||||
amountWithCommodity c a = a{acommodity=c, aprice=Nothing}
|
amountWithCommodity c a = a{acommodity=c, aprice=NoPrice}
|
||||||
|
|
||||||
-- | A more complete amount adding operation.
|
-- | A more complete amount adding operation.
|
||||||
sumAmounts :: [Amount] -> MixedAmount
|
sumAmounts :: [Amount] -> MixedAmount
|
||||||
@ -162,11 +162,11 @@ sumAmounts = normaliseMixedAmountPreservingPrices . Mixed
|
|||||||
|
|
||||||
-- | Set an amount's unit price.
|
-- | Set an amount's unit price.
|
||||||
at :: Amount -> Amount -> Amount
|
at :: Amount -> Amount -> Amount
|
||||||
amt `at` priceamt = amt{aprice=Just $ UnitPrice $ Mixed [priceamt]}
|
amt `at` priceamt = amt{aprice=UnitPrice $ Mixed [priceamt]}
|
||||||
|
|
||||||
-- | Set an amount's total price.
|
-- | Set an amount's total price.
|
||||||
(@@) :: Amount -> Amount -> Amount
|
(@@) :: Amount -> Amount -> Amount
|
||||||
amt @@ priceamt = amt{aprice=Just $ TotalPrice $ Mixed [priceamt]}
|
amt @@ priceamt = amt{aprice=TotalPrice $ Mixed [priceamt]}
|
||||||
|
|
||||||
tests_sumAmounts = [
|
tests_sumAmounts = [
|
||||||
"sumAmounts" ~: do
|
"sumAmounts" ~: do
|
||||||
@ -188,9 +188,9 @@ tests_sumAmounts = [
|
|||||||
costOfAmount :: Amount -> Amount
|
costOfAmount :: Amount -> Amount
|
||||||
costOfAmount a@Amount{aquantity=q, aprice=price} =
|
costOfAmount a@Amount{aquantity=q, aprice=price} =
|
||||||
case price of
|
case price of
|
||||||
Nothing -> a
|
NoPrice -> a
|
||||||
Just (UnitPrice (Mixed [p@Amount{aquantity=pq}])) -> p{aquantity=pq * q}
|
UnitPrice (Mixed [p@Amount{aquantity=pq}]) -> p{aquantity=pq * q}
|
||||||
Just (TotalPrice (Mixed [p@Amount{aquantity=pq}])) -> p{aquantity=pq * signum q}
|
TotalPrice (Mixed [p@Amount{aquantity=pq}]) -> p{aquantity=pq * signum q}
|
||||||
_ -> error' "costOfAmount: Malformed price encountered, programmer error"
|
_ -> error' "costOfAmount: Malformed price encountered, programmer error"
|
||||||
|
|
||||||
-- | Divide an amount's quantity by a constant.
|
-- | Divide an amount's quantity by a constant.
|
||||||
@ -232,21 +232,23 @@ withPrecision = flip setAmountPrecision
|
|||||||
showAmountDebug :: Amount -> String
|
showAmountDebug :: Amount -> String
|
||||||
showAmountDebug Amount{acommodity="AUTO"} = "(missing)"
|
showAmountDebug Amount{acommodity="AUTO"} = "(missing)"
|
||||||
showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}"
|
showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}"
|
||||||
(show acommodity) (show aquantity) (maybe "Nothing" showPriceDebug aprice) (show astyle)
|
(show acommodity) (show aquantity) (showPriceDebug aprice) (show astyle)
|
||||||
|
|
||||||
-- | Get the string representation of an amount, without any \@ price.
|
-- | Get the string representation of an amount, without any \@ price.
|
||||||
showAmountWithoutPrice :: Amount -> String
|
showAmountWithoutPrice :: Amount -> String
|
||||||
showAmountWithoutPrice a = showAmount a{aprice=Nothing}
|
showAmountWithoutPrice a = showAmount a{aprice=NoPrice}
|
||||||
|
|
||||||
-- | Get the string representation of an amount, without any price or commodity symbol.
|
-- | Get the string representation of an amount, without any price or commodity symbol.
|
||||||
showAmountWithoutPriceOrCommodity :: Amount -> String
|
showAmountWithoutPriceOrCommodity :: Amount -> String
|
||||||
showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=Nothing}
|
showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=NoPrice}
|
||||||
|
|
||||||
showPrice :: Price -> String
|
showPrice :: Price -> String
|
||||||
|
showPrice NoPrice = ""
|
||||||
showPrice (UnitPrice pa) = " @ " ++ showMixedAmount pa
|
showPrice (UnitPrice pa) = " @ " ++ showMixedAmount pa
|
||||||
showPrice (TotalPrice pa) = " @@ " ++ showMixedAmount pa
|
showPrice (TotalPrice pa) = " @@ " ++ showMixedAmount pa
|
||||||
|
|
||||||
showPriceDebug :: Price -> String
|
showPriceDebug :: Price -> String
|
||||||
|
showPriceDebug NoPrice = ""
|
||||||
showPriceDebug (UnitPrice pa) = " @ " ++ showMixedAmountDebug pa
|
showPriceDebug (UnitPrice pa) = " @ " ++ showMixedAmountDebug pa
|
||||||
showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa
|
showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa
|
||||||
|
|
||||||
@ -265,7 +267,7 @@ showAmount a@(Amount{acommodity=c, aprice=p, astyle=AmountStyle{..}}) =
|
|||||||
(quantity',c') | displayingzero = ("0","")
|
(quantity',c') | displayingzero = ("0","")
|
||||||
| otherwise = (quantity, quoteCommoditySymbolIfNeeded c)
|
| otherwise = (quantity, quoteCommoditySymbolIfNeeded c)
|
||||||
space = if (not (null c') && ascommodityspaced) then " " else "" :: String
|
space = if (not (null c') && ascommodityspaced) then " " else "" :: String
|
||||||
price = maybe "" showPrice p
|
price = showPrice p
|
||||||
|
|
||||||
-- | Get the string representation of the number part of of an amount,
|
-- | Get the string representation of the number part of of an amount,
|
||||||
-- using the display settings from its commodity.
|
-- using the display settings from its commodity.
|
||||||
@ -355,8 +357,8 @@ normaliseMixedAmountPreservingPrices (Mixed as) = Mixed as''
|
|||||||
where
|
where
|
||||||
sameunitprice a1 a2 =
|
sameunitprice a1 a2 =
|
||||||
case (aprice a1, aprice a2) of
|
case (aprice a1, aprice a2) of
|
||||||
(Nothing, Nothing) -> True
|
(NoPrice, NoPrice) -> True
|
||||||
(Just (UnitPrice p1), Just (UnitPrice p2)) -> p1 == p2
|
(UnitPrice p1, UnitPrice p2) -> p1 == p2
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
tests_normaliseMixedAmountPreservingPrices = [
|
tests_normaliseMixedAmountPreservingPrices = [
|
||||||
@ -471,7 +473,7 @@ showMixedAmountWithoutPrice :: MixedAmount -> String
|
|||||||
showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth as
|
showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth as
|
||||||
where
|
where
|
||||||
(Mixed as) = normaliseMixedAmountPreservingFirstPrice $ stripPrices m
|
(Mixed as) = normaliseMixedAmountPreservingFirstPrice $ stripPrices m
|
||||||
stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing}
|
stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice}
|
||||||
width = maximum $ map (length . showAmount) as
|
width = maximum $ map (length . showAmount) as
|
||||||
showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice
|
showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice
|
||||||
|
|
||||||
@ -508,9 +510,9 @@ tests_Hledger_Data_Amount = TestList $
|
|||||||
|
|
||||||
"costOfAmount" ~: do
|
"costOfAmount" ~: do
|
||||||
costOfAmount (eur 1) `is` eur 1
|
costOfAmount (eur 1) `is` eur 1
|
||||||
costOfAmount (eur 2){aprice=Just $ UnitPrice $ Mixed [usd 2]} `is` usd 4
|
costOfAmount (eur 2){aprice=UnitPrice $ Mixed [usd 2]} `is` usd 4
|
||||||
costOfAmount (eur 1){aprice=Just $ TotalPrice $ Mixed [usd 2]} `is` usd 2
|
costOfAmount (eur 1){aprice=TotalPrice $ Mixed [usd 2]} `is` usd 2
|
||||||
costOfAmount (eur (-1)){aprice=Just $ TotalPrice $ Mixed [usd 2]} `is` usd (-2)
|
costOfAmount (eur (-1)){aprice=TotalPrice $ Mixed [usd 2]} `is` usd (-2)
|
||||||
|
|
||||||
,"isZeroAmount" ~: do
|
,"isZeroAmount" ~: do
|
||||||
assertBool "" $ isZeroAmount $ amount
|
assertBool "" $ isZeroAmount $ amount
|
||||||
@ -519,7 +521,7 @@ tests_Hledger_Data_Amount = TestList $
|
|||||||
,"negating amounts" ~: do
|
,"negating amounts" ~: do
|
||||||
let a = usd 1
|
let a = usd 1
|
||||||
negate a `is` a{aquantity=(-1)}
|
negate a `is` a{aquantity=(-1)}
|
||||||
let b = (usd 1){aprice=Just $ UnitPrice $ Mixed [eur 2]}
|
let b = (usd 1){aprice=UnitPrice $ Mixed [eur 2]}
|
||||||
negate b `is` b{aquantity=(-1)}
|
negate b `is` b{aquantity=(-1)}
|
||||||
|
|
||||||
,"adding amounts without prices" ~: do
|
,"adding amounts without prices" ~: do
|
||||||
|
@ -284,21 +284,21 @@ balanceTransaction styles t@Transaction{tpostings=ps}
|
|||||||
rcommoditiesinorder = map acommodity ramountsinorder
|
rcommoditiesinorder = map acommodity ramountsinorder
|
||||||
rsumamounts = amounts $ sum rmixedamountsinorder
|
rsumamounts = amounts $ sum rmixedamountsinorder
|
||||||
-- assumption: the sum of mixed amounts is normalised (one simple amount per commodity)
|
-- assumption: the sum of mixed amounts is normalised (one simple amount per commodity)
|
||||||
t'' = if length rsumamounts == 2 && all (isNothing.aprice) rsumamounts && t'==t
|
t'' = if length rsumamounts == 2 && all ((==NoPrice).aprice) rsumamounts && t'==t
|
||||||
then t'{tpostings=map inferprice ps}
|
then t'{tpostings=map inferprice ps}
|
||||||
else t'
|
else t'
|
||||||
where
|
where
|
||||||
-- assumption: a posting's mixed amount contains one simple amount
|
-- assumption: a posting's mixed amount contains one simple amount
|
||||||
inferprice p@Posting{pamount=Mixed [a@Amount{acommodity=c,aprice=Nothing}], ptype=RegularPosting}
|
inferprice p@Posting{pamount=Mixed [a@Amount{acommodity=c,aprice=NoPrice}], ptype=RegularPosting}
|
||||||
= p{pamount=Mixed [a{aprice=conversionprice c}]}
|
= p{pamount=Mixed [a{aprice=conversionprice c}]}
|
||||||
where
|
where
|
||||||
conversionprice c | c == unpricedcommodity
|
conversionprice c | c == unpricedcommodity
|
||||||
-- assign a balancing price. Use @@ for more exact output when possible.
|
-- assign a balancing price. Use @@ for more exact output when possible.
|
||||||
-- invariant: prices should always be positive. Enforced with "abs"
|
-- invariant: prices should always be positive. Enforced with "abs"
|
||||||
= if length ramountsinunpricedcommodity == 1
|
= if length ramountsinunpricedcommodity == 1
|
||||||
then Just $ TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount]
|
then TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount]
|
||||||
else Just $ UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)]
|
else UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)]
|
||||||
| otherwise = Nothing
|
| otherwise = NoPrice
|
||||||
where
|
where
|
||||||
unpricedcommodity = head $ filter (`elem` (map acommodity rsumamounts)) rcommoditiesinorder
|
unpricedcommodity = head $ filter (`elem` (map acommodity rsumamounts)) rcommoditiesinorder
|
||||||
unpricedamount = head $ filter ((==unpricedcommodity).acommodity) rsumamounts
|
unpricedamount = head $ filter ((==unpricedcommodity).acommodity) rsumamounts
|
||||||
@ -311,18 +311,18 @@ balanceTransaction styles t@Transaction{tpostings=ps}
|
|||||||
bvamountsinorder = concatMap amounts bvmixedamountsinorder
|
bvamountsinorder = concatMap amounts bvmixedamountsinorder
|
||||||
bvcommoditiesinorder = map acommodity bvamountsinorder
|
bvcommoditiesinorder = map acommodity bvamountsinorder
|
||||||
bvsumamounts = amounts $ sum bvmixedamountsinorder
|
bvsumamounts = amounts $ sum bvmixedamountsinorder
|
||||||
t''' = if length bvsumamounts == 2 && all (isNothing.aprice) bvsumamounts && t'==t -- XXX could check specifically for bv amount inferring
|
t''' = if length bvsumamounts == 2 && all ((==NoPrice).aprice) bvsumamounts && t'==t -- XXX could check specifically for bv amount inferring
|
||||||
then t''{tpostings=map inferprice ps}
|
then t''{tpostings=map inferprice ps}
|
||||||
else t''
|
else t''
|
||||||
where
|
where
|
||||||
inferprice p@Posting{pamount=Mixed [a@Amount{acommodity=c,aprice=Nothing}], ptype=BalancedVirtualPosting}
|
inferprice p@Posting{pamount=Mixed [a@Amount{acommodity=c,aprice=NoPrice}], ptype=BalancedVirtualPosting}
|
||||||
= p{pamount=Mixed [a{aprice=conversionprice c}]}
|
= p{pamount=Mixed [a{aprice=conversionprice c}]}
|
||||||
where
|
where
|
||||||
conversionprice c | c == unpricedcommodity
|
conversionprice c | c == unpricedcommodity
|
||||||
= if length bvamountsinunpricedcommodity == 1
|
= if length bvamountsinunpricedcommodity == 1
|
||||||
then Just $ TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount]
|
then TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount]
|
||||||
else Just $ UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)]
|
else UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)]
|
||||||
| otherwise = Nothing
|
| otherwise = NoPrice
|
||||||
where
|
where
|
||||||
unpricedcommodity = head $ filter (`elem` (map acommodity bvsumamounts)) bvcommoditiesinorder
|
unpricedcommodity = head $ filter (`elem` (map acommodity bvsumamounts)) bvcommoditiesinorder
|
||||||
unpricedamount = head $ filter ((==unpricedcommodity).acommodity) bvsumamounts
|
unpricedamount = head $ filter ((==unpricedcommodity).acommodity) bvsumamounts
|
||||||
|
@ -47,11 +47,11 @@ type Commodity = String
|
|||||||
|
|
||||||
type Quantity = Double
|
type Quantity = Double
|
||||||
|
|
||||||
-- | An amount's price in another commodity may be written as \@ unit
|
-- | An amount's price (none, per unit, or total) in another commodity.
|
||||||
-- price or \@\@ total price. Note although a MixedAmount is used, it
|
-- Note although a MixedAmount is used, it should be in a single
|
||||||
-- should be in a single commodity, also the amount should be positive;
|
-- commodity, also the amount should be positive; these are not enforced
|
||||||
-- these are not enforced currently.
|
-- currently.
|
||||||
data Price = {- NoPrice | -} UnitPrice MixedAmount | TotalPrice MixedAmount
|
data Price = NoPrice | UnitPrice MixedAmount | TotalPrice MixedAmount
|
||||||
deriving (Eq,Ord)
|
deriving (Eq,Ord)
|
||||||
|
|
||||||
-- | Display style for an amount.
|
-- | Display style for an amount.
|
||||||
@ -67,7 +67,7 @@ data AmountStyle = AmountStyle {
|
|||||||
data Amount = Amount {
|
data Amount = Amount {
|
||||||
acommodity :: Commodity,
|
acommodity :: Commodity,
|
||||||
aquantity :: Quantity,
|
aquantity :: Quantity,
|
||||||
aprice :: Maybe Price, -- ^ the price for this amount, fixed at posting time
|
aprice :: Price, -- ^ the (fixed) price for this amount, if any
|
||||||
astyle :: AmountStyle
|
astyle :: AmountStyle
|
||||||
} deriving (Eq,Ord)
|
} deriving (Eq,Ord)
|
||||||
|
|
||||||
|
@ -639,7 +639,7 @@ quotedcommoditysymbol = do
|
|||||||
simplecommoditysymbol :: GenParser Char JournalContext String
|
simplecommoditysymbol :: GenParser Char JournalContext String
|
||||||
simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars)
|
simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars)
|
||||||
|
|
||||||
priceamount :: GenParser Char JournalContext (Maybe Price)
|
priceamount :: GenParser Char JournalContext Price
|
||||||
priceamount =
|
priceamount =
|
||||||
try (do
|
try (do
|
||||||
many spacenonewline
|
many spacenonewline
|
||||||
@ -648,12 +648,12 @@ priceamount =
|
|||||||
char '@'
|
char '@'
|
||||||
many spacenonewline
|
many spacenonewline
|
||||||
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
|
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
|
||||||
return $ Just $ TotalPrice a)
|
return $ TotalPrice a)
|
||||||
<|> (do
|
<|> (do
|
||||||
many spacenonewline
|
many spacenonewline
|
||||||
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
|
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
|
||||||
return $ Just $ UnitPrice a))
|
return $ UnitPrice a))
|
||||||
<|> return Nothing
|
<|> return NoPrice
|
||||||
|
|
||||||
balanceassertion :: GenParser Char JournalContext (Maybe MixedAmount)
|
balanceassertion :: GenParser Char JournalContext (Maybe MixedAmount)
|
||||||
balanceassertion =
|
balanceassertion =
|
||||||
|
Loading…
Reference in New Issue
Block a user