;lib: refactor: change AmountPrice to a Maybe
I've wanted to do this for a long time; now that prices are in flux, seems a good time.
This commit is contained in:
		
							parent
							
								
									adb6ee40eb
								
							
						
					
					
						commit
						692620180e
					
				| @ -165,7 +165,7 @@ instance Num Amount where | |||||||
| 
 | 
 | ||||||
| -- | The empty simple amount. | -- | The empty simple amount. | ||||||
| amount, nullamt :: Amount | amount, nullamt :: Amount | ||||||
| amount = Amount{acommodity="", aquantity=0, aprice=NoPrice, astyle=amountstyle, aismultiplier=False} | amount = Amount{acommodity="", aquantity=0, aprice=Nothing, astyle=amountstyle, aismultiplier=False} | ||||||
| nullamt = amount | nullamt = amount | ||||||
| 
 | 
 | ||||||
| -- | A temporary value for parsed transactions which had no amount specified. | -- | A temporary value for parsed transactions which had no amount specified. | ||||||
| @ -179,8 +179,8 @@ hrs n = amount{acommodity="h", aquantity=n,           astyle=amountstyle{aspreci | |||||||
| usd n = amount{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} | usd n = amount{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} | ||||||
| eur n = amount{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} | eur n = amount{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} | ||||||
| gbp n = amount{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} | gbp n = amount{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} | ||||||
| amt `at` priceamt = amt{aprice=UnitPrice priceamt} | amt `at` priceamt = amt{aprice=Just $ UnitPrice priceamt} | ||||||
| amt @@ priceamt = amt{aprice=TotalPrice priceamt} | amt @@ priceamt = amt{aprice=Just $ TotalPrice priceamt} | ||||||
| 
 | 
 | ||||||
| -- | Apply a binary arithmetic operator to two amounts, which should | -- | Apply a binary arithmetic operator to two amounts, which should | ||||||
| -- be in the same commodity if non-zero (warning, this is not checked). | -- be in the same commodity if non-zero (warning, this is not checked). | ||||||
| @ -200,7 +200,7 @@ similarAmountsOp op Amount{acommodity=_,  aquantity=q1, 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 :: CommoditySymbol -> Amount -> Amount | amountWithCommodity :: CommoditySymbol -> Amount -> Amount | ||||||
| amountWithCommodity c a = a{acommodity=c, aprice=NoPrice} | amountWithCommodity c a = a{acommodity=c, aprice=Nothing} | ||||||
| 
 | 
 | ||||||
| -- | Convert an amount to the commodity of its assigned price, if any.  Notes: | -- | Convert an amount to the commodity of its assigned price, if any.  Notes: | ||||||
| -- | -- | ||||||
| @ -208,11 +208,11 @@ amountWithCommodity c a = a{acommodity=c, aprice=NoPrice} | |||||||
| -- | -- | ||||||
| -- - price amounts should be positive, though this is not currently enforced | -- - price amounts should be positive, though this is not currently enforced | ||||||
| costOfAmount :: Amount -> Amount | costOfAmount :: Amount -> Amount | ||||||
| costOfAmount a@Amount{aquantity=q, aprice=price} = | costOfAmount a@Amount{aquantity=q, aprice=mp} = | ||||||
|     case price of |     case mp of | ||||||
|       NoPrice -> a |       Nothing                                  -> a | ||||||
|       UnitPrice  p@Amount{aquantity=pq} -> p{aquantity=pq * q} |       Just (UnitPrice  p@Amount{aquantity=pq}) -> p{aquantity=pq * q} | ||||||
|       TotalPrice p@Amount{aquantity=pq} -> p{aquantity=pq * signum q} |       Just (TotalPrice p@Amount{aquantity=pq}) -> p{aquantity=pq * signum q} | ||||||
| 
 | 
 | ||||||
| -- | Convert this amount to cost, and apply the appropriate amount style. | -- | Convert this amount to cost, and apply the appropriate amount style. | ||||||
| amountToCost :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount | amountToCost :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount | ||||||
| @ -225,8 +225,8 @@ amountToCost styles = styleAmount styles . costOfAmount | |||||||
| -- Does Decimal division, might be some rounding/irrational number issues. | -- Does Decimal division, might be some rounding/irrational number issues. | ||||||
| amountTotalPriceToUnitPrice :: Amount -> Amount | amountTotalPriceToUnitPrice :: Amount -> Amount | ||||||
| amountTotalPriceToUnitPrice  | amountTotalPriceToUnitPrice  | ||||||
|   a@Amount{aquantity=q, aprice=TotalPrice pa@Amount{aquantity=pq, astyle=ps@AmountStyle{asprecision=pp}}} |   a@Amount{aquantity=q, aprice=Just (TotalPrice pa@Amount{aquantity=pq, astyle=ps@AmountStyle{asprecision=pp}})} | ||||||
|   = a{aprice = UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp+1}}} |   = a{aprice = Just $ UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp+1}}} | ||||||
| amountTotalPriceToUnitPrice a = a | amountTotalPriceToUnitPrice a = a | ||||||
| 
 | 
 | ||||||
| -- | Divide an amount's quantity by a constant. | -- | Divide an amount's quantity by a constant. | ||||||
| @ -240,7 +240,7 @@ multiplyAmount n a@Amount{aquantity=q} = a{aquantity=q*n} | |||||||
| -- | Divide an amount's quantity (and its total price, if it has one) by a constant. | -- | Divide an amount's quantity (and its total price, if it has one) by a constant. | ||||||
| -- The total price will be kept positive regardless of the multiplier's sign. | -- The total price will be kept positive regardless of the multiplier's sign. | ||||||
| divideAmountAndPrice :: Quantity -> Amount -> Amount | divideAmountAndPrice :: Quantity -> Amount -> Amount | ||||||
| divideAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q/n, aprice=f p} | divideAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q/n, aprice=f <$> p} | ||||||
|   where |   where | ||||||
|     f (TotalPrice a) = TotalPrice $ abs $ n `divideAmount` a |     f (TotalPrice a) = TotalPrice $ abs $ n `divideAmount` a | ||||||
|     f p = p |     f p = p | ||||||
| @ -248,7 +248,7 @@ divideAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q/n, aprice= | |||||||
| -- | Multiply an amount's quantity (and its total price, if it has one) by a constant. | -- | Multiply an amount's quantity (and its total price, if it has one) by a constant. | ||||||
| -- The total price will be kept positive regardless of the multiplier's sign. | -- The total price will be kept positive regardless of the multiplier's sign. | ||||||
| multiplyAmountAndPrice :: Quantity -> Amount -> Amount | multiplyAmountAndPrice :: Quantity -> Amount -> Amount | ||||||
| multiplyAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q*n, aprice=f p} | multiplyAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q*n, aprice=f <$> p} | ||||||
|   where |   where | ||||||
|     f (TotalPrice a) = TotalPrice $ abs $ n `multiplyAmount` a |     f (TotalPrice a) = TotalPrice $ abs $ n `multiplyAmount` a | ||||||
|     f p = p |     f p = p | ||||||
| @ -306,7 +306,7 @@ showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice | |||||||
| 
 | 
 | ||||||
| -- | 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=NoPrice} | showAmountWithoutPrice a = showAmount a{aprice=Nothing} | ||||||
| 
 | 
 | ||||||
| -- | Set an amount's internal precision, ie rounds the Decimal representing  | -- | Set an amount's internal precision, ie rounds the Decimal representing  | ||||||
| -- the amount's quantity to some number of decimal places. | -- the amount's quantity to some number of decimal places. | ||||||
| @ -335,21 +335,21 @@ withDecimalPoint = flip setAmountDecimalPoint | |||||||
| 
 | 
 | ||||||
| -- | Colour version. | -- | Colour version. | ||||||
| cshowAmountWithoutPrice :: Amount -> String | cshowAmountWithoutPrice :: Amount -> String | ||||||
| cshowAmountWithoutPrice a = cshowAmount a{aprice=NoPrice} | cshowAmountWithoutPrice a = cshowAmount a{aprice=Nothing} | ||||||
| 
 | 
 | ||||||
| -- | 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=NoPrice} | showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=Nothing} | ||||||
| 
 | 
 | ||||||
| showAmountPrice :: AmountPrice -> String | showAmountPrice :: Maybe AmountPrice -> String | ||||||
| showAmountPrice NoPrice         = "" | showAmountPrice Nothing                = "" | ||||||
| showAmountPrice (UnitPrice pa)  = " @ "  ++ showAmount pa | showAmountPrice (Just (UnitPrice pa))  = " @ "  ++ showAmount pa | ||||||
| showAmountPrice (TotalPrice pa) = " @@ " ++ showAmount pa | showAmountPrice (Just (TotalPrice pa)) = " @@ " ++ showAmount pa | ||||||
| 
 | 
 | ||||||
| showAmountPriceDebug :: AmountPrice -> String | showAmountPriceDebug :: Maybe AmountPrice -> String | ||||||
| showAmountPriceDebug NoPrice         = "" | showAmountPriceDebug Nothing                = "" | ||||||
| showAmountPriceDebug (UnitPrice pa)  = " @ "  ++ showAmountDebug pa | showAmountPriceDebug (Just (UnitPrice pa))  = " @ "  ++ showAmountDebug pa | ||||||
| showAmountPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa | showAmountPriceDebug (Just (TotalPrice pa)) = " @@ " ++ showAmountDebug pa | ||||||
| 
 | 
 | ||||||
| -- | Given a map of standard amount display styles, apply the appropriate one to this amount. | -- | Given a map of standard amount display styles, apply the appropriate one to this amount. | ||||||
| -- If there's no standard style for this amount's commodity, return the amount unchanged. | -- If there's no standard style for this amount's commodity, return the amount unchanged. | ||||||
| @ -375,7 +375,7 @@ cshowAmount a = | |||||||
| 
 | 
 | ||||||
| showAmountHelper :: Bool -> Amount -> String | showAmountHelper :: Bool -> Amount -> String | ||||||
| showAmountHelper _ Amount{acommodity="AUTO"} = "" | showAmountHelper _ Amount{acommodity="AUTO"} = "" | ||||||
| showAmountHelper showzerocommodity a@Amount{acommodity=c, aprice=p, astyle=AmountStyle{..}} = | showAmountHelper showzerocommodity a@Amount{acommodity=c, aprice=mp, astyle=AmountStyle{..}} = | ||||||
|     case ascommodityside of |     case ascommodityside of | ||||||
|       L -> printf "%s%s%s%s" (T.unpack c') space quantity' price |       L -> printf "%s%s%s%s" (T.unpack c') space quantity' price | ||||||
|       R -> printf "%s%s%s%s" quantity' space (T.unpack c') price |       R -> printf "%s%s%s%s" quantity' space (T.unpack c') price | ||||||
| @ -385,7 +385,7 @@ showAmountHelper showzerocommodity a@Amount{acommodity=c, aprice=p, astyle=Amoun | |||||||
|       (quantity',c') | displayingzero && not showzerocommodity = ("0","") |       (quantity',c') | displayingzero && not showzerocommodity = ("0","") | ||||||
|                      | otherwise = (quantity, quoteCommoditySymbolIfNeeded c) |                      | otherwise = (quantity, quoteCommoditySymbolIfNeeded c) | ||||||
|       space = if not (T.null c') && ascommodityspaced then " " else "" :: String |       space = if not (T.null c') && ascommodityspaced then " " else "" :: String | ||||||
|       price = showAmountPrice p |       price = showAmountPrice mp | ||||||
| 
 | 
 | ||||||
| -- | Like showAmount, but show a zero amount's commodity if it has one. | -- | Like showAmount, but show a zero amount's commodity if it has one. | ||||||
| showAmountWithZeroCommodity :: Amount -> String | showAmountWithZeroCommodity :: Amount -> String | ||||||
| @ -503,8 +503,8 @@ normaliseHelper squashprices (Mixed as) | |||||||
|     groupfn | squashprices = (==) `on` acommodity |     groupfn | squashprices = (==) `on` acommodity | ||||||
|             | otherwise    = \a1 a2 -> acommodity a1 == acommodity a2 && combinableprices a1 a2 |             | otherwise    = \a1 a2 -> acommodity a1 == acommodity a2 && combinableprices a1 a2 | ||||||
| 
 | 
 | ||||||
|     combinableprices Amount{aprice=NoPrice} Amount{aprice=NoPrice} = True |     combinableprices Amount{aprice=Nothing} Amount{aprice=Nothing} = True | ||||||
|     combinableprices Amount{aprice=UnitPrice p1} Amount{aprice=UnitPrice p2} = p1 == p2 |     combinableprices Amount{aprice=Just (UnitPrice p1)} Amount{aprice=Just (UnitPrice p2)} = p1 == p2 | ||||||
|     combinableprices _ _ = False |     combinableprices _ _ = False | ||||||
| 
 | 
 | ||||||
| -- | Like normaliseMixedAmount, but combine each commodity's amounts | -- | Like normaliseMixedAmount, but combine each commodity's amounts | ||||||
| @ -682,7 +682,7 @@ cshowMixedAmountWithoutPrice m = intercalate "\n" $ map showamt as | |||||||
|         width = maximumDef 0 $ map (length . showAmount) as |         width = maximumDef 0 $ map (length . showAmount) as | ||||||
| 
 | 
 | ||||||
| mixedAmountStripPrices :: MixedAmount -> MixedAmount | mixedAmountStripPrices :: MixedAmount -> MixedAmount | ||||||
| mixedAmountStripPrices (Mixed as) = Mixed $ map (\a -> a{aprice=NoPrice}) as | mixedAmountStripPrices (Mixed as) = Mixed $ map (\a -> a{aprice=Nothing}) as | ||||||
| 
 | 
 | ||||||
| -- | Get the one-line string representation of a mixed amount, but without | -- | Get the one-line string representation of a mixed amount, but without | ||||||
| -- any \@ prices. | -- any \@ prices. | ||||||
| @ -690,14 +690,14 @@ showMixedAmountOneLineWithoutPrice :: MixedAmount -> String | |||||||
| showMixedAmountOneLineWithoutPrice m = intercalate ", " $ map showAmountWithoutPrice as | showMixedAmountOneLineWithoutPrice m = intercalate ", " $ map showAmountWithoutPrice as | ||||||
|     where |     where | ||||||
|       (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m |       (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m | ||||||
|       stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice} |       stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing} | ||||||
| 
 | 
 | ||||||
| -- | Colour version. | -- | Colour version. | ||||||
| cshowMixedAmountOneLineWithoutPrice :: MixedAmount -> String | cshowMixedAmountOneLineWithoutPrice :: MixedAmount -> String | ||||||
| cshowMixedAmountOneLineWithoutPrice m = intercalate ", " $ map cshowAmountWithoutPrice as | cshowMixedAmountOneLineWithoutPrice m = intercalate ", " $ map cshowAmountWithoutPrice as | ||||||
|     where |     where | ||||||
|       (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m |       (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m | ||||||
|       stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice} |       stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing} | ||||||
| 
 | 
 | ||||||
| -- | Canonicalise a mixed amount's display styles using the provided commodity style map. | -- | Canonicalise a mixed amount's display styles using the provided commodity style map. | ||||||
| canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount | canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount | ||||||
| @ -718,9 +718,9 @@ tests_Amount = tests "Amount" [ | |||||||
| 
 | 
 | ||||||
|      tests "costOfAmount" [ |      tests "costOfAmount" [ | ||||||
|        costOfAmount (eur 1) `is` eur 1 |        costOfAmount (eur 1) `is` eur 1 | ||||||
|       ,costOfAmount (eur 2){aprice=UnitPrice $ usd 2} `is` usd 4 |       ,costOfAmount (eur 2){aprice=Just $ UnitPrice $ usd 2} `is` usd 4 | ||||||
|       ,costOfAmount (eur 1){aprice=TotalPrice $ usd 2} `is` usd 2 |       ,costOfAmount (eur 1){aprice=Just $ TotalPrice $ usd 2} `is` usd 2 | ||||||
|       ,costOfAmount (eur (-1)){aprice=TotalPrice $ usd 2} `is` usd (-2) |       ,costOfAmount (eur (-1)){aprice=Just $ TotalPrice $ usd 2} `is` usd (-2) | ||||||
|     ] |     ] | ||||||
|    |    | ||||||
|     ,tests "isZeroAmount" [ |     ,tests "isZeroAmount" [ | ||||||
| @ -730,7 +730,7 @@ tests_Amount = tests "Amount" [ | |||||||
|    |    | ||||||
|     ,tests "negating amounts" [ |     ,tests "negating amounts" [ | ||||||
|        negate (usd 1) `is` (usd 1){aquantity= -1} |        negate (usd 1) `is` (usd 1){aquantity= -1} | ||||||
|       ,let b = (usd 1){aprice=UnitPrice $ eur 2} in negate b `is` b{aquantity= -1} |       ,let b = (usd 1){aprice=Just $ UnitPrice $ eur 2} in negate b `is` b{aquantity= -1} | ||||||
|     ] |     ] | ||||||
|    |    | ||||||
|     ,tests "adding amounts without prices" [ |     ,tests "adding amounts without prices" [ | ||||||
|  | |||||||
| @ -200,7 +200,7 @@ sumPostings = sumStrict . map pamount | |||||||
| -- | Remove all prices of a posting | -- | Remove all prices of a posting | ||||||
| removePrices :: Posting -> Posting | removePrices :: Posting -> Posting | ||||||
| removePrices p = p{ pamount = Mixed $ remove <$> amounts (pamount p) } | removePrices p = p{ pamount = Mixed $ remove <$> amounts (pamount p) } | ||||||
|   where remove a = a { aprice = NoPrice } |   where remove a = a { aprice = Nothing } | ||||||
| 
 | 
 | ||||||
| -- | Get a posting's (primary) date - it's own primary date if specified, | -- | Get a posting's (primary) date - it's own primary date if specified, | ||||||
| -- otherwise the parent transaction's primary date, or the null date if | -- otherwise the parent transaction's primary date, or the null date if | ||||||
|  | |||||||
| @ -493,12 +493,12 @@ priceInferrerFor t pt = inferprice | |||||||
|     pcommodities   = map acommodity pamounts |     pcommodities   = map acommodity pamounts | ||||||
|     sumamounts     = amounts $ sumStrict pmixedamounts -- sum normalises to one amount per commodity & price |     sumamounts     = amounts $ sumStrict pmixedamounts -- sum normalises to one amount per commodity & price | ||||||
|     sumcommodities = map acommodity sumamounts |     sumcommodities = map acommodity sumamounts | ||||||
|     sumprices      = filter (/=NoPrice) $ map aprice sumamounts |     sumprices      = filter (/=Nothing) $ map aprice sumamounts | ||||||
|     caninferprices = length sumcommodities == 2 && null sumprices |     caninferprices = length sumcommodities == 2 && null sumprices | ||||||
| 
 | 
 | ||||||
|     inferprice p@Posting{pamount=Mixed [a]} |     inferprice p@Posting{pamount=Mixed [a]} | ||||||
|       | caninferprices && ptype p == pt && acommodity a == fromcommodity |       | caninferprices && ptype p == pt && acommodity a == fromcommodity | ||||||
|         = p{pamount=Mixed [a{aprice=conversionprice}], poriginal=Just $ originalPosting p} |         = p{pamount=Mixed [a{aprice=Just conversionprice}], poriginal=Just $ originalPosting p} | ||||||
|       where |       where | ||||||
|         fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe |         fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe | ||||||
|         conversionprice |         conversionprice | ||||||
|  | |||||||
| @ -157,7 +157,7 @@ instance ToMarkup Quantity | |||||||
| -- | An amount's per-unit or total cost/selling price in another | -- | An amount's per-unit or total cost/selling price in another | ||||||
| -- commodity, as recorded in the journal entry eg with @ or @@. | -- commodity, as recorded in the journal entry eg with @ or @@. | ||||||
| -- Docs call this "transaction price". The amount is always positive. | -- Docs call this "transaction price". The amount is always positive. | ||||||
| data AmountPrice = NoPrice | UnitPrice Amount | TotalPrice Amount  | data AmountPrice = UnitPrice Amount | TotalPrice Amount  | ||||||
|   deriving (Eq,Ord,Typeable,Data,Generic,Show) |   deriving (Eq,Ord,Typeable,Data,Generic,Show) | ||||||
| 
 | 
 | ||||||
| instance NFData AmountPrice | instance NFData AmountPrice | ||||||
| @ -208,7 +208,7 @@ data Amount = Amount { | |||||||
|       aismultiplier :: Bool,            -- ^ kludge: a flag marking this amount and posting as a multiplier |       aismultiplier :: Bool,            -- ^ kludge: a flag marking this amount and posting as a multiplier | ||||||
|                                         --   in a TMPostingRule. In a regular Posting, should always be false. |                                         --   in a TMPostingRule. In a regular Posting, should always be false. | ||||||
|       astyle      :: AmountStyle, |       astyle      :: AmountStyle, | ||||||
|       aprice      :: AmountPrice            -- ^ the (fixed, transaction-specific) price for this amount, if any |       aprice      :: Maybe AmountPrice  -- ^ the (fixed, transaction-specific) price for this amount, if any | ||||||
|     } deriving (Eq,Ord,Typeable,Data,Generic,Show) |     } deriving (Eq,Ord,Typeable,Data,Generic,Show) | ||||||
| 
 | 
 | ||||||
| instance NFData Amount | instance NFData Amount | ||||||
|  | |||||||
| @ -606,8 +606,8 @@ amountp :: JournalParser m Amount | |||||||
| amountp = label "amount" $ do | amountp = label "amount" $ do | ||||||
|   amount <- amountwithoutpricep |   amount <- amountwithoutpricep | ||||||
|   lift $ skipMany spacenonewline |   lift $ skipMany spacenonewline | ||||||
|   price <- priceamountp |   mprice <- priceamountp | ||||||
|   pure $ amount { aprice = price } |   pure $ amount { aprice = mprice } | ||||||
| 
 | 
 | ||||||
| amountwithoutpricep :: JournalParser m Amount | amountwithoutpricep :: JournalParser m Amount | ||||||
| amountwithoutpricep = do | amountwithoutpricep = do | ||||||
| @ -629,7 +629,7 @@ amountwithoutpricep = do | |||||||
|     let numRegion = (offBeforeNum, offAfterNum) |     let numRegion = (offBeforeNum, offAfterNum) | ||||||
|     (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent |     (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent | ||||||
|     let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} |     let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} | ||||||
|     return $ nullamt{acommodity=c, aquantity=sign (sign2 q), aismultiplier=mult, astyle=s, aprice=NoPrice} |     return $ nullamt{acommodity=c, aquantity=sign (sign2 q), aismultiplier=mult, astyle=s, aprice=Nothing} | ||||||
| 
 | 
 | ||||||
|   rightornosymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount |   rightornosymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount | ||||||
|   rightornosymbolamountp mult sign = label "amount" $ do |   rightornosymbolamountp mult sign = label "amount" $ do | ||||||
| @ -645,7 +645,7 @@ amountwithoutpricep = do | |||||||
|         suggestedStyle <- getAmountStyle c |         suggestedStyle <- getAmountStyle c | ||||||
|         (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent |         (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent | ||||||
|         let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} |         let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} | ||||||
|         return $ nullamt{acommodity=c, aquantity=sign q, aismultiplier=mult, astyle=s, aprice=NoPrice} |         return $ nullamt{acommodity=c, aquantity=sign q, aismultiplier=mult, astyle=s, aprice=Nothing} | ||||||
|       -- no symbol amount |       -- no symbol amount | ||||||
|       Nothing -> do |       Nothing -> do | ||||||
|         suggestedStyle <- getDefaultAmountStyle |         suggestedStyle <- getDefaultAmountStyle | ||||||
| @ -656,7 +656,7 @@ amountwithoutpricep = do | |||||||
|         let (c,s) = case (mult, defcs) of |         let (c,s) = case (mult, defcs) of | ||||||
|               (False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) prec}) |               (False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) prec}) | ||||||
|               _ -> ("", amountstyle{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}) |               _ -> ("", amountstyle{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}) | ||||||
|         return $ nullamt{acommodity=c, aquantity=sign q, aismultiplier=mult, astyle=s, aprice=NoPrice} |         return $ nullamt{acommodity=c, aquantity=sign q, aismultiplier=mult, astyle=s, aprice=Nothing} | ||||||
| 
 | 
 | ||||||
|   -- For reducing code duplication. Doesn't parse anything. Has the type |   -- For reducing code duplication. Doesn't parse anything. Has the type | ||||||
|   -- of a parser only in order to throw parse errors (for convenience). |   -- of a parser only in order to throw parse errors (for convenience). | ||||||
| @ -714,15 +714,15 @@ quotedcommoditysymbolp = | |||||||
| simplecommoditysymbolp :: TextParser m CommoditySymbol | simplecommoditysymbolp :: TextParser m CommoditySymbol | ||||||
| simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar) | simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar) | ||||||
| 
 | 
 | ||||||
| priceamountp :: JournalParser m AmountPrice | priceamountp :: JournalParser m (Maybe AmountPrice) | ||||||
| priceamountp = option NoPrice $ do | priceamountp = option Nothing $ do | ||||||
|   char '@' |   char '@' | ||||||
|   priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice |   priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice | ||||||
| 
 | 
 | ||||||
|   lift (skipMany spacenonewline) |   lift (skipMany spacenonewline) | ||||||
|   priceAmount <- amountwithoutpricep <?> "unpriced amount (specifying a price)" |   priceAmount <- amountwithoutpricep <?> "unpriced amount (specifying a price)" | ||||||
| 
 | 
 | ||||||
|   pure $ priceConstructor priceAmount |   pure $ Just $ priceConstructor priceAmount | ||||||
| 
 | 
 | ||||||
| balanceassertionp :: JournalParser m BalanceAssertion | balanceassertionp :: JournalParser m BalanceAssertion | ||||||
| balanceassertionp = do | balanceassertionp = do | ||||||
| @ -1313,7 +1313,7 @@ tests_Common = tests "Common" [ | |||||||
|          acommodity="$" |          acommodity="$" | ||||||
|         ,aquantity=10 -- need to test internal precision with roundTo ? I think not  |         ,aquantity=10 -- need to test internal precision with roundTo ? I think not  | ||||||
|         ,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing} |         ,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing} | ||||||
|         ,aprice=UnitPrice $ |         ,aprice=Just $ UnitPrice $ | ||||||
|           amount{ |           amount{ | ||||||
|              acommodity="€" |              acommodity="€" | ||||||
|             ,aquantity=0.5 |             ,aquantity=0.5 | ||||||
| @ -1325,7 +1325,7 @@ tests_Common = tests "Common" [ | |||||||
|          acommodity="$" |          acommodity="$" | ||||||
|         ,aquantity=10  |         ,aquantity=10  | ||||||
|         ,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing} |         ,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing} | ||||||
|         ,aprice=TotalPrice $ |         ,aprice=Just $ TotalPrice $ | ||||||
|           amount{ |           amount{ | ||||||
|              acommodity="€" |              acommodity="€" | ||||||
|             ,aquantity=5 |             ,aquantity=5 | ||||||
|  | |||||||
| @ -406,7 +406,7 @@ tests_MultiBalanceReports = tests "MultiBalanceReports" [ | |||||||
|       (map showw aitems) `is` (map showw eitems) |       (map showw aitems) `is` (map showw eitems) | ||||||
|       ((\(_, b, _) -> showMixedAmountDebug b) atotal) `is` (showMixedAmountDebug etotal) -- we only check the sum of the totals |       ((\(_, b, _) -> showMixedAmountDebug b) atotal) `is` (showMixedAmountDebug etotal) -- we only check the sum of the totals | ||||||
|     usd0 = usd 0 |     usd0 = usd 0 | ||||||
|     amount0 = Amount {acommodity="$", aquantity=0, aprice=NoPrice, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False} |     amount0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False} | ||||||
|   in  |   in  | ||||||
|    tests "multiBalanceReport" [ |    tests "multiBalanceReport" [ | ||||||
|       test "null journal"  $ |       test "null journal"  $ | ||||||
|  | |||||||
| @ -109,7 +109,7 @@ asInit d reset ui@UIState{ | |||||||
|                         } |                         } | ||||||
|       where |       where | ||||||
|         Mixed amts = normaliseMixedAmountSquashPricesForDisplay $ stripPrices bal |         Mixed amts = normaliseMixedAmountSquashPricesForDisplay $ stripPrices bal | ||||||
|         stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice} |         stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing} | ||||||
|     displayitems = map displayitem items |     displayitems = map displayitem items | ||||||
|     -- blanks added for scrolling control, cf RegisterScreen  |     -- blanks added for scrolling control, cf RegisterScreen  | ||||||
|     blankitems = replicate 100 |     blankitems = replicate 100 | ||||||
|  | |||||||
| @ -45,7 +45,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do | |||||||
|       -- balance assertion amounts will be unpriced, cf #824 |       -- balance assertion amounts will be unpriced, cf #824 | ||||||
|       closingps = [posting{paccount=a |       closingps = [posting{paccount=a | ||||||
|                           ,pamount=mixed [setprec $ negate b] |                           ,pamount=mixed [setprec $ negate b] | ||||||
|                           ,pbalanceassertion=Just assertion{baamount=setprec b{aquantity=0, aprice=NoPrice}} |                           ,pbalanceassertion=Just assertion{baamount=setprec b{aquantity=0, aprice=Nothing}} | ||||||
|                           } |                           } | ||||||
|                   | (a,_,_,mb) <- acctbals |                   | (a,_,_,mb) <- acctbals | ||||||
|                   , b <- amounts $ normaliseMixedAmountSquashPricesForDisplay mb |                   , b <- amounts $ normaliseMixedAmountSquashPricesForDisplay mb | ||||||
| @ -54,7 +54,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do | |||||||
| 
 | 
 | ||||||
|       openingps = [posting{paccount=a |       openingps = [posting{paccount=a | ||||||
|                           ,pamount=mixed [setprec b] |                           ,pamount=mixed [setprec b] | ||||||
|                           ,pbalanceassertion=Just assertion{baamount=setprec b{aprice=NoPrice}} |                           ,pbalanceassertion=Just assertion{baamount=setprec b{aprice=Nothing}} | ||||||
|                           } |                           } | ||||||
|                   | (a,_,_,mb) <- acctbals |                   | (a,_,_,mb) <- acctbals | ||||||
|                   , b <- amounts $ normaliseMixedAmountSquashPricesForDisplay mb |                   , b <- amounts $ normaliseMixedAmountSquashPricesForDisplay mb | ||||||
|  | |||||||
| @ -56,22 +56,22 @@ divideAmount' n a = a' where | |||||||
| invertPrice :: Amount -> Amount | invertPrice :: Amount -> Amount | ||||||
| invertPrice a = | invertPrice a = | ||||||
|     case aprice a of |     case aprice a of | ||||||
|         NoPrice -> a |         Nothing -> a | ||||||
|         UnitPrice pa -> invertPrice |         Just (UnitPrice pa) -> invertPrice | ||||||
|             -- normalize to TotalPrice |             -- normalize to TotalPrice | ||||||
|             a { aprice = TotalPrice pa' } where |             a { aprice = Just $ TotalPrice pa' } where | ||||||
|                 pa' = ((1 / aquantity a) `divideAmount` pa) { aprice = NoPrice } |                 pa' = ((1 / aquantity a) `divideAmount` pa) { aprice = Nothing } | ||||||
|         TotalPrice pa -> |         Just (TotalPrice pa) -> | ||||||
|             a { aquantity = aquantity pa * signum (aquantity a), acommodity = acommodity pa, aprice = TotalPrice pa' } where |             a { aquantity = aquantity pa * signum (aquantity a), acommodity = acommodity pa, aprice = Just $ TotalPrice pa' } where | ||||||
|                 pa' = pa { aquantity = abs $ aquantity a, acommodity = acommodity a, aprice = NoPrice, astyle = astyle a } |                 pa' = pa { aquantity = abs $ aquantity a, acommodity = acommodity a, aprice = Nothing, astyle = astyle a } | ||||||
| 
 | 
 | ||||||
| amountCost :: Day -> Amount -> Maybe PriceDirective | amountCost :: Day -> Amount -> Maybe PriceDirective | ||||||
| amountCost d a = | amountCost d a = | ||||||
|     case aprice a of |     case aprice a of | ||||||
|         NoPrice -> Nothing |         Nothing -> Nothing | ||||||
|         UnitPrice pa -> Just |         Just (UnitPrice pa) -> Just | ||||||
|             PriceDirective { pddate = d, pdcommodity = acommodity a, pdamount = pa } |             PriceDirective { pddate = d, pdcommodity = acommodity a, pdamount = pa } | ||||||
|         TotalPrice pa -> Just |         Just (TotalPrice pa) -> Just | ||||||
|             PriceDirective { pddate = d, pdcommodity = acommodity a, pdamount = abs (aquantity a) `divideAmount'` pa } |             PriceDirective { pddate = d, pdcommodity = acommodity a, pdamount = abs (aquantity a) `divideAmount'` pa } | ||||||
| 
 | 
 | ||||||
| postingCosts :: Posting -> [PriceDirective] | postingCosts :: Posting -> [PriceDirective] | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user