From 8c06553e3b7d8d65c493f618b934d72fe6951cf8 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 19 Nov 2012 22:39:08 +0000 Subject: [PATCH] refactor: make amount price a non-maybe, reducing noise --- hledger-lib/Hledger/Data/Amount.hs | 40 ++++++++++++----------- hledger-lib/Hledger/Data/Transaction.hs | 20 ++++++------ hledger-lib/Hledger/Data/Types.hs | 12 +++---- hledger-lib/Hledger/Read/JournalReader.hs | 8 ++--- 4 files changed, 41 insertions(+), 39 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 2f4a0d5b6..a722b34ec 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index f6914d3a5..987cfb739 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index b7cc0a4e5..e715ee075 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -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) diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index d76944c27..007efe830 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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 =