simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-20 02:37:12 +03:00
Code Issues Projects Releases Wiki Activity

refactor: make amount price a non-maybe, reducing noise

Browse Source
This commit is contained in:
Simon Michael 2012-11-19 22:39:08 +00:00
parent 4567e91409
commit 8c06553e3b
4 changed files with 41 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
hledger-lib/Hledger/Data/Amount.hs
View File

@ -125,8 +125,8 @@ instance Num Amount where
(*) = similarAmountsOp (*)
-- | The empty simple amount.
amount :: Amount
amount = Amount{acommodity="", aquantity=0, aprice=Nothing, astyle=amountstyle}
amount, nullamt :: Amount
amount = Amount{acommodity="", aquantity=0, aprice=NoPrice, astyle=amountstyle}
nullamt = amount
-- 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
-- any assigned prices and assuming an exchange rate of 1.
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.
sumAmounts :: [Amount] -> MixedAmount
@ -162,11 +162,11 @@ sumAmounts = normaliseMixedAmountPreservingPrices . Mixed
-- | Set an amount's unit price.
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.
(@@) :: Amount -> Amount -> Amount
amt @@ priceamt = amt{aprice=Just $ TotalPrice $ Mixed [priceamt]}
amt @@ priceamt = amt{aprice=TotalPrice $ Mixed [priceamt]}
tests_sumAmounts = [
"sumAmounts" ~: do
@ -188,9 +188,9 @@ tests_sumAmounts = [
costOfAmount :: Amount -> Amount
costOfAmount a@Amount{aquantity=q, aprice=price} =
case price of
Nothing -> a
Just (UnitPrice (Mixed [p@Amount{aquantity=pq}])) -> p{aquantity=pq * q}
Just (TotalPrice (Mixed [p@Amount{aquantity=pq}])) -> p{aquantity=pq * signum q}
NoPrice -> a
UnitPrice (Mixed [p@Amount{aquantity=pq}]) -> p{aquantity=pq * q}
TotalPrice (Mixed [p@Amount{aquantity=pq}]) -> p{aquantity=pq * signum q}
_ -> error' "costOfAmount: Malformed price encountered, programmer error"
-- | Divide an amount's quantity by a constant.
@ -232,21 +232,23 @@ withPrecision = flip setAmountPrecision
showAmountDebug :: Amount -> String
showAmountDebug Amount{acommodity="AUTO"} = "(missing)"
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.
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.
showAmountWithoutPriceOrCommodity :: Amount -> String
showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=Nothing}
showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=NoPrice}
showPrice :: Price -> String
showPrice NoPrice = ""
showPrice (UnitPrice pa) = " @ " ++ showMixedAmount pa
showPrice (TotalPrice pa) = " @@ " ++ showMixedAmount pa
showPriceDebug :: Price -> String
showPriceDebug NoPrice = ""
showPriceDebug (UnitPrice 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","")
| otherwise = (quantity, quoteCommoditySymbolIfNeeded c)
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,
-- using the display settings from its commodity.
@ -355,8 +357,8 @@ normaliseMixedAmountPreservingPrices (Mixed as) = Mixed as''
where
sameunitprice a1 a2 =
case (aprice a1, aprice a2) of
(Nothing, Nothing) -> True
(Just (UnitPrice p1), Just (UnitPrice p2)) -> p1 == p2
(NoPrice, NoPrice) -> True
(UnitPrice p1, UnitPrice p2) -> p1 == p2
_ -> False
tests_normaliseMixedAmountPreservingPrices = [
@ -471,7 +473,7 @@ showMixedAmountWithoutPrice :: MixedAmount -> String
showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth as
where
(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
showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice
@ -508,9 +510,9 @@ tests_Hledger_Data_Amount = TestList $
"costOfAmount" ~: do
costOfAmount (eur 1) `is` eur 1
costOfAmount (eur 2){aprice=Just $ UnitPrice $ Mixed [usd 2]} `is` usd 4
costOfAmount (eur 1){aprice=Just $ TotalPrice $ Mixed [usd 2]} `is` usd 2
costOfAmount (eur (-1)){aprice=Just $ TotalPrice $ Mixed [usd 2]} `is` usd (-2)
costOfAmount (eur 2){aprice=UnitPrice $ Mixed [usd 2]} `is` usd 4
costOfAmount (eur 1){aprice=TotalPrice $ Mixed [usd 2]} `is` usd 2
costOfAmount (eur (-1)){aprice=TotalPrice $ Mixed [usd 2]} `is` usd (-2)
,"isZeroAmount" ~: do
assertBool "" $ isZeroAmount $ amount
@ -519,7 +521,7 @@ tests_Hledger_Data_Amount = TestList $
,"negating amounts" ~: do
let a = usd 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)}
,"adding amounts without prices" ~: do

20
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -284,21 +284,21 @@ balanceTransaction styles t@Transaction{tpostings=ps}
rcommoditiesinorder = map acommodity ramountsinorder
rsumamounts = amounts $ sum rmixedamountsinorder
-- 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}
else t'
where
-- 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}]}
where
conversionprice c | c == unpricedcommodity
-- assign a balancing price. Use @@ for more exact output when possible.
-- invariant: prices should always be positive. Enforced with "abs"
= if length ramountsinunpricedcommodity == 1
then Just $ TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount]
else Just $ UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)]
| otherwise = Nothing
then TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount]
else UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)]
| otherwise = NoPrice
where
unpricedcommodity = head $ filter (`elem` (map acommodity rsumamounts)) rcommoditiesinorder
unpricedamount = head $ filter ((==unpricedcommodity).acommodity) rsumamounts
@ -311,18 +311,18 @@ balanceTransaction styles t@Transaction{tpostings=ps}
bvamountsinorder = concatMap amounts bvmixedamountsinorder
bvcommoditiesinorder = map acommodity bvamountsinorder
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}
else t''
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}]}
where
conversionprice c | c == unpricedcommodity
= if length bvamountsinunpricedcommodity == 1
then Just $ TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount]
else Just $ UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)]
| otherwise = Nothing
then TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount]
else UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)]
| otherwise = NoPrice
where
unpricedcommodity = head $ filter (`elem` (map acommodity bvsumamounts)) bvcommoditiesinorder
unpricedamount = head $ filter ((==unpricedcommodity).acommodity) bvsumamounts

12
hledger-lib/Hledger/Data/Types.hs
View File

@ -47,11 +47,11 @@ type Commodity = String
type Quantity = Double
-- | An amount's price in another commodity may be written as \@ unit
-- price or \@\@ total price. Note although a MixedAmount is used, it
-- should be in a single commodity, also the amount should be positive;
-- these are not enforced currently.
data Price = {- NoPrice | -} UnitPrice MixedAmount | TotalPrice MixedAmount
-- | An amount's price (none, per unit, or total) in another commodity.
-- Note although a MixedAmount is used, it should be in a single
-- commodity, also the amount should be positive; these are not enforced
-- currently.
data Price = NoPrice | UnitPrice MixedAmount | TotalPrice MixedAmount
deriving (Eq,Ord)
-- | Display style for an amount.
@ -67,7 +67,7 @@ data AmountStyle = AmountStyle {
data Amount = Amount {
acommodity :: Commodity,
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
} deriving (Eq,Ord)

8
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -639,7 +639,7 @@ quotedcommoditysymbol = do
simplecommoditysymbol :: GenParser Char JournalContext String
simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars)
priceamount :: GenParser Char JournalContext (Maybe Price)
priceamount :: GenParser Char JournalContext Price
priceamount =
try (do
many spacenonewline
@ -648,12 +648,12 @@ priceamount =
char '@'
many spacenonewline
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
return $ Just $ TotalPrice a)
return $ TotalPrice a)
<|> (do
many spacenonewline
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
return $ Just $ UnitPrice a))
<|> return Nothing
return $ UnitPrice a))
<|> return NoPrice
balanceassertion :: GenParser Char JournalContext (Maybe MixedAmount)
balanceassertion =