lib: Move unifyMixedAmount to Hledger.Data.Amount, make it return Maybe Amount, export it.

This commit is contained in:
Stephen Morgan 2020-06-24 23:38:17 +10:00 committed by Simon Michael
parent e090e0f949
commit 015492553e
2 changed files with 28 additions and 29 deletions

View File

@ -100,6 +100,7 @@ module Hledger.Data.Amount (
mapMixedAmount, mapMixedAmount,
normaliseMixedAmountSquashPricesForDisplay, normaliseMixedAmountSquashPricesForDisplay,
normaliseMixedAmount, normaliseMixedAmount,
unifyMixedAmount,
mixedAmountStripPrices, mixedAmountStripPrices,
-- ** arithmetic -- ** arithmetic
mixedAmountCost, mixedAmountCost,
@ -131,6 +132,7 @@ module Hledger.Data.Amount (
tests_Amount tests_Amount
) where ) where
import Control.Monad (foldM)
import Data.Char (isDigit) import Data.Char (isDigit)
import Data.Decimal (roundTo, decimalPlaces, normalizeDecimal) import Data.Decimal (roundTo, decimalPlaces, normalizeDecimal)
import Data.Function (on) import Data.Function (on)
@ -537,6 +539,19 @@ normaliseHelper squashprices (Mixed as)
normaliseMixedAmountSquashPricesForDisplay :: MixedAmount -> MixedAmount normaliseMixedAmountSquashPricesForDisplay :: MixedAmount -> MixedAmount
normaliseMixedAmountSquashPricesForDisplay = normaliseHelper True normaliseMixedAmountSquashPricesForDisplay = normaliseHelper True
-- | Unify a MixedAmount to a single commodity value if possible.
-- Like normaliseMixedAmount, this consolidates amounts of the same commodity
-- and discards zero amounts; but this one insists on simplifying to
-- a single commodity, and will return Nothing if this is not possible.
unifyMixedAmount :: MixedAmount -> Maybe Amount
unifyMixedAmount = foldM combine 0 . amounts
where
combine amount result
| amountIsZero amount = Just result
| amountIsZero result = Just amount
| acommodity amount == acommodity result = Just $ amount + result
| otherwise = Nothing
-- | Sum same-commodity amounts in a lossy way, applying the first -- | Sum same-commodity amounts in a lossy way, applying the first
-- price to the result and discarding any other prices. Only used as a -- price to the result and discarding any other prices. Only used as a
-- rendering helper. -- rendering helper.

View File

@ -25,20 +25,21 @@ module Hledger.Reports.MultiBalanceReport (
) )
where where
import Data.List import Control.Monad (guard)
import Data.List (sortBy, transpose)
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe import Data.Maybe (fromMaybe, mapMaybe)
import Data.Ord import Data.Ord (comparing)
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>)) import Data.Semigroup ((<>))
#endif #endif
import Data.Time.Calendar import Data.Time.Calendar (Day, addDays, fromGregorian)
import Safe import Safe (headDef, headMay, lastMay)
import Text.Tabular as T import Text.Tabular as T
import Text.Tabular.AsciiWide import Text.Tabular.AsciiWide (render)
import Hledger.Data import Hledger.Data
import Hledger.Query import Hledger.Query
@ -511,32 +512,15 @@ subaccountTallies as = foldr incrementParent mempty allaccts
allaccts = expandAccountNames as allaccts = expandAccountNames as
incrementParent a = HM.insertWith (+) (parentAccountName a) 1 incrementParent a = HM.insertWith (+) (parentAccountName a) 1
-- | Helper to unify a MixedAmount to a single commodity value.
-- Like normaliseMixedAmount, this consolidates amounts of the same commodity
-- and discards zero amounts; but this one insists on simplifying to
-- a single commodity, and will throw a program-terminating error if
-- this is not possible.
unifyMixedAmount :: MixedAmount -> Amount
unifyMixedAmount mixedAmount = foldl combine (num 0) (amounts mixedAmount)
where
combine amount result =
if amountIsZero amount
then result
else if amountIsZero result
then amount
else if acommodity amount == acommodity result
then amount + result
else error' "Cannot calculate percentages for accounts with multiple commodities. (Hint: Try --cost, -V or similar flags.)"
-- | Helper to calculate the percentage from two mixed. Keeps the sign of the first argument. -- | Helper to calculate the percentage from two mixed. Keeps the sign of the first argument.
-- Uses unifyMixedAmount to unify each argument and then divides them. -- Uses unifyMixedAmount to unify each argument and then divides them.
perdivide :: MixedAmount -> MixedAmount -> MixedAmount perdivide :: MixedAmount -> MixedAmount -> MixedAmount
perdivide a b = perdivide a b = fromMaybe (error' errmsg) $ do
let a' = unifyMixedAmount a a' <- unifyMixedAmount a
b' = unifyMixedAmount b b' <- unifyMixedAmount b
in if amountIsZero a' || amountIsZero b' || acommodity a' == acommodity b' guard $ amountIsZero a' || amountIsZero b' || acommodity a' == acommodity b'
then mixed [per $ if aquantity b' == 0 then 0 else (aquantity a' / abs (aquantity b') * 100)] return $ mixed [per $ if aquantity b' == 0 then 0 else aquantity a' / abs (aquantity b') * 100]
else error' "Cannot calculate percentages if accounts have different commodities. (Hint: Try --cost, -V or similar flags.)" where errmsg = "Cannot calculate percentages if accounts have different commodities (Hint: Try --cost, -V or similar flags.)"
-- Local debug helper -- Local debug helper
-- add a prefix to this function's debug output -- add a prefix to this function's debug output