lib: Move unifyMixedAmount to Hledger.Data.Amount, make it return Maybe Amount, export it.
This commit is contained in:
parent
e090e0f949
commit
015492553e
@ -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.
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user