{-|
A simple 'Amount' is some quantity of money, shares, or anything else.
It has a (possibly null) 'CommoditySymbol' and a numeric quantity:

@
  $1
  £-50
  EUR 3.44
  GOOG 500
  1.5h
  90 apples
  0
@

It may also have an 'AmountCost', representing this amount's per-unit
or total cost in a different commodity. If present, this is rendered like
so:

@
  EUR 2 \@ $1.50  (unit cost)
  EUR 2 \@\@ $3   (total cost)
@

A 'MixedAmount' is zero or more simple amounts, so can represent multiple
commodities; this is the type most often used:

@
  0
  $50 + EUR 3
  16h + $13.55 + AAPL 500 + 6 oranges
@

A mixed amount is always \"normalised\", it has no more than one amount
in each commodity and cost. When calling 'amounts' it will have no zero
amounts, or just a single zero amount and no other amounts.

Limited arithmetic with simple and mixed amounts is supported, best used
with similar amounts since it mostly ignores costss and commodity exchange rates.

-}

{-# LANGUAGE CPP  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE NamedFieldPuns #-}

module Hledger.Data.Amount (
  -- * Commodity
  showCommoditySymbol,
  isNonsimpleCommodityChar,
  quoteCommoditySymbolIfNeeded,

  -- * Amount
  -- ** arithmetic
  nullamt,
  missingamt,
  num,
  usd,
  eur,
  gbp,
  per,
  hrs,
  at,
  (@@),
  amountWithCommodity,
  amountCost,
  amountIsZero,
  amountLooksZero,
  divideAmount,
  multiplyAmount,
  invertAmount,
  -- ** styles
  amountstyle,
  canonicaliseAmount,
  styleAmount,
  amountSetStyles,
  amountStyleSetRounding,
  amountStylesSetRounding,
  amountUnstyled,
  -- ** rendering
  AmountFormat(..),
  defaultFmt,
  fullZeroFmt,
  noCostFmt,
  oneLineFmt,
  oneLineNoCostFmt,
  machineFmt,
  showAmount,
  showAmountWith,
  showAmountB,
  showAmountCost,
  showAmountCostB,
  cshowAmount,
  showAmountWithZeroCommodity,
  showAmountDebug,
  showAmountWithoutCost,
  amountSetPrecision,
  amountSetPrecisionMin,
  amountSetPrecisionMax,
  withPrecision,
  amountSetFullPrecision,
  amountSetFullPrecisionUpTo,
  amountInternalPrecision,
  amountDisplayPrecision,
  defaultMaxPrecision,
  setAmountInternalPrecision,
  withInternalPrecision,
  setAmountDecimalPoint,
  withDecimalPoint,
  amountStripCost,

  -- * MixedAmount
  nullmixedamt,
  missingmixedamt,
  isMissingMixedAmount,
  mixed,
  mixedAmount,
  maAddAmount,
  maAddAmounts,
  amounts,
  amountsRaw,
  amountsPreservingZeros,
  maCommodities,
  filterMixedAmount,
  filterMixedAmountByCommodity,
  mapMixedAmount,
  unifyMixedAmount,
  mixedAmountStripCosts,
  -- ** arithmetic
  mixedAmountCost,
  maNegate,
  maPlus,
  maMinus,
  maSum,
  divideMixedAmount,
  multiplyMixedAmount,
  averageMixedAmounts,
  isNegativeAmount,
  isNegativeMixedAmount,
  mixedAmountIsZero,
  maIsZero,
  maIsNonZero,
  mixedAmountLooksZero,
  -- ** styles
  canonicaliseMixedAmount,
  styleMixedAmount,
  mixedAmountSetStyles,
  mixedAmountUnstyled,
  -- ** rendering
  showMixedAmount,
  showMixedAmountWith,
  showMixedAmountOneLine,
  showMixedAmountDebug,
  showMixedAmountWithoutCost,
  showMixedAmountOneLineWithoutCost,
  showMixedAmountElided,
  showMixedAmountWithZeroCommodity,
  showMixedAmountB,
  showMixedAmountLinesB,
  showMixedAmountLinesPartsB,
  wbToText,
  wbUnpack,
  mixedAmountSetPrecision,
  mixedAmountSetFullPrecision,
  mixedAmountSetFullPrecisionUpTo,
  mixedAmountSetPrecisionMin,
  mixedAmountSetPrecisionMax,

  -- * misc.
  tests_Amount
) where

import Prelude hiding (Applicative(..))
import Control.Applicative (Applicative(..))
import Control.Monad (foldM)
import Data.Char (isDigit)
import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
import Data.Default (Default(..))
import Data.Foldable (toList)
import Data.List (find, intercalate, intersperse, mapAccumL, partition)
#if !MIN_VERSION_base(4,20,0)
import Data.List (foldl')
#endif
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Data.Maybe (fromMaybe, isNothing)
import Data.Semigroup (Semigroup(..))
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TB
import Data.Word (Word8)
import Safe (headDef, lastDef, lastMay)
import System.Console.ANSI (Color(..),ColorIntensity(..))

import Test.Tasty (testGroup)
import Test.Tasty.HUnit ((@?=), assertBool, testCase)

import Hledger.Data.Types
import Hledger.Utils (colorB, numDigitsInt, numDigitsInteger)
import Hledger.Utils.Text (textQuoteIfNeeded)
import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack)
import Data.Functor ((<&>))
-- import Data.Function ((&))
-- import Hledger.Utils.Debug (dbg0)


-- A 'Commodity' is a symbol representing a currency or some other kind of
-- thing we are tracking, and some display preferences that tell how to
-- display 'Amount's of the commodity - is the symbol on the left or right,
-- are thousands separated by comma, significant decimal places and so on.

-- | Show space-containing commodity symbols quoted, as they are in a journal.
showCommoditySymbol :: T.Text -> T.Text
showCommoditySymbol :: CommoditySymbol -> CommoditySymbol
showCommoditySymbol = CommoditySymbol -> CommoditySymbol
textQuoteIfNeeded

-- characters that may not be used in a non-quoted commodity symbol
isNonsimpleCommodityChar :: Char -> Bool
isNonsimpleCommodityChar :: Char -> Bool
isNonsimpleCommodityChar = (Bool -> Bool -> Bool)
-> (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
forall a b c.
(a -> b -> c) -> (Char -> a) -> (Char -> b) -> Char -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) Char -> Bool
isDigit Char -> Bool
isOther
  where
    otherChars :: CommoditySymbol
otherChars = CommoditySymbol
"-+.@*;\t\n \"{}=" :: T.Text
    isOther :: Char -> Bool
isOther Char
c = (Char -> Bool) -> CommoditySymbol -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c) CommoditySymbol
otherChars

quoteCommoditySymbolIfNeeded :: T.Text -> T.Text
quoteCommoditySymbolIfNeeded :: CommoditySymbol -> CommoditySymbol
quoteCommoditySymbolIfNeeded CommoditySymbol
s
  | (Char -> Bool) -> CommoditySymbol -> Bool
T.any Char -> Bool
isNonsimpleCommodityChar CommoditySymbol
s = CommoditySymbol
"\"" CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol
s CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol
"\""
  | Bool
otherwise = CommoditySymbol
s

-- | Formatting options available when displaying Amounts and MixedAmounts.
-- Similar to "AmountStyle" but lower level, not attached to amounts or commodities, and can override it in some ways.
-- See also hledger manual > "Amount formatting, parseability", which speaks of human, hledger, and machine output.
data AmountFormat = AmountFormat
  { AmountFormat -> Bool
displayCommodity        :: Bool       -- ^ Whether to display commodity symbols.
  , AmountFormat -> Bool
displayZeroCommodity    :: Bool       -- ^ Whether to display commodity symbols for zero Amounts.
  , AmountFormat -> Maybe [CommoditySymbol]
displayCommodityOrder   :: Maybe [CommoditySymbol]
                                          -- ^ For a MixedAmount, an optional order in which to display the commodities.
                                          --   Also, causes 0s to be generated for any commodities which are not present
                                          --   (important for tabular reports).
  , AmountFormat -> Bool
displayDigitGroups      :: Bool       -- ^ Whether to display digit group marks (eg thousands separators)
  , AmountFormat -> Bool
displayForceDecimalMark :: Bool       -- ^ Whether to add a trailing decimal mark when there are no decimal digits 
                                          --   and there are digit group marks, to disambiguate
  , AmountFormat -> Bool
displayOneLine          :: Bool       -- ^ Whether to display on one line.
  , AmountFormat -> Maybe Int
displayMinWidth         :: Maybe Int  -- ^ Minimum width to pad to
  , AmountFormat -> Maybe Int
displayMaxWidth         :: Maybe Int  -- ^ Maximum width to clip to
  , AmountFormat -> Bool
displayCost             :: Bool       -- ^ Whether to display Amounts' costs.
  , AmountFormat -> Bool
displayColour           :: Bool       -- ^ Whether to ansi-colourise negative Amounts.
  , AmountFormat -> Bool
displayQuotes           :: Bool       -- ^ Whether to enclose complex symbols in quotes (normally true)
  } deriving (Int -> AmountFormat -> ShowS
[AmountFormat] -> ShowS
AmountFormat -> [Char]
(Int -> AmountFormat -> ShowS)
-> (AmountFormat -> [Char])
-> ([AmountFormat] -> ShowS)
-> Show AmountFormat
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AmountFormat -> ShowS
showsPrec :: Int -> AmountFormat -> ShowS
$cshow :: AmountFormat -> [Char]
show :: AmountFormat -> [Char]
$cshowList :: [AmountFormat] -> ShowS
showList :: [AmountFormat] -> ShowS
Show)

-- | By default, display amounts using @defaultFmt@ amount display options.
instance Default AmountFormat where def :: AmountFormat
def = AmountFormat
defaultFmt

-- | Display amounts without colour, and with various other defaults.
defaultFmt :: AmountFormat
defaultFmt :: AmountFormat
defaultFmt = AmountFormat {
    displayCommodity :: Bool
displayCommodity        = Bool
True
  , displayZeroCommodity :: Bool
displayZeroCommodity    = Bool
False
  , displayCommodityOrder :: Maybe [CommoditySymbol]
displayCommodityOrder   = Maybe [CommoditySymbol]
forall a. Maybe a
Nothing
  , displayDigitGroups :: Bool
displayDigitGroups      = Bool
True
  , displayForceDecimalMark :: Bool
displayForceDecimalMark = Bool
False
  , displayOneLine :: Bool
displayOneLine          = Bool
False
  , displayMinWidth :: Maybe Int
displayMinWidth         = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
  , displayMaxWidth :: Maybe Int
displayMaxWidth         = Maybe Int
forall a. Maybe a
Nothing
  , displayCost :: Bool
displayCost             = Bool
True
  , displayColour :: Bool
displayColour           = Bool
False
  , displayQuotes :: Bool
displayQuotes           = Bool
True
  }

-- | Like defaultFmt but show zero amounts with commodity symbol and styling, like non-zero amounts.
fullZeroFmt :: AmountFormat
fullZeroFmt :: AmountFormat
fullZeroFmt = AmountFormat
defaultFmt{displayZeroCommodity=True}

-- | Like defaultFmt but don't show costs.
noCostFmt :: AmountFormat
noCostFmt :: AmountFormat
noCostFmt = AmountFormat
defaultFmt{displayCost=False}

-- | Like defaultFmt but display all amounts on one line.
oneLineFmt :: AmountFormat
oneLineFmt :: AmountFormat
oneLineFmt = AmountFormat
defaultFmt{displayOneLine=True}

-- | Like noCostFmt but display all amounts on one line.
oneLineNoCostFmt :: AmountFormat
oneLineNoCostFmt :: AmountFormat
oneLineNoCostFmt = AmountFormat
noCostFmt{displayOneLine=True}

-- | A (slightly more) machine-readable amount format; like oneLineNoCostFmt but don't show digit group marks.
machineFmt :: AmountFormat
machineFmt :: AmountFormat
machineFmt = AmountFormat
oneLineNoCostFmt{displayDigitGroups=False}

-------------------------------------------------------------------------------
-- Amount arithmetic

instance Num Amount where
    abs :: Amount -> Amount
abs a :: Amount
a@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
q}    = Amount
a{aquantity=abs q}
    signum :: Amount -> Amount
signum a :: Amount
a@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
q} = Amount
a{aquantity=signum q}
    fromInteger :: Integer -> Amount
fromInteger Integer
i                = Amount
nullamt{aquantity=fromInteger i}
    negate :: Amount -> Amount
negate                       = (Quantity -> Quantity) -> Amount -> Amount
transformAmount Quantity -> Quantity
forall a. Num a => a -> a
negate
    + :: Amount -> Amount -> Amount
(+)                          = (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount
similarAmountsOp Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
(+)
    (-)                          = (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount
similarAmountsOp (-)
    * :: Amount -> Amount -> Amount
(*)                          = (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount
similarAmountsOp Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
(*)

-- | The empty simple amount - a zero with no commodity symbol or cost
-- and the default amount display style.
nullamt :: Amount
nullamt :: Amount
nullamt = Amount{acommodity :: CommoditySymbol
acommodity=CommoditySymbol
"", aquantity :: Quantity
aquantity=Quantity
0, acost :: Maybe AmountCost
acost=Maybe AmountCost
forall a. Maybe a
Nothing, astyle :: AmountStyle
astyle=AmountStyle
amountstyle}

-- | A special amount used as a marker, meaning
-- "no explicit amount provided here, infer it when needed".
-- It is nullamt with commodity symbol "AUTO".
missingamt :: Amount
missingamt :: Amount
missingamt = Amount
nullamt{acommodity="AUTO"}

-- Handy amount constructors for tests.
-- usd/eur/gbp round their argument to a whole number of pennies/cents.
-- XXX these are a bit clashy
num :: Quantity -> Amount
num Quantity
n = Amount
nullamt{acommodity="",  aquantity=n}
hrs :: Quantity -> Amount
hrs Quantity
n = Amount
nullamt{acommodity="h", aquantity=n,           astyle=amountstyle{asprecision=Precision 2, ascommodityside=R}}
usd :: Quantity -> Amount
usd Quantity
n = Amount
nullamt{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}}
eur :: Quantity -> Amount
eur Quantity
n = Amount
nullamt{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}}
gbp :: Quantity -> Amount
gbp Quantity
n = Amount
nullamt{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}}
per :: Quantity -> Amount
per Quantity
n = Amount
nullamt{acommodity="%", aquantity=n,           astyle=amountstyle{asprecision=Precision 1, ascommodityside=R, ascommodityspaced=True}}
Amount
amt at :: Amount -> Amount -> Amount
`at` Amount
costamt = Amount
amt{acost=Just $ UnitCost costamt}
Amount
amt @@ :: Amount -> Amount -> Amount
@@ Amount
costamt = Amount
amt{acost=Just $ TotalCost costamt}

-- | Apply a binary arithmetic operator to two amounts, which should
-- be in the same commodity if non-zero (warning, this is not checked).
-- A zero result keeps the commodity of the second amount.
-- The result's display style is that of the second amount, with
-- precision set to the highest of either amount.
-- Costs are ignored and discarded.
-- Remember: the caller is responsible for ensuring both amounts have the same commodity.
similarAmountsOp :: (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount
similarAmountsOp :: (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount
similarAmountsOp Quantity -> Quantity -> Quantity
op Amount{acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
_,  aquantity :: Amount -> Quantity
aquantity=Quantity
q1, astyle :: Amount -> AmountStyle
astyle=AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
p1}}
                    Amount{acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
c2, aquantity :: Amount -> Quantity
aquantity=Quantity
q2, astyle :: Amount -> AmountStyle
astyle=s2 :: AmountStyle
s2@AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
p2}} =
   -- trace ("a1:"++showAmountDebug a1) $ trace ("a2:"++showAmountDebug a2) $ traceWith (("= :"++).showAmountDebug)
   Amount
nullamt{acommodity=c2, aquantity=q1 `op` q2, astyle=s2{asprecision=max p1 p2}}
  --  c1==c2 || q1==0 || q2==0 =
  --  otherwise = error "tried to do simple arithmetic with amounts in different commodities"

-- | Convert an amount to the specified commodity, ignoring and discarding
-- any costs and assuming an exchange rate of 1.
amountWithCommodity :: CommoditySymbol -> Amount -> Amount
amountWithCommodity :: CommoditySymbol -> Amount -> Amount
amountWithCommodity CommoditySymbol
c Amount
a = Amount
a{acommodity=c, acost=Nothing}

-- | Convert a amount to its total cost in another commodity,
-- using its attached cost amount if it has one.  Notes:
--
-- - cost amounts must be MixedAmounts with exactly one component Amount
--   (or there will be a runtime error XXX)
--
-- - cost amounts should be positive in the Journal
--   (though this is currently not enforced)
--
amountCost :: Amount -> Amount
amountCost :: Amount -> Amount
amountCost a :: Amount
a@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
q, acost :: Amount -> Maybe AmountCost
acost=Maybe AmountCost
mp} =
    case Maybe AmountCost
mp of
      Maybe AmountCost
Nothing                                  -> Amount
a
      Just (UnitCost  p :: Amount
p@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
pq}) -> Amount
p{aquantity=pq * q}
      Just (TotalCost p :: Amount
p@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
pq}) -> Amount
p{aquantity=pq}

-- | Strip all costs from an Amount
amountStripCost :: Amount -> Amount
amountStripCost :: Amount -> Amount
amountStripCost Amount
a = Amount
a{acost=Nothing}

-- | Apply a function to an amount's quantity (and its total cost, if it has one).
transformAmount :: (Quantity -> Quantity) -> Amount -> Amount
transformAmount :: (Quantity -> Quantity) -> Amount -> Amount
transformAmount Quantity -> Quantity
f a :: Amount
a@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
q,acost :: Amount -> Maybe AmountCost
acost=Maybe AmountCost
p} = Amount
a{aquantity=f q, acost=f' <$> p}
  where
    f' :: AmountCost -> AmountCost
f' (TotalCost a1 :: Amount
a1@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
pq}) = Amount -> AmountCost
TotalCost Amount
a1{aquantity = f pq}
    f' AmountCost
p' = AmountCost
p'

-- | Divide an amount's quantity (and total cost, if any) by some number.
divideAmount :: Quantity -> Amount -> Amount
divideAmount :: Quantity -> Amount -> Amount
divideAmount Quantity
n = (Quantity -> Quantity) -> Amount -> Amount
transformAmount (Quantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/Quantity
n)

-- | Multiply an amount's quantity (and its total cost, if it has one) by a constant.
multiplyAmount :: Quantity -> Amount -> Amount
multiplyAmount :: Quantity -> Amount -> Amount
multiplyAmount Quantity
n = (Quantity -> Quantity) -> Amount -> Amount
transformAmount (Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
*Quantity
n)

-- | Invert an amount (replace its quantity q with 1/q).
-- (Its cost if any is not changed, currently.)
invertAmount :: Amount -> Amount
invertAmount :: Amount -> Amount
invertAmount a :: Amount
a@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
q} = Amount
a{aquantity=1/q}

-- | Is this amount negative ? The cost is ignored.
isNegativeAmount :: Amount -> Bool
isNegativeAmount :: Amount -> Bool
isNegativeAmount Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
q} = Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
0

-- | Round an Amount's Quantity (internally) to match its display precision. 
-- If that is unset or NaturalPrecision, this does nothing.
amountRoundedQuantity :: Amount -> Quantity
amountRoundedQuantity :: Amount -> Quantity
amountRoundedQuantity Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
q, astyle :: Amount -> AmountStyle
astyle=AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
mp}} = case AmountPrecision
mp of
    AmountPrecision
NaturalPrecision -> Quantity
q
    Precision Word8
p      -> Word8 -> Quantity -> Quantity
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
p Quantity
q

-- | Apply a test to both an Amount and its total cost, if it has one.
testAmountAndTotalCost :: (Amount -> Bool) -> Amount -> Bool
testAmountAndTotalCost :: (Amount -> Bool) -> Amount -> Bool
testAmountAndTotalCost Amount -> Bool
f Amount
amt = case Amount -> Maybe AmountCost
acost Amount
amt of
    Just (TotalCost Amount
cost) -> Amount -> Bool
f Amount
amt Bool -> Bool -> Bool
&& Amount -> Bool
f Amount
cost
    Maybe AmountCost
_                       -> Amount -> Bool
f Amount
amt

-- | Do this Amount and (and its total cost, if it has one) appear to be zero
-- when rendered with its display precision ?
-- The display precision should usually have a specific value here;
-- if unset, it will be treated like NaturalPrecision.
amountLooksZero :: Amount -> Bool
amountLooksZero :: Amount -> Bool
amountLooksZero = (Amount -> Bool) -> Amount -> Bool
testAmountAndTotalCost Amount -> Bool
looksZero
  where
    looksZero :: Amount -> Bool
looksZero Amount{aquantity :: Amount -> Quantity
aquantity=Decimal Word8
e Integer
q, astyle :: Amount -> AmountStyle
astyle=AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
p}} = case AmountPrecision
p of
        Precision Word8
d      -> if Word8
e Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
d then Integer -> Integer
forall a. Num a => a -> a
abs Integer
q Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
5Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
10Integer -> Word8 -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Word8
eWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
dWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
1) else Integer
q Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
        AmountPrecision
NaturalPrecision -> Integer
q Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0

-- | Is this Amount (and its total cost, if it has one) exactly zero, ignoring its display precision ?
amountIsZero :: Amount -> Bool
amountIsZero :: Amount -> Bool
amountIsZero = (Amount -> Bool) -> Amount -> Bool
testAmountAndTotalCost (\Amount{aquantity :: Amount -> Quantity
aquantity=Decimal Word8
_ Integer
q} -> Integer
q Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0)

-- | Does this amount's internal Decimal representation have the
-- maximum number of digits, suggesting that it probably is
-- representing an infinite decimal ?
amountHasMaxDigits :: Amount -> Bool
amountHasMaxDigits :: Amount -> Bool
amountHasMaxDigits = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
255) (Int -> Bool) -> (Amount -> Int) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
numDigitsInteger (Integer -> Int) -> (Amount -> Integer) -> Amount -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity -> Integer
forall i. DecimalRaw i -> i
decimalMantissa (Quantity -> Integer) -> (Amount -> Quantity) -> Amount -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Quantity
aquantity
-- XXX this seems not always right. Eg:
-- ghci> let n = 100 / (3.0 :: Decimal)
-- decimalPlaces n
-- 255
-- numDigitsInteger $ decimalMantissa n
-- 257


-- | Set an amount's display precision, flipped.
withPrecision :: Amount -> AmountPrecision -> Amount
withPrecision :: Amount -> AmountPrecision -> Amount
withPrecision = (AmountPrecision -> Amount -> Amount)
-> Amount -> AmountPrecision -> Amount
forall a b c. (a -> b -> c) -> b -> a -> c
flip AmountPrecision -> Amount -> Amount
amountSetPrecision

-- | Set an amount's display precision.
amountSetPrecision :: AmountPrecision -> Amount -> Amount
amountSetPrecision :: AmountPrecision -> Amount -> Amount
amountSetPrecision AmountPrecision
p a :: Amount
a@Amount{astyle :: Amount -> AmountStyle
astyle=AmountStyle
s} = Amount
a{astyle=s{asprecision=p}}

-- | Ensure an amount's display precision is at least the given minimum precision.
-- Always sets an explicit Precision.
amountSetPrecisionMin :: Word8 -> Amount -> Amount
amountSetPrecisionMin :: Word8 -> Amount -> Amount
amountSetPrecisionMin Word8
minp Amount
a = AmountPrecision -> Amount -> Amount
amountSetPrecision AmountPrecision
p Amount
a
  where p :: AmountPrecision
p = Word8 -> AmountPrecision
Precision (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max Word8
minp (Amount -> Word8
amountDisplayPrecision Amount
a)

-- | Ensure an amount's display precision is at most the given maximum precision.
-- Always sets an explicit Precision.
amountSetPrecisionMax :: Word8 -> Amount -> Amount
amountSetPrecisionMax :: Word8 -> Amount -> Amount
amountSetPrecisionMax Word8
maxp Amount
a = AmountPrecision -> Amount -> Amount
amountSetPrecision AmountPrecision
p Amount
a
  where p :: AmountPrecision
p = Word8 -> AmountPrecision
Precision (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
min Word8
maxp (Amount -> Word8
amountDisplayPrecision Amount
a)

-- | Increase an amount's display precision, if needed, to enough decimal places
-- to show it exactly (showing all significant decimal digits, without trailing zeros).
-- If the amount's display precision is unset, it will be treated as precision 0.
amountSetFullPrecision :: Amount -> Amount
amountSetFullPrecision :: Amount -> Amount
amountSetFullPrecision Amount
a = AmountPrecision -> Amount -> Amount
amountSetPrecision AmountPrecision
p Amount
a
  where
    p :: AmountPrecision
p                = AmountPrecision -> AmountPrecision -> AmountPrecision
forall a. Ord a => a -> a -> a
max AmountPrecision
displayprecision AmountPrecision
naturalprecision
    displayprecision :: AmountPrecision
displayprecision = AmountStyle -> AmountPrecision
asprecision (AmountStyle -> AmountPrecision) -> AmountStyle -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
a
    naturalprecision :: AmountPrecision
naturalprecision = Word8 -> AmountPrecision
Precision (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> Word8
amountInternalPrecision Amount
a
-- XXX Is that last sentence correct ?
-- max (Precision n) NaturalPrecision is NaturalPrecision.
-- Would this work instead ?
-- amountSetFullPrecision a = amountSetPrecision (Precision p) a
--   where p = max (amountDisplayPrecision a) (amountInternalPrecision a)


-- | We often want to display "infinite decimal" amounts rounded to some readable
-- number of digits, while still displaying amounts with a large but "non infinite"
-- number of decimal digits (eg 10 or 100 or 200 digits) in full.
-- This helper is like amountSetFullPrecision, but with some refinements:
--
-- 1. A maximum display precision can be specified, setting a hard upper limit.
--
-- 2. If no limit is specified, and the internal precision is the maximum (255),
-- indicating an infinite decimal, display precision is set to a smaller default (8).
--
-- This function always sets an explicit display precision (ie, Precision n).
--
amountSetFullPrecisionUpTo :: Maybe Word8 -> Amount -> Amount
amountSetFullPrecisionUpTo :: Maybe Word8 -> Amount -> Amount
amountSetFullPrecisionUpTo Maybe Word8
mmaxp Amount
a = AmountPrecision -> Amount -> Amount
amountSetPrecision (Word8 -> AmountPrecision
Precision Word8
p) Amount
a
  where
    p :: Word8
p = case Maybe Word8
mmaxp of
      Just Word8
maxp -> Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
min Word8
maxp (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max Word8
disp Word8
intp
      Maybe Word8
Nothing   -> if Amount -> Bool
amountHasMaxDigits Amount
a then Word8
defaultMaxPrecision else Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max Word8
disp Word8
intp
      where
        disp :: Word8
disp = Amount -> Word8
amountDisplayPrecision Amount
a
        intp :: Word8
intp = Amount -> Word8
amountInternalPrecision Amount
a

-- | The fallback display precision used when showing amounts
-- representing an infinite decimal.
defaultMaxPrecision :: Word8
defaultMaxPrecision :: Word8
defaultMaxPrecision = Word8
8

-- | How many internal decimal digits are stored for this amount ?
amountInternalPrecision :: Amount -> Word8
amountInternalPrecision :: Amount -> Word8
amountInternalPrecision = Quantity -> Word8
forall i. DecimalRaw i -> Word8
decimalPlaces (Quantity -> Word8) -> (Amount -> Quantity) -> Amount -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity -> Quantity
forall i. Integral i => DecimalRaw i -> DecimalRaw i
normalizeDecimal (Quantity -> Quantity)
-> (Amount -> Quantity) -> Amount -> Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Quantity
aquantity

-- | How many decimal digits will be displayed for this amount ?
amountDisplayPrecision :: Amount -> Word8
amountDisplayPrecision :: Amount -> Word8
amountDisplayPrecision Amount
a =
  case AmountStyle -> AmountPrecision
asprecision (AmountStyle -> AmountPrecision) -> AmountStyle -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
a of
    Precision Word8
n      -> Word8
n
    AmountPrecision
NaturalPrecision -> Amount -> Word8
amountInternalPrecision Amount
a

-- | Set an amount's internal decimal precision as well as its display precision.
-- This rounds or pads its Decimal quantity to the specified number of decimal places.
-- Rounding is done with Data.Decimal's default roundTo function:
-- "If the value ends in 5 then it is rounded to the nearest even value (Banker's Rounding)".
setAmountInternalPrecision :: Word8 -> Amount -> Amount
setAmountInternalPrecision :: Word8 -> Amount -> Amount
setAmountInternalPrecision Word8
p a :: Amount
a@Amount{ aquantity :: Amount -> Quantity
aquantity=Quantity
q, astyle :: Amount -> AmountStyle
astyle=AmountStyle
s } = Amount
a{
   aquantity=roundTo p q
  ,astyle=s{asprecision=Precision p}
  }

-- | setAmountInternalPrecision with arguments flipped.
withInternalPrecision :: Amount -> Word8 -> Amount
withInternalPrecision :: Amount -> Word8 -> Amount
withInternalPrecision = (Word8 -> Amount -> Amount) -> Amount -> Word8 -> Amount
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> Amount -> Amount
setAmountInternalPrecision

-- Amount display styles

-- v1
{-# DEPRECATED canonicaliseAmount "please use styleAmounts instead" #-}
canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
canonicaliseAmount :: Map CommoditySymbol AmountStyle -> Amount -> Amount
canonicaliseAmount = Map CommoditySymbol AmountStyle -> Amount -> Amount
forall a. HasAmounts a => Map CommoditySymbol AmountStyle -> a -> a
styleAmounts

-- v2
{-# DEPRECATED styleAmount "please use styleAmounts instead" #-}
styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmount :: Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmount = Map CommoditySymbol AmountStyle -> Amount -> Amount
forall a. HasAmounts a => Map CommoditySymbol AmountStyle -> a -> a
styleAmounts

-- v3
{-# DEPRECATED amountSetStyles "please use styleAmounts instead" #-}
amountSetStyles :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
amountSetStyles :: Map CommoditySymbol AmountStyle -> Amount -> Amount
amountSetStyles = Map CommoditySymbol AmountStyle -> Amount -> Amount
forall a. HasAmounts a => Map CommoditySymbol AmountStyle -> a -> a
styleAmounts

-- v4
instance HasAmounts Amount where
  -- | Given some commodity display styles, find and apply the appropriate one to this amount,
  -- and its cost amount if any (and stop; we assume costs don't have costs).
  -- Display precision will be applied (or not) as specified by the style's rounding strategy,
  -- except that costs' precision is never changed (costs are often recorded inexactly,
  -- so we don't want to imply greater precision than they were recorded with).
  -- If no style is found for an amount, it is left unchanged.
  styleAmounts :: Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmounts Map CommoditySymbol AmountStyle
styles a :: Amount
a@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
qty, acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
comm, astyle :: Amount -> AmountStyle
astyle=AmountStyle
oldstyle, acost :: Amount -> Maybe AmountCost
acost=Maybe AmountCost
mcost0} =
    Amount
a{astyle=newstyle, acost=mcost1}
    where
      newstyle :: AmountStyle
newstyle = Bool -> Quantity -> AmountStyle -> CommoditySymbol -> AmountStyle
mknewstyle Bool
False Quantity
qty AmountStyle
oldstyle CommoditySymbol
comm 

      mcost1 :: Maybe AmountCost
mcost1 = case Maybe AmountCost
mcost0 of
        Maybe AmountCost
Nothing -> Maybe AmountCost
forall a. Maybe a
Nothing
        Just (UnitCost  ca :: Amount
ca@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
cq, astyle :: Amount -> AmountStyle
astyle=AmountStyle
cs, acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
ccomm}) -> AmountCost -> Maybe AmountCost
forall a. a -> Maybe a
Just (AmountCost -> Maybe AmountCost) -> AmountCost -> Maybe AmountCost
forall a b. (a -> b) -> a -> b
$ Amount -> AmountCost
UnitCost  Amount
ca{astyle=mknewstyle True cq cs ccomm}
        Just (TotalCost ca :: Amount
ca@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
cq, astyle :: Amount -> AmountStyle
astyle=AmountStyle
cs, acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
ccomm}) -> AmountCost -> Maybe AmountCost
forall a. a -> Maybe a
Just (AmountCost -> Maybe AmountCost) -> AmountCost -> Maybe AmountCost
forall a b. (a -> b) -> a -> b
$ Amount -> AmountCost
TotalCost Amount
ca{astyle=mknewstyle True cq cs ccomm}

      mknewstyle :: Bool -> Quantity -> AmountStyle -> CommoditySymbol -> AmountStyle
      mknewstyle :: Bool -> Quantity -> AmountStyle -> CommoditySymbol -> AmountStyle
mknewstyle Bool
iscost Quantity
oldq AmountStyle
olds CommoditySymbol
com =
        case CommoditySymbol
-> Map CommoditySymbol AmountStyle -> Maybe AmountStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup CommoditySymbol
com Map CommoditySymbol AmountStyle
styles of
          Just AmountStyle
s  -> 
            -- dbg0 "new      style" $ 
            Bool -> Quantity -> AmountStyle -> AmountStyle -> AmountStyle
amountStyleApplyWithRounding Bool
iscost Quantity
oldq 
              (
                -- dbg0 "applying style"
                AmountStyle
s)
              (
                -- dbg0 "old      style"
                AmountStyle
olds)
          Maybe AmountStyle
Nothing -> AmountStyle
olds

-- AmountStyle helpers

-- | Replace one AmountStyle with another, but don't just replace the display precision;
-- update that in one of several ways as selected by the new style's "rounding strategy":
--
-- NoRounding - keep the precision unchanged
--
-- SoftRounding -
--
--  if either precision is NaturalPrecision, use NaturalPrecision;
--
--  if the new precision is greater than the old, use the new (adds decimal zeros);
--
--  if the new precision is less than the old, use as close to the new as we can get
--    without dropping (more) non-zero digits (drops decimal zeros).
--
--  for a cost amount, keep the precision unchanged
--
-- HardRounding -
--
--  for a posting amount, use the new precision (may truncate significant digits);
--
--  for a cost amount, keep the precision unchanged
--
-- AllRounding -
--
--  for both posting and cost amounts, do hard rounding.
--
-- Arguments:
--
--  whether this style is for a posting amount or a cost amount,
--
--  the amount's decimal quantity (for inspecting its internal representation), 
--
--  the new style, 
--
--  the old style.
--
amountStyleApplyWithRounding :: Bool -> Quantity -> AmountStyle -> AmountStyle -> AmountStyle
amountStyleApplyWithRounding :: Bool -> Quantity -> AmountStyle -> AmountStyle -> AmountStyle
amountStyleApplyWithRounding Bool
iscost Quantity
q news :: AmountStyle
news@AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
newp, asrounding :: AmountStyle -> Rounding
asrounding=Rounding
newr} AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
oldp} =
  case Rounding
newr of
    Rounding
NoRounding   -> AmountStyle
news{asprecision=oldp}
    Rounding
SoftRounding -> AmountStyle
news{asprecision=if iscost then oldp else newp'}
      where
        newp' :: AmountPrecision
newp' = case (AmountPrecision
newp, AmountPrecision
oldp) of
          (Precision Word8
new, Precision Word8
old) ->
            if Word8
new Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
old
            then Word8 -> AmountPrecision
Precision Word8
new
            else Word8 -> AmountPrecision
Precision (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max (Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
min Word8
old Word8
internal) Word8
new
              where internal :: Word8
internal = Quantity -> Word8
forall i. DecimalRaw i -> Word8
decimalPlaces (Quantity -> Word8) -> Quantity -> Word8
forall a b. (a -> b) -> a -> b
$ Quantity -> Quantity
forall i. Integral i => DecimalRaw i -> DecimalRaw i
normalizeDecimal Quantity
q
          (AmountPrecision, AmountPrecision)
_ -> AmountPrecision
NaturalPrecision
    Rounding
HardRounding -> AmountStyle
news{asprecision=if iscost then oldp else newp}
    Rounding
AllRounding  -> AmountStyle
news

-- | Set this amount style's rounding strategy when it is being applied to amounts.
amountStyleSetRounding :: Rounding -> AmountStyle -> AmountStyle
amountStyleSetRounding :: Rounding -> AmountStyle -> AmountStyle
amountStyleSetRounding Rounding
r AmountStyle
as = AmountStyle
as{asrounding=r}

-- | Set these amount styles' rounding strategy when they are being applied to amounts.
amountStylesSetRounding :: Rounding -> M.Map CommoditySymbol AmountStyle -> M.Map CommoditySymbol AmountStyle
amountStylesSetRounding :: Rounding
-> Map CommoditySymbol AmountStyle
-> Map CommoditySymbol AmountStyle
amountStylesSetRounding Rounding
r = (AmountStyle -> AmountStyle)
-> Map CommoditySymbol AmountStyle
-> Map CommoditySymbol AmountStyle
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Rounding -> AmountStyle -> AmountStyle
amountStyleSetRounding Rounding
r)

-- | Default amount style
amountstyle :: AmountStyle
amountstyle = Side
-> Bool
-> Maybe DigitGroupStyle
-> Maybe Char
-> AmountPrecision
-> Rounding
-> AmountStyle
AmountStyle Side
L Bool
False Maybe DigitGroupStyle
forall a. Maybe a
Nothing (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') (Word8 -> AmountPrecision
Precision Word8
0) Rounding
NoRounding

-- | Reset this amount's display style to the default.
amountUnstyled :: Amount -> Amount
amountUnstyled :: Amount -> Amount
amountUnstyled Amount
a = Amount
a{astyle=amountstyle}

-- | Set (or clear) an amount's display decimal point.
setAmountDecimalPoint :: Maybe Char -> Amount -> Amount
setAmountDecimalPoint :: Maybe Char -> Amount -> Amount
setAmountDecimalPoint Maybe Char
mc a :: Amount
a@Amount{ astyle :: Amount -> AmountStyle
astyle=AmountStyle
s } = Amount
a{ astyle=s{asdecimalmark=mc} }

-- | Set (or clear) an amount's display decimal point, flipped.
withDecimalPoint :: Amount -> Maybe Char -> Amount
withDecimalPoint :: Amount -> Maybe Char -> Amount
withDecimalPoint = (Maybe Char -> Amount -> Amount) -> Amount -> Maybe Char -> Amount
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe Char -> Amount -> Amount
setAmountDecimalPoint

-- Amount rendering

-- | Render an amount using its display style and the default amount format.
-- Zero-equivalent amounts  are shown as just \"0\".
-- The special "missing" amount is shown as the empty string.
showAmount :: Amount -> String
showAmount :: Amount -> [Char]
showAmount = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (Amount -> WideBuilder) -> Amount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> Amount -> WideBuilder
showAmountB AmountFormat
defaultFmt

-- | Like showAmount but uses the given amount format.
showAmountWith :: AmountFormat -> Amount -> String
showAmountWith :: AmountFormat -> Amount -> [Char]
showAmountWith AmountFormat
fmt = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (Amount -> WideBuilder) -> Amount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> Amount -> WideBuilder
showAmountB AmountFormat
fmt

-- | Render an amount using its display style and the given amount format, as a builder for efficiency.
-- (This can be converted to a Text with wbToText or to a String with wbUnpack).
-- The special "missing" amount is displayed as the empty string. 
showAmountB :: AmountFormat -> Amount -> WideBuilder
showAmountB :: AmountFormat -> Amount -> WideBuilder
showAmountB AmountFormat
_ Amount{acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
"AUTO"} = WideBuilder
forall a. Monoid a => a
mempty
showAmountB
  afmt :: AmountFormat
afmt@AmountFormat{Bool
displayCommodity :: AmountFormat -> Bool
displayCommodity :: Bool
displayCommodity, Bool
displayZeroCommodity :: AmountFormat -> Bool
displayZeroCommodity :: Bool
displayZeroCommodity, Bool
displayDigitGroups :: AmountFormat -> Bool
displayDigitGroups :: Bool
displayDigitGroups
                   ,Bool
displayForceDecimalMark :: AmountFormat -> Bool
displayForceDecimalMark :: Bool
displayForceDecimalMark, Bool
displayCost :: AmountFormat -> Bool
displayCost :: Bool
displayCost, Bool
displayColour :: AmountFormat -> Bool
displayColour :: Bool
displayColour, Bool
displayQuotes :: AmountFormat -> Bool
displayQuotes :: Bool
displayQuotes}
  a :: Amount
a@Amount{astyle :: Amount -> AmountStyle
astyle=AmountStyle
style} =
    WideBuilder -> WideBuilder
color (WideBuilder -> WideBuilder) -> WideBuilder -> WideBuilder
forall a b. (a -> b) -> a -> b
$ case AmountStyle -> Side
ascommodityside AmountStyle
style of
      Side
L -> (if Bool
displayCommodity then CommoditySymbol -> WideBuilder
wbFromText CommoditySymbol
comm WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
space else WideBuilder
forall a. Monoid a => a
mempty) WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
quantity' WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
cost
      Side
R -> WideBuilder
quantity' WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> (if Bool
displayCommodity then WideBuilder
space WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol -> WideBuilder
wbFromText CommoditySymbol
comm else WideBuilder
forall a. Monoid a => a
mempty) WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
cost
  where
    color :: WideBuilder -> WideBuilder
color = if Bool
displayColour Bool -> Bool -> Bool
&& Amount -> Bool
isNegativeAmount Amount
a then ColorIntensity -> Color -> WideBuilder -> WideBuilder
colorB ColorIntensity
Dull Color
Red else WideBuilder -> WideBuilder
forall a. a -> a
id
    quantity :: WideBuilder
quantity = Bool -> Amount -> WideBuilder
showAmountQuantity Bool
displayForceDecimalMark (Amount -> WideBuilder) -> Amount -> WideBuilder
forall a b. (a -> b) -> a -> b
$
      if Bool
displayDigitGroups then Amount
a else Amount
a{astyle=(astyle a){asdigitgroups=Nothing}}
    (WideBuilder
quantity', CommoditySymbol
comm)
      | Amount -> Bool
amountLooksZero Amount
a Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
displayZeroCommodity = (Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
'0') Int
1, CommoditySymbol
"")
      | Bool
otherwise = (WideBuilder
quantity, (if Bool
displayQuotes then CommoditySymbol -> CommoditySymbol
quoteCommoditySymbolIfNeeded else CommoditySymbol -> CommoditySymbol
forall a. a -> a
id) (CommoditySymbol -> CommoditySymbol)
-> CommoditySymbol -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Amount -> CommoditySymbol
acommodity Amount
a)
    space :: WideBuilder
space = if Bool -> Bool
not (CommoditySymbol -> Bool
T.null CommoditySymbol
comm) Bool -> Bool -> Bool
&& AmountStyle -> Bool
ascommodityspaced AmountStyle
style then Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
' ') Int
1 else WideBuilder
forall a. Monoid a => a
mempty
    cost :: WideBuilder
cost = if Bool
displayCost then AmountFormat -> Amount -> WideBuilder
showAmountCostB AmountFormat
afmt Amount
a else WideBuilder
forall a. Monoid a => a
mempty

-- Show an amount's cost as @ UNITCOST or @@ TOTALCOST, plus a leading space, or "" if there's no cost.
showAmountCost :: Amount -> String
showAmountCost :: Amount -> [Char]
showAmountCost = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (Amount -> WideBuilder) -> Amount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> Amount -> WideBuilder
showAmountCostB AmountFormat
defaultFmt

-- showAmountCost, efficient builder version.
showAmountCostB :: AmountFormat -> Amount -> WideBuilder
showAmountCostB :: AmountFormat -> Amount -> WideBuilder
showAmountCostB AmountFormat
afmt Amount
amt = case Amount -> Maybe AmountCost
acost Amount
amt of
  Maybe AmountCost
Nothing             -> WideBuilder
forall a. Monoid a => a
mempty
  Just (UnitCost  Amount
pa) -> Builder -> Int -> WideBuilder
WideBuilder ([Char] -> Builder
TB.fromString [Char]
" @ ")  Int
3 WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> AmountFormat -> Amount -> WideBuilder
showAmountB AmountFormat
afmt Amount
pa
  Just (TotalCost Amount
pa) -> Builder -> Int -> WideBuilder
WideBuilder ([Char] -> Builder
TB.fromString [Char]
" @@ ") Int
4 WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> AmountFormat -> Amount -> WideBuilder
showAmountB AmountFormat
afmt (Amount -> Amount
sign Amount
pa)
  where sign :: Amount -> Amount
sign = if Amount -> Quantity
aquantity Amount
amt Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
0 then Amount -> Amount
forall a. Num a => a -> a
negate else Amount -> Amount
forall a. a -> a
id

showAmountCostDebug :: Maybe AmountCost -> String
showAmountCostDebug :: Maybe AmountCost -> [Char]
showAmountCostDebug Maybe AmountCost
Nothing                = [Char]
""
showAmountCostDebug (Just (UnitCost Amount
pa))  = [Char]
"@ "  [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Amount -> [Char]
showAmountDebug Amount
pa
showAmountCostDebug (Just (TotalCost Amount
pa)) = [Char]
"@@ " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Amount -> [Char]
showAmountDebug Amount
pa

-- | Colour version. For a negative amount, adds ANSI codes to change the colour,
-- currently to hard-coded red.
--
-- > cshowAmount = wbUnpack . showAmountB def{displayColour=True}
cshowAmount :: Amount -> String
cshowAmount :: Amount -> [Char]
cshowAmount = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (Amount -> WideBuilder) -> Amount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> Amount -> WideBuilder
showAmountB AmountFormat
forall a. Default a => a
def{displayColour=True}

-- | Get the string representation of an amount, without any \@ cost.
--
-- > showAmountWithoutCost = wbUnpack . showAmountB noCostFmt
showAmountWithoutCost :: Amount -> String
showAmountWithoutCost :: Amount -> [Char]
showAmountWithoutCost = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (Amount -> WideBuilder) -> Amount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> Amount -> WideBuilder
showAmountB AmountFormat
noCostFmt

-- | Like showAmount, but show a zero amount's commodity if it has one.
--
-- > showAmountWithZeroCommodity = wbUnpack . showAmountB defaultFmt{displayZeryCommodity=True}
showAmountWithZeroCommodity :: Amount -> String
showAmountWithZeroCommodity :: Amount -> [Char]
showAmountWithZeroCommodity = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (Amount -> WideBuilder) -> Amount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> Amount -> WideBuilder
showAmountB AmountFormat
defaultFmt{displayZeroCommodity=True}

-- | Get a string representation of an amount for debugging,
-- appropriate to the current debug level. 9 shows maximum detail.
showAmountDebug :: Amount -> String
showAmountDebug :: Amount -> [Char]
showAmountDebug Amount{acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
"AUTO"} = [Char]
"(missing)"
showAmountDebug Amount{Maybe AmountCost
Quantity
CommoditySymbol
AmountStyle
aquantity :: Amount -> Quantity
acommodity :: Amount -> CommoditySymbol
acost :: Amount -> Maybe AmountCost
astyle :: Amount -> AmountStyle
acommodity :: CommoditySymbol
aquantity :: Quantity
astyle :: AmountStyle
acost :: Maybe AmountCost
..} =
      [Char]
"Amount {acommodity=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CommoditySymbol -> [Char]
forall a. Show a => a -> [Char]
show CommoditySymbol
acommodity [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", aquantity=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Quantity -> [Char]
forall a. Show a => a -> [Char]
show Quantity
aquantity
   [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", acost=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe AmountCost -> [Char]
showAmountCostDebug Maybe AmountCost
acost [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", astyle=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ AmountStyle -> [Char]
forall a. Show a => a -> [Char]
show AmountStyle
astyle [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"}"

-- | Get a Text Builder for the string representation of the number part of of an amount,
-- using the display settings from its commodity. Also returns the width of the number.
-- With a true first argument, if there are no decimal digits but there are digit group separators,
-- it shows the amount with a trailing decimal mark to help disambiguate it for parsing.
showAmountQuantity :: Bool -> Amount -> WideBuilder
showAmountQuantity :: Bool -> Amount -> WideBuilder
showAmountQuantity Bool
disambiguate amt :: Amount
amt@Amount{astyle :: Amount -> AmountStyle
astyle=AmountStyle{asdecimalmark :: AmountStyle -> Maybe Char
asdecimalmark=Maybe Char
mdec, asdigitgroups :: AmountStyle -> Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps}} =
    WideBuilder
signB WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
intB WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
fracB
  where
    Decimal Word8
decplaces Integer
mantissa = Amount -> Quantity
amountRoundedQuantity Amount
amt
    numtxt :: CommoditySymbol
numtxt = [Char] -> CommoditySymbol
T.pack ([Char] -> CommoditySymbol)
-> (Integer -> [Char]) -> Integer -> CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> CommoditySymbol) -> Integer -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs Integer
mantissa
    numlen :: Int
numlen = CommoditySymbol -> Int
T.length CommoditySymbol
numtxt
    intLen :: Int
intLen = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
numlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
decplaces
    dec :: Char
dec = Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
'.' Maybe Char
mdec
    numtxtwithzero :: CommoditySymbol
numtxtwithzero = Int -> CommoditySymbol -> CommoditySymbol
T.replicate (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
decplaces Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numlen) CommoditySymbol
"0" CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol
numtxt
    (CommoditySymbol
intPart, CommoditySymbol
fracPart) = Int -> CommoditySymbol -> (CommoditySymbol, CommoditySymbol)
T.splitAt Int
intLen CommoditySymbol
numtxtwithzero
    intB :: WideBuilder
intB = Maybe DigitGroupStyle -> Int -> CommoditySymbol -> WideBuilder
applyDigitGroupStyle Maybe DigitGroupStyle
mgrps Int
intLen (CommoditySymbol -> WideBuilder) -> CommoditySymbol -> WideBuilder
forall a b. (a -> b) -> a -> b
$ if Word8
decplaces Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then CommoditySymbol
numtxt else CommoditySymbol
intPart
    signB :: WideBuilder
signB = if Integer
mantissa Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
'-') Int
1 else WideBuilder
forall a. Monoid a => a
mempty
    fracB :: WideBuilder
fracB = if Word8
decplaces Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0 Bool -> Bool -> Bool
|| (Bool
isshowingdigitgroupseparator Bool -> Bool -> Bool
&& Bool
disambiguate)
      then Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
dec Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol -> Builder
TB.fromText CommoditySymbol
fracPart) (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
decplaces)
      else WideBuilder
forall a. Monoid a => a
mempty
      where
        isshowingdigitgroupseparator :: Bool
isshowingdigitgroupseparator = case Maybe DigitGroupStyle
mgrps of
          Just (DigitGroups Char
_ (Word8
rightmostgrplen:[Word8]
_)) -> Int
intLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
rightmostgrplen
          Maybe DigitGroupStyle
_ -> Bool
False

-- | Given an integer as text, and its length, apply the given DigitGroupStyle,
-- inserting digit group separators between digit groups where appropriate.
-- Returns a Text builder and the number of digit group separators used.
applyDigitGroupStyle :: Maybe DigitGroupStyle -> Int -> T.Text -> WideBuilder
applyDigitGroupStyle :: Maybe DigitGroupStyle -> Int -> CommoditySymbol -> WideBuilder
applyDigitGroupStyle Maybe DigitGroupStyle
Nothing                       Int
l CommoditySymbol
s = Builder -> Int -> WideBuilder
WideBuilder (CommoditySymbol -> Builder
TB.fromText CommoditySymbol
s) Int
l
applyDigitGroupStyle (Just (DigitGroups Char
_ []))     Int
l CommoditySymbol
s = Builder -> Int -> WideBuilder
WideBuilder (CommoditySymbol -> Builder
TB.fromText CommoditySymbol
s) Int
l
applyDigitGroupStyle (Just (DigitGroups Char
c (Word8
g0:[Word8]
gs0))) Int
l0 CommoditySymbol
s0 = NonEmpty Word8 -> Integer -> CommoditySymbol -> WideBuilder
forall {a}.
Integral a =>
NonEmpty a -> Integer -> CommoditySymbol -> WideBuilder
addseps (Word8
g0Word8 -> [Word8] -> NonEmpty Word8
forall a. a -> [a] -> NonEmpty a
:|[Word8]
gs0) (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
l0) CommoditySymbol
s0
  where
    addseps :: NonEmpty a -> Integer -> CommoditySymbol -> WideBuilder
addseps (a
g1:|[a]
gs1) Integer
l1 CommoditySymbol
s1
        | Integer
l2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0    = NonEmpty a -> Integer -> CommoditySymbol -> WideBuilder
addseps NonEmpty a
gs2 Integer
l2 CommoditySymbol
rest WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol -> Builder
TB.fromText CommoditySymbol
part) (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
g1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise = Builder -> Int -> WideBuilder
WideBuilder (CommoditySymbol -> Builder
TB.fromText CommoditySymbol
s1) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
l1)
      where
        (CommoditySymbol
rest, CommoditySymbol
part) = Int -> CommoditySymbol -> (CommoditySymbol, CommoditySymbol)
T.splitAt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
l2) CommoditySymbol
s1
        gs2 :: NonEmpty a
gs2 = NonEmpty a -> Maybe (NonEmpty a) -> NonEmpty a
forall a. a -> Maybe a -> a
fromMaybe (a
g1a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[]) (Maybe (NonEmpty a) -> NonEmpty a)
-> Maybe (NonEmpty a) -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [a]
gs1
        l2 :: Integer
l2 = Integer
l1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- a -> Integer
forall a. Integral a => a -> Integer
toInteger a
g1

-------------------------------------------------------------------------------
-- MixedAmount

instance Semigroup MixedAmount where
  <> :: MixedAmount -> MixedAmount -> MixedAmount
(<>) = MixedAmount -> MixedAmount -> MixedAmount
maPlus
  sconcat :: NonEmpty MixedAmount -> MixedAmount
sconcat = NonEmpty MixedAmount -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum
  stimes :: forall b. Integral b => b -> MixedAmount -> MixedAmount
stimes b
n = Quantity -> MixedAmount -> MixedAmount
multiplyMixedAmount (b -> Quantity
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n)

instance Monoid MixedAmount where
  mempty :: MixedAmount
mempty = MixedAmount
nullmixedamt
  mconcat :: [MixedAmount] -> MixedAmount
mconcat = [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum

instance Num MixedAmount where
    fromInteger :: Integer -> MixedAmount
fromInteger = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount)
-> (Integer -> Amount) -> Integer -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Amount
forall a. Num a => Integer -> a
fromInteger
    negate :: MixedAmount -> MixedAmount
negate = MixedAmount -> MixedAmount
maNegate
    + :: MixedAmount -> MixedAmount -> MixedAmount
(+)    = MixedAmount -> MixedAmount -> MixedAmount
maPlus
    * :: MixedAmount -> MixedAmount -> MixedAmount
(*)    = [Char] -> MixedAmount -> MixedAmount -> MixedAmount
forall a. HasCallStack => [Char] -> a
error [Char]
"error, mixed amounts do not support multiplication" -- PARTIAL:
    abs :: MixedAmount -> MixedAmount
abs    = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount (\Amount
amt -> Amount
amt { aquantity = abs (aquantity amt)})
    signum :: MixedAmount -> MixedAmount
signum = [Char] -> MixedAmount -> MixedAmount
forall a. HasCallStack => [Char] -> a
error [Char]
"error, mixed amounts do not support signum"

-- | Calculate the key used to store an Amount within a MixedAmount.
amountKey :: Amount -> MixedAmountKey
amountKey :: Amount -> MixedAmountKey
amountKey amt :: Amount
amt@Amount{acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
c} = case Amount -> Maybe AmountCost
acost Amount
amt of
    Maybe AmountCost
Nothing             -> CommoditySymbol -> MixedAmountKey
MixedAmountKeyNoCost    CommoditySymbol
c
    Just (TotalCost Amount
p) -> CommoditySymbol -> CommoditySymbol -> MixedAmountKey
MixedAmountKeyTotalCost CommoditySymbol
c (Amount -> CommoditySymbol
acommodity Amount
p)
    Just (UnitCost  Amount
p) -> CommoditySymbol -> CommoditySymbol -> Quantity -> MixedAmountKey
MixedAmountKeyUnitCost  CommoditySymbol
c (Amount -> CommoditySymbol
acommodity Amount
p) (Amount -> Quantity
aquantity Amount
p)

-- | The empty mixed amount.
nullmixedamt :: MixedAmount
nullmixedamt :: MixedAmount
nullmixedamt = Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
forall a. Monoid a => a
mempty

-- | A special mixed amount used as a marker, meaning
-- "no explicit amount provided here, infer it when needed".
missingmixedamt :: MixedAmount
missingmixedamt :: MixedAmount
missingmixedamt = Amount -> MixedAmount
mixedAmount Amount
missingamt

-- | Does this MixedAmount include the "missing amount" marker ?
-- Note: currently does not test for equality with missingmixedamt,
-- instead it looks for missingamt among the Amounts.
-- missingamt should always be alone, but detect it even if not.
isMissingMixedAmount :: MixedAmount -> Bool
isMissingMixedAmount :: MixedAmount -> Bool
isMissingMixedAmount (Mixed Map MixedAmountKey Amount
ma) = Amount -> MixedAmountKey
amountKey Amount
missingamt MixedAmountKey -> Map MixedAmountKey Amount -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map MixedAmountKey Amount
ma

-- | Convert amounts in various commodities into a mixed amount.
mixed :: Foldable t => t Amount -> MixedAmount
mixed :: forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed = MixedAmount -> t Amount -> MixedAmount
forall (t :: * -> *).
Foldable t =>
MixedAmount -> t Amount -> MixedAmount
maAddAmounts MixedAmount
nullmixedamt

-- | Create a MixedAmount from a single Amount.
mixedAmount :: Amount -> MixedAmount
mixedAmount :: Amount -> MixedAmount
mixedAmount Amount
a = Map MixedAmountKey Amount -> MixedAmount
Mixed (Map MixedAmountKey Amount -> MixedAmount)
-> Map MixedAmountKey Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmountKey -> Amount -> Map MixedAmountKey Amount
forall k a. k -> a -> Map k a
M.singleton (Amount -> MixedAmountKey
amountKey Amount
a) Amount
a

-- | Add an Amount to a MixedAmount, normalising the result.
-- Amounts with different costs are kept separate.
maAddAmount :: MixedAmount -> Amount -> MixedAmount
maAddAmount :: MixedAmount -> Amount -> MixedAmount
maAddAmount (Mixed Map MixedAmountKey Amount
ma) Amount
a = Map MixedAmountKey Amount -> MixedAmount
Mixed (Map MixedAmountKey Amount -> MixedAmount)
-> Map MixedAmountKey Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Amount -> Amount)
-> MixedAmountKey
-> Amount
-> Map MixedAmountKey Amount
-> Map MixedAmountKey Amount
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Amount -> Amount -> Amount
sumSimilarAmountsUsingFirstCost (Amount -> MixedAmountKey
amountKey Amount
a) Amount
a Map MixedAmountKey Amount
ma

-- | Add a collection of Amounts to a MixedAmount, normalising the result.
-- Amounts with different costs are kept separate.
maAddAmounts :: Foldable t => MixedAmount -> t Amount -> MixedAmount
maAddAmounts :: forall (t :: * -> *).
Foldable t =>
MixedAmount -> t Amount -> MixedAmount
maAddAmounts = (MixedAmount -> Amount -> MixedAmount)
-> MixedAmount -> t Amount -> MixedAmount
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' MixedAmount -> Amount -> MixedAmount
maAddAmount

-- | Negate mixed amount's quantities (and total costs, if any).
maNegate :: MixedAmount -> MixedAmount
maNegate :: MixedAmount -> MixedAmount
maNegate = (Quantity -> Quantity) -> MixedAmount -> MixedAmount
transformMixedAmount Quantity -> Quantity
forall a. Num a => a -> a
negate

-- | Sum two MixedAmount, keeping the cost of the first if any.
-- Amounts with different costs are kept separate (since 2021).
maPlus :: MixedAmount -> MixedAmount -> MixedAmount
maPlus :: MixedAmount -> MixedAmount -> MixedAmount
maPlus (Mixed Map MixedAmountKey Amount
as) (Mixed Map MixedAmountKey Amount
bs) = Map MixedAmountKey Amount -> MixedAmount
Mixed (Map MixedAmountKey Amount -> MixedAmount)
-> Map MixedAmountKey Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Amount -> Amount)
-> Map MixedAmountKey Amount
-> Map MixedAmountKey Amount
-> Map MixedAmountKey Amount
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Amount -> Amount -> Amount
sumSimilarAmountsUsingFirstCost Map MixedAmountKey Amount
as Map MixedAmountKey Amount
bs

-- | Subtract a MixedAmount from another.
-- Amounts with different costs are kept separate.
maMinus :: MixedAmount -> MixedAmount -> MixedAmount
maMinus :: MixedAmount -> MixedAmount -> MixedAmount
maMinus MixedAmount
a = MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
a (MixedAmount -> MixedAmount)
-> (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> MixedAmount
maNegate

-- | Sum a collection of MixedAmounts.
-- Amounts with different costs are kept separate.
maSum :: Foldable t => t MixedAmount -> MixedAmount
maSum :: forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum = (MixedAmount -> MixedAmount -> MixedAmount)
-> MixedAmount -> t MixedAmount -> MixedAmount
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
nullmixedamt

-- | Divide a mixed amount's quantities (and total costs, if any) by a constant.
divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount
divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount
divideMixedAmount Quantity
n = (Quantity -> Quantity) -> MixedAmount -> MixedAmount
transformMixedAmount (Quantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/Quantity
n)

-- | Multiply a mixed amount's quantities (and total costs, if any) by a constant.
multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount
multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount
multiplyMixedAmount Quantity
n = (Quantity -> Quantity) -> MixedAmount -> MixedAmount
transformMixedAmount (Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
*Quantity
n)

-- | Apply a function to a mixed amount's quantities (and its total costs, if it has any).
transformMixedAmount :: (Quantity -> Quantity) -> MixedAmount -> MixedAmount
transformMixedAmount :: (Quantity -> Quantity) -> MixedAmount -> MixedAmount
transformMixedAmount Quantity -> Quantity
f = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe ((Quantity -> Quantity) -> Amount -> Amount
transformAmount Quantity -> Quantity
f)

-- | Calculate the average of some mixed amounts.
averageMixedAmounts :: [MixedAmount] -> MixedAmount
averageMixedAmounts :: [MixedAmount] -> MixedAmount
averageMixedAmounts [MixedAmount]
as = Int -> Quantity
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([MixedAmount] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MixedAmount]
as) Quantity -> MixedAmount -> MixedAmount
`divideMixedAmount` [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum [MixedAmount]
as

-- | Is this mixed amount negative, if we can tell that unambiguously?
-- Ie when normalised, are all individual commodity amounts negative ?
isNegativeMixedAmount :: MixedAmount -> Maybe Bool
isNegativeMixedAmount :: MixedAmount -> Maybe Bool
isNegativeMixedAmount MixedAmount
m =
  case MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
mixedAmountStripCosts MixedAmount
m of
    []  -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    [Amount
a] -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Amount -> Bool
isNegativeAmount Amount
a
    [Amount]
as | (Amount -> Bool) -> [Amount] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Amount -> Bool
isNegativeAmount [Amount]
as -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    [Amount]
as | Bool -> Bool
not ((Amount -> Bool) -> [Amount] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Amount -> Bool
isNegativeAmount [Amount]
as) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    [Amount]
_ -> Maybe Bool
forall a. Maybe a
Nothing  -- multiple amounts with different signs

-- | Does this mixed amount appear to be zero when rendered with its display precision?
-- See amountLooksZero.
mixedAmountLooksZero :: MixedAmount -> Bool
mixedAmountLooksZero :: MixedAmount -> Bool
mixedAmountLooksZero (Mixed Map MixedAmountKey Amount
ma) = (Amount -> Bool) -> Map MixedAmountKey Amount -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Amount -> Bool
amountLooksZero Map MixedAmountKey Amount
ma

-- | Is this mixed amount exactly zero, ignoring its display precision?
-- See amountIsZero.
mixedAmountIsZero :: MixedAmount -> Bool
mixedAmountIsZero :: MixedAmount -> Bool
mixedAmountIsZero (Mixed Map MixedAmountKey Amount
ma) = (Amount -> Bool) -> Map MixedAmountKey Amount -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Amount -> Bool
amountIsZero Map MixedAmountKey Amount
ma

-- | Is this mixed amount exactly zero, ignoring its display precision?
--
-- A convenient alias for mixedAmountIsZero.
maIsZero :: MixedAmount -> Bool
maIsZero :: MixedAmount -> Bool
maIsZero = MixedAmount -> Bool
mixedAmountIsZero

-- | Is this mixed amount non-zero, ignoring its display precision?
--
-- A convenient alias for not . mixedAmountIsZero.
maIsNonZero :: MixedAmount -> Bool
maIsNonZero :: MixedAmount -> Bool
maIsNonZero = Bool -> Bool
not (Bool -> Bool) -> (MixedAmount -> Bool) -> MixedAmount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountIsZero

-- | Get a mixed amount's component amounts, with some cleanups.
-- The following descriptions are old and possibly wrong:
--
-- * amounts in the same commodity are combined unless they have different costs or total costs
--
-- * multiple zero amounts, all with the same non-null commodity, are replaced by just the last of them, preserving the commodity and amount style (all but the last zero amount are discarded)
--
-- * multiple zero amounts with multiple commodities, or no commodities, are replaced by one commodity-less zero amount
--
-- * an empty amount list is replaced by one commodity-less zero amount
--
-- * the special "missing" mixed amount remains unchanged
--
amounts :: MixedAmount -> [Amount]
amounts :: MixedAmount -> [Amount]
amounts (Mixed Map MixedAmountKey Amount
ma)
  | MixedAmount -> Bool
isMissingMixedAmount (Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
ma) = [Amount
missingamt]
  | Map MixedAmountKey Amount -> Bool
forall k a. Map k a -> Bool
M.null Map MixedAmountKey Amount
nonzeros                 = [Amount
newzero]
  | Bool
otherwise                       = Map MixedAmountKey Amount -> [Amount]
forall a. Map MixedAmountKey a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map MixedAmountKey Amount
nonzeros
  where
    newzero :: Amount
newzero = Amount -> Maybe Amount -> Amount
forall a. a -> Maybe a -> a
fromMaybe Amount
nullamt (Maybe Amount -> Amount) -> Maybe Amount -> Amount
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool) -> Map MixedAmountKey Amount -> Maybe Amount
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
not (Bool -> Bool) -> (Amount -> Bool) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> Bool
T.null (CommoditySymbol -> Bool)
-> (Amount -> CommoditySymbol) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> CommoditySymbol
acommodity) Map MixedAmountKey Amount
zeros
    (Map MixedAmountKey Amount
zeros, Map MixedAmountKey Amount
nonzeros) = (Amount -> Bool)
-> Map MixedAmountKey Amount
-> (Map MixedAmountKey Amount, Map MixedAmountKey Amount)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition Amount -> Bool
amountIsZero Map MixedAmountKey Amount
ma

-- | Get a mixed amount's component amounts, with some cleanups.
-- This is a new version of @amounts@, with updated descriptions
-- and optimised for @print@ to show commodityful zeros.
--
-- * If it contains the "missing amount" marker, only that is returned
--   (discarding any additional amounts).
--
-- * Or if it contains any non-zero amounts, only those are returned
--   (discarding any zeroes).
--
-- * Or if it contains any zero amounts (possibly more than one,
--   possibly in different commodities), all of those are returned.
--
-- * Otherwise the null amount is returned.
--
amountsPreservingZeros :: MixedAmount -> [Amount]
amountsPreservingZeros :: MixedAmount -> [Amount]
amountsPreservingZeros (Mixed Map MixedAmountKey Amount
ma)
  | MixedAmount -> Bool
isMissingMixedAmount (Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
ma) = [Amount
missingamt]
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map MixedAmountKey Amount -> Bool
forall k a. Map k a -> Bool
M.null Map MixedAmountKey Amount
nonzeros           = Map MixedAmountKey Amount -> [Amount]
forall a. Map MixedAmountKey a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map MixedAmountKey Amount
nonzeros
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map MixedAmountKey Amount -> Bool
forall k a. Map k a -> Bool
M.null Map MixedAmountKey Amount
zeros              = Map MixedAmountKey Amount -> [Amount]
forall a. Map MixedAmountKey a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map MixedAmountKey Amount
zeros
  | Bool
otherwise                       = [Amount
nullamt]
  where
    (Map MixedAmountKey Amount
zeros, Map MixedAmountKey Amount
nonzeros) = (Amount -> Bool)
-> Map MixedAmountKey Amount
-> (Map MixedAmountKey Amount, Map MixedAmountKey Amount)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition Amount -> Bool
amountIsZero Map MixedAmountKey Amount
ma

-- | Get a mixed amount's component amounts without normalising zero and missing
-- amounts. This is used for JSON serialisation, so the order is important. In
-- particular, we want the Amounts given in the order of the MixedAmountKeys,
-- i.e. lexicographically first by commodity, then by cost commodity, then by
-- unit cost from most negative to most positive.
amountsRaw :: MixedAmount -> [Amount]
amountsRaw :: MixedAmount -> [Amount]
amountsRaw (Mixed Map MixedAmountKey Amount
ma) = Map MixedAmountKey Amount -> [Amount]
forall a. Map MixedAmountKey a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map MixedAmountKey Amount
ma

-- | Get this mixed amount's commodities as a set.
-- Returns an empty set if there are no amounts.
maCommodities :: MixedAmount -> S.Set CommoditySymbol
maCommodities :: MixedAmount -> Set CommoditySymbol
maCommodities = [CommoditySymbol] -> Set CommoditySymbol
forall a. Ord a => [a] -> Set a
S.fromList ([CommoditySymbol] -> Set CommoditySymbol)
-> (MixedAmount -> [CommoditySymbol])
-> MixedAmount
-> Set CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> CommoditySymbol) -> [Amount] -> [CommoditySymbol]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Amount -> CommoditySymbol
acommodity ([Amount] -> [CommoditySymbol])
-> (MixedAmount -> [Amount]) -> MixedAmount -> [CommoditySymbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts'
  where amounts' :: MixedAmount -> [Amount]
amounts' ma :: MixedAmount
ma@(Mixed Map MixedAmountKey Amount
m) = if Map MixedAmountKey Amount -> Bool
forall k a. Map k a -> Bool
M.null Map MixedAmountKey Amount
m then [] else MixedAmount -> [Amount]
amounts MixedAmount
ma

-- | Unify a MixedAmount to a single commodity value if possible.
-- 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 :: MixedAmount -> Maybe Amount
unifyMixedAmount = (Amount -> Amount -> Maybe Amount)
-> Amount -> [Amount] -> Maybe Amount
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Amount -> Amount -> Maybe Amount
combine Amount
0 ([Amount] -> Maybe Amount)
-> (MixedAmount -> [Amount]) -> MixedAmount -> Maybe Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts
  where
    combine :: Amount -> Amount -> Maybe Amount
combine Amount
amt Amount
result
      | Amount -> Bool
amountIsZero Amount
amt                    = Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
result
      | Amount -> Bool
amountIsZero Amount
result                 = Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
amt
      | Amount -> CommoditySymbol
acommodity Amount
amt CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> CommoditySymbol
acommodity Amount
result = Amount -> Maybe Amount
forall a. a -> Maybe a
Just (Amount -> Maybe Amount) -> Amount -> Maybe Amount
forall a b. (a -> b) -> a -> b
$ Amount
amt Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Amount
result
      | Bool
otherwise                           = Maybe Amount
forall a. Maybe a
Nothing

-- | Sum same-commodity amounts in a lossy way, applying the first
-- cost to the result and discarding any other costs. Only used as a
-- rendering helper.
sumSimilarAmountsUsingFirstCost :: Amount -> Amount -> Amount
sumSimilarAmountsUsingFirstCost :: Amount -> Amount -> Amount
sumSimilarAmountsUsingFirstCost Amount
a Amount
b = (Amount
a Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Amount
b){acost=p}
  where
    p :: Maybe AmountCost
p = case (Amount -> Maybe AmountCost
acost Amount
a, Amount -> Maybe AmountCost
acost Amount
b) of
        (Just (TotalCost Amount
ap), Just (TotalCost Amount
bp))
          -> AmountCost -> Maybe AmountCost
forall a. a -> Maybe a
Just (AmountCost -> Maybe AmountCost)
-> (Amount -> AmountCost) -> Amount -> Maybe AmountCost
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> AmountCost
TotalCost (Amount -> Maybe AmountCost) -> Amount -> Maybe AmountCost
forall a b. (a -> b) -> a -> b
$ Amount
ap{aquantity = aquantity ap + aquantity bp }
        (Maybe AmountCost, Maybe AmountCost)
_ -> Amount -> Maybe AmountCost
acost Amount
a

-- | Filter a mixed amount's component amounts by a predicate.
filterMixedAmount :: (Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount :: (Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount Amount -> Bool
p (Mixed Map MixedAmountKey Amount
ma) = Map MixedAmountKey Amount -> MixedAmount
Mixed (Map MixedAmountKey Amount -> MixedAmount)
-> Map MixedAmountKey Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool)
-> Map MixedAmountKey Amount -> Map MixedAmountKey Amount
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter Amount -> Bool
p Map MixedAmountKey Amount
ma

-- | Return an unnormalised MixedAmount containing just the amounts in the
-- requested commodity from the original mixed amount.
--
-- The result will contain at least one Amount of the requested commodity,
-- even if the original mixed amount did not (with quantity zero in that case,
-- and this would be discarded when the mixed amount is next normalised).
--
-- The result can contain more than one Amount of the requested commodity,
-- eg because there were several with different costs,
-- or simply because the original mixed amount was was unnormalised.
--
filterMixedAmountByCommodity :: CommoditySymbol -> MixedAmount -> MixedAmount
filterMixedAmountByCommodity :: CommoditySymbol -> MixedAmount -> MixedAmount
filterMixedAmountByCommodity CommoditySymbol
c (Mixed Map MixedAmountKey Amount
ma)
  | Map MixedAmountKey Amount -> Bool
forall k a. Map k a -> Bool
M.null Map MixedAmountKey Amount
ma' = Amount -> MixedAmount
mixedAmount Amount
nullamt{acommodity=c}
  | Bool
otherwise  = Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
ma'
  where ma' :: Map MixedAmountKey Amount
ma' = (Amount -> Bool)
-> Map MixedAmountKey Amount -> Map MixedAmountKey Amount
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter ((CommoditySymbol
cCommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
==) (CommoditySymbol -> Bool)
-> (Amount -> CommoditySymbol) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> CommoditySymbol
acommodity) Map MixedAmountKey Amount
ma

-- | Apply a transform to a mixed amount's component 'Amount's.
mapMixedAmount :: (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount :: (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount Amount -> Amount
f (Mixed Map MixedAmountKey Amount
ma) = [Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed ([Amount] -> MixedAmount)
-> ([Amount] -> [Amount]) -> [Amount] -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> Amount) -> [Amount] -> [Amount]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> Amount
f ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Map MixedAmountKey Amount -> [Amount]
forall a. Map MixedAmountKey a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map MixedAmountKey Amount
ma

-- | Apply a transform to a mixed amount's component 'Amount's, which does not
-- affect the key of the amount (i.e. doesn't change the commodity, cost
-- commodity, or unit cost amount). This condition is not checked.
mapMixedAmountUnsafe :: (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe :: (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe Amount -> Amount
f (Mixed Map MixedAmountKey Amount
ma) = Map MixedAmountKey Amount -> MixedAmount
Mixed (Map MixedAmountKey Amount -> MixedAmount)
-> Map MixedAmountKey Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Amount)
-> Map MixedAmountKey Amount -> Map MixedAmountKey Amount
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Amount -> Amount
f Map MixedAmountKey Amount
ma  -- Use M.map instead of fmap to maintain strictness

-- | Convert all component amounts to cost where possible (see amountCost).
mixedAmountCost :: MixedAmount -> MixedAmount
mixedAmountCost :: MixedAmount -> MixedAmount
mixedAmountCost (Mixed Map MixedAmountKey Amount
ma) =
    (MixedAmount -> Amount -> MixedAmount)
-> MixedAmount -> Map MixedAmountKey Amount -> MixedAmount
forall b a. (b -> a -> b) -> b -> Map MixedAmountKey a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\MixedAmount
m Amount
a -> MixedAmount -> Amount -> MixedAmount
maAddAmount MixedAmount
m (Amount -> Amount
amountCost Amount
a)) (Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
noCosts) Map MixedAmountKey Amount
withCosts
  where (Map MixedAmountKey Amount
noCosts, Map MixedAmountKey Amount
withCosts) = (Amount -> Bool)
-> Map MixedAmountKey Amount
-> (Map MixedAmountKey Amount, Map MixedAmountKey Amount)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition (Maybe AmountCost -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe AmountCost -> Bool)
-> (Amount -> Maybe AmountCost) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Maybe AmountCost
acost) Map MixedAmountKey Amount
ma

-- -- | MixedAmount derived Eq instance in Types.hs doesn't know that we
-- -- want $0 = EUR0 = 0. Yet we don't want to drag all this code over there.
-- -- For now, use this when cross-commodity zero equality is important.
-- mixedAmountEquals :: MixedAmount -> MixedAmount -> Bool
-- mixedAmountEquals a b = amounts a' == amounts b' || (mixedAmountLooksZero a' && mixedAmountLooksZero b')
--     where a' = mixedAmountStripCosts a
--           b' = mixedAmountStripCosts b

-- Mixed amount styles

-- v1
{-# DEPRECATED canonicaliseMixedAmount "please use mixedAmountSetStyle False (or styleAmounts) instead" #-}
canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount :: Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount = Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map CommoditySymbol AmountStyle -> a -> a
styleAmounts

-- v2
{-# DEPRECATED styleMixedAmount "please use styleAmounts instead" #-}
-- | Given a map of standard commodity display styles, find and apply
-- the appropriate style to each individual amount.
styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount :: Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount = Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map CommoditySymbol AmountStyle -> a -> a
styleAmounts

-- v3
{-# DEPRECATED mixedAmountSetStyles "please use styleAmounts instead" #-}
mixedAmountSetStyles :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
mixedAmountSetStyles :: Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
mixedAmountSetStyles = Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map CommoditySymbol AmountStyle -> a -> a
styleAmounts

-- v4
instance HasAmounts MixedAmount where
  styleAmounts :: Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
styleAmounts Map CommoditySymbol AmountStyle
styles = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe (Map CommoditySymbol AmountStyle -> Amount -> Amount
forall a. HasAmounts a => Map CommoditySymbol AmountStyle -> a -> a
styleAmounts Map CommoditySymbol AmountStyle
styles)

instance HasAmounts Account where
  styleAmounts :: Map CommoditySymbol AmountStyle -> Account -> Account
styleAmounts Map CommoditySymbol AmountStyle
styles acct :: Account
acct@Account{MixedAmount
aebalance :: MixedAmount
aebalance :: Account -> MixedAmount
aebalance,MixedAmount
aibalance :: MixedAmount
aibalance :: Account -> MixedAmount
aibalance} =
    Account
acct{aebalance=styleAmounts styles aebalance, aibalance=styleAmounts styles aibalance}

-- | Reset each individual amount's display style to the default.
mixedAmountUnstyled :: MixedAmount -> MixedAmount
mixedAmountUnstyled :: MixedAmount -> MixedAmount
mixedAmountUnstyled = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe Amount -> Amount
amountUnstyled

-- Mixed amount rendering


-- | Render a mixed amount using its amount display styles and the default amount format,
-- after normalising it (to at most one amount in each of its commodities).
-- See showMixedAmountB for special cases.
showMixedAmount :: MixedAmount -> String
showMixedAmount :: MixedAmount -> [Char]
showMixedAmount = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (MixedAmount -> WideBuilder) -> MixedAmount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
defaultFmt

-- | Like showMixedAmount but uses the given amount format.
-- See showMixedAmountB for special cases.
showMixedAmountWith :: AmountFormat -> MixedAmount -> String
showMixedAmountWith :: AmountFormat -> MixedAmount -> [Char]
showMixedAmountWith AmountFormat
fmt = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (MixedAmount -> WideBuilder) -> MixedAmount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
fmt

-- | Get the one-line string representation of a mixed amount (also showing any costs).
-- See showMixedAmountB for special cases.
showMixedAmountOneLine :: MixedAmount -> String
showMixedAmountOneLine :: MixedAmount -> [Char]
showMixedAmountOneLine = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (MixedAmount -> WideBuilder) -> MixedAmount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
oneLineNoCostFmt{displayCost=True}

-- | Like showMixedAmount, but zero amounts are shown with their
-- commodity if they have one.
-- See showMixedAmountB for special cases.
showMixedAmountWithZeroCommodity :: MixedAmount -> String
showMixedAmountWithZeroCommodity :: MixedAmount -> [Char]
showMixedAmountWithZeroCommodity = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (MixedAmount -> WideBuilder) -> MixedAmount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
defaultFmt{displayZeroCommodity=True}

-- | Get the string representation of a mixed amount, without showing any costs.
-- With a True argument, adds ANSI codes to show negative amounts in red.
-- See showMixedAmountB for special cases.
showMixedAmountWithoutCost :: Bool -> MixedAmount -> String
showMixedAmountWithoutCost :: Bool -> MixedAmount -> [Char]
showMixedAmountWithoutCost Bool
c = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (MixedAmount -> WideBuilder) -> MixedAmount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
noCostFmt{displayColour=c}

-- | Get the one-line string representation of a mixed amount, but without
-- any \@ costs.
-- With a True argument, adds ANSI codes to show negative amounts in red.
-- See showMixedAmountB for special cases.
showMixedAmountOneLineWithoutCost :: Bool -> MixedAmount -> String
showMixedAmountOneLineWithoutCost :: Bool -> MixedAmount -> [Char]
showMixedAmountOneLineWithoutCost Bool
c = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (MixedAmount -> WideBuilder) -> MixedAmount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
oneLineNoCostFmt{displayColour=c}

-- | Like showMixedAmountOneLineWithoutCost, but show at most the given width,
-- with an elision indicator if there are more.
-- With a True argument, adds ANSI codes to show negative amounts in red.
-- See showMixedAmountB for special cases.
showMixedAmountElided :: Int -> Bool -> MixedAmount -> String
showMixedAmountElided :: Int -> Bool -> MixedAmount -> [Char]
showMixedAmountElided Int
w Bool
c = WideBuilder -> [Char]
wbUnpack (WideBuilder -> [Char])
-> (MixedAmount -> WideBuilder) -> MixedAmount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
oneLineNoCostFmt{displayColour=c, displayMaxWidth=Just w}

-- | Get an unambiguous string representation of a mixed amount for debugging.
showMixedAmountDebug :: MixedAmount -> String
showMixedAmountDebug :: MixedAmount -> [Char]
showMixedAmountDebug MixedAmount
m | MixedAmount
m MixedAmount -> MixedAmount -> Bool
forall a. Eq a => a -> a -> Bool
== MixedAmount
missingmixedamt = [Char]
"(missing)"
                       | Bool
otherwise       = [Char]
"Mixed [" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
as [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]"
    where as :: [Char]
as = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n       " ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Amount -> [Char]) -> [Amount] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> [Char]
showAmountDebug ([Amount] -> [[Char]]) -> [Amount] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amounts MixedAmount
m

-- | Render a mixed amount using its amount display styles and the given amount format,
-- as a builder for efficiency.
-- (This can be converted to a Text with wbToText or to a String with wbUnpack).
--
-- Warning: this (and its showMixedAmount aliases above) basically assumes amounts have no costs.
-- It can show misleading costs or not show costs which are there.
--
-- If a maximum width is given then:
--
-- - If displayed on one line, it will display as many Amounts as can
--   fit in the given width, and further Amounts will be elided. There
--   will always be at least one amount displayed, even if this will
--   exceed the requested maximum width.
--
-- - If displayed on multiple lines, any Amounts longer than the
--   maximum width will be elided.
--
-- Zero-equivalent amounts  are shown as just \"0\".
--
-- The special "missing" amount is shown as the empty string (?).
--
showMixedAmountB :: AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB :: AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
opts MixedAmount
ma
    | AmountFormat -> Bool
displayOneLine AmountFormat
opts = AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountOneLineB AmountFormat
opts MixedAmount
ma
    | Bool
otherwise           = Builder -> Int -> WideBuilder
WideBuilder (WideBuilder -> Builder
wbBuilder (WideBuilder -> Builder)
-> ([WideBuilder] -> WideBuilder) -> [WideBuilder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WideBuilder] -> WideBuilder
forall a. Monoid a => [a] -> a
mconcat ([WideBuilder] -> Builder) -> [WideBuilder] -> Builder
forall a b. (a -> b) -> a -> b
$ WideBuilder -> [WideBuilder] -> [WideBuilder]
forall a. a -> [a] -> [a]
intersperse WideBuilder
sep [WideBuilder]
ls) Int
width
  where
    ls :: [WideBuilder]
ls = AmountFormat -> MixedAmount -> [WideBuilder]
showMixedAmountLinesB AmountFormat
opts MixedAmount
ma
    width :: Int
width = Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (WideBuilder -> Int) -> [WideBuilder] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map WideBuilder -> Int
wbWidth [WideBuilder]
ls
    sep :: WideBuilder
sep = Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
'\n') Int
0

-- | Helper for showMixedAmountB (and postingAsLines, ...) to show a list of Amounts on multiple lines.
-- This returns the list of WideBuilders: one for each Amount, and padded/elided to the appropriate width.
-- This does not honour displayOneLine; all amounts will be displayed as if displayOneLine were False.
showMixedAmountLinesB :: AmountFormat -> MixedAmount -> [WideBuilder]
showMixedAmountLinesB :: AmountFormat -> MixedAmount -> [WideBuilder]
showMixedAmountLinesB AmountFormat
opts MixedAmount
ma =
    ((WideBuilder, Amount) -> WideBuilder)
-> [(WideBuilder, Amount)] -> [WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder, Amount) -> WideBuilder
forall a b. (a, b) -> a
fst ([(WideBuilder, Amount)] -> [WideBuilder])
-> [(WideBuilder, Amount)] -> [WideBuilder]
forall a b. (a -> b) -> a -> b
$ AmountFormat -> MixedAmount -> [(WideBuilder, Amount)]
showMixedAmountLinesPartsB AmountFormat
opts MixedAmount
ma

-- | Like 'showMixedAmountLinesB' but also returns
-- the amounts associated with each text builder.
showMixedAmountLinesPartsB :: AmountFormat -> MixedAmount -> [(WideBuilder, Amount)]
showMixedAmountLinesPartsB :: AmountFormat -> MixedAmount -> [(WideBuilder, Amount)]
showMixedAmountLinesPartsB opts :: AmountFormat
opts@AmountFormat{displayMaxWidth :: AmountFormat -> Maybe Int
displayMaxWidth=Maybe Int
mmax,displayMinWidth :: AmountFormat -> Maybe Int
displayMinWidth=Maybe Int
mmin} MixedAmount
ma =
    [WideBuilder] -> [Amount] -> [(WideBuilder, Amount)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((AmountDisplay -> WideBuilder) -> [AmountDisplay] -> [WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (AmountDisplay -> WideBuilder
adBuilder (AmountDisplay -> WideBuilder)
-> (AmountDisplay -> AmountDisplay) -> AmountDisplay -> WideBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplay -> AmountDisplay
pad) [AmountDisplay]
elided) [Amount]
amts
  where
    astrs :: [AmountDisplay]
astrs = Int -> (Amount -> WideBuilder) -> [Amount] -> [AmountDisplay]
amtDisplayList (WideBuilder -> Int
wbWidth WideBuilder
sep) (AmountFormat -> Amount -> WideBuilder
showAmountB AmountFormat
opts) [Amount]
amts
    amts :: [Amount]
amts = AmountFormat -> MixedAmount -> [Amount]
orderedAmounts AmountFormat
opts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$
              if AmountFormat -> Bool
displayCost AmountFormat
opts then MixedAmount
ma else MixedAmount -> MixedAmount
mixedAmountStripCosts MixedAmount
ma
    sep :: WideBuilder
sep   = Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
'\n') Int
0
    width :: Int
width = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (AmountDisplay -> Int) -> [AmountDisplay] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder -> Int
wbWidth (WideBuilder -> Int)
-> (AmountDisplay -> WideBuilder) -> AmountDisplay -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplay -> WideBuilder
adBuilder) [AmountDisplay]
elided

    pad :: AmountDisplay -> AmountDisplay
pad AmountDisplay
amt
      | Just Int
mw <- Maybe Int
mmin =
          let w :: Int
w = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
width Int
mw) Int -> Int -> Int
forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth (AmountDisplay -> WideBuilder
adBuilder AmountDisplay
amt)
           in AmountDisplay
amt{ adBuilder = WideBuilder (TB.fromText $ T.replicate w " ") w <> adBuilder amt }
      | Bool
otherwise = AmountDisplay
amt

    elided :: [AmountDisplay]
elided = ([AmountDisplay] -> [AmountDisplay])
-> (Int -> [AmountDisplay] -> [AmountDisplay])
-> Maybe Int
-> [AmountDisplay]
-> [AmountDisplay]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [AmountDisplay] -> [AmountDisplay]
forall a. a -> a
id Int -> [AmountDisplay] -> [AmountDisplay]
elideTo Maybe Int
mmax [AmountDisplay]
astrs
    elideTo :: Int -> [AmountDisplay] -> [AmountDisplay]
elideTo Int
m [AmountDisplay]
xs = Maybe AmountDisplay -> [AmountDisplay] -> [AmountDisplay]
forall a. Maybe a -> [a] -> [a]
maybeAppend Maybe AmountDisplay
elisionStr [AmountDisplay]
short
      where
        elisionStr :: Maybe AmountDisplay
elisionStr = Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay
elisionDisplay (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
m) (WideBuilder -> Int
wbWidth WideBuilder
sep) ([AmountDisplay] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AmountDisplay]
long) (AmountDisplay -> Maybe AmountDisplay)
-> AmountDisplay -> Maybe AmountDisplay
forall a b. (a -> b) -> a -> b
$ AmountDisplay -> [AmountDisplay] -> AmountDisplay
forall a. a -> [a] -> a
lastDef AmountDisplay
nullAmountDisplay [AmountDisplay]
short
        ([AmountDisplay]
short, [AmountDisplay]
long) = (AmountDisplay -> Bool)
-> [AmountDisplay] -> ([AmountDisplay], [AmountDisplay])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Int
mInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=) (Int -> Bool) -> (AmountDisplay -> Int) -> AmountDisplay -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WideBuilder -> Int
wbWidth (WideBuilder -> Int)
-> (AmountDisplay -> WideBuilder) -> AmountDisplay -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplay -> WideBuilder
adBuilder) [AmountDisplay]
xs

-- | Helper for showMixedAmountB to deal with single line displays. This does not
-- honour displayOneLine: all amounts will be displayed as if displayOneLine
-- were True.
showMixedAmountOneLineB :: AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountOneLineB :: AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountOneLineB opts :: AmountFormat
opts@AmountFormat{displayMaxWidth :: AmountFormat -> Maybe Int
displayMaxWidth=Maybe Int
mmax,displayMinWidth :: AmountFormat -> Maybe Int
displayMinWidth=Maybe Int
mmin} MixedAmount
ma =
    Builder -> Int -> WideBuilder
WideBuilder (WideBuilder -> Builder
wbBuilder (WideBuilder -> Builder)
-> ([WideBuilder] -> WideBuilder) -> [WideBuilder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WideBuilder -> WideBuilder
pad (WideBuilder -> WideBuilder)
-> ([WideBuilder] -> WideBuilder) -> [WideBuilder] -> WideBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WideBuilder] -> WideBuilder
forall a. Monoid a => [a] -> a
mconcat ([WideBuilder] -> WideBuilder)
-> ([WideBuilder] -> [WideBuilder]) -> [WideBuilder] -> WideBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WideBuilder -> [WideBuilder] -> [WideBuilder]
forall a. a -> [a] -> [a]
intersperse WideBuilder
sep ([WideBuilder] -> Builder) -> [WideBuilder] -> Builder
forall a b. (a -> b) -> a -> b
$ (AmountDisplay -> WideBuilder) -> [AmountDisplay] -> [WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map AmountDisplay -> WideBuilder
adBuilder [AmountDisplay]
elided)
    (Int -> WideBuilder) -> (Int -> Int) -> Int -> WideBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
width (Int -> WideBuilder) -> Int -> WideBuilder
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
mmin
  where
    width :: Int
width  = Int -> (AmountDisplay -> Int) -> Maybe AmountDisplay -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 AmountDisplay -> Int
adTotal (Maybe AmountDisplay -> Int) -> Maybe AmountDisplay -> Int
forall a b. (a -> b) -> a -> b
$ [AmountDisplay] -> Maybe AmountDisplay
forall a. [a] -> Maybe a
lastMay [AmountDisplay]
elided
    astrs :: [AmountDisplay]
astrs  = Int -> (Amount -> WideBuilder) -> [Amount] -> [AmountDisplay]
amtDisplayList (WideBuilder -> Int
wbWidth WideBuilder
sep) (AmountFormat -> Amount -> WideBuilder
showAmountB AmountFormat
opts) ([Amount] -> [AmountDisplay])
-> (MixedAmount -> [Amount]) -> MixedAmount -> [AmountDisplay]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> MixedAmount -> [Amount]
orderedAmounts AmountFormat
opts (MixedAmount -> [AmountDisplay]) -> MixedAmount -> [AmountDisplay]
forall a b. (a -> b) -> a -> b
$
               if AmountFormat -> Bool
displayCost AmountFormat
opts then MixedAmount
ma else MixedAmount -> MixedAmount
mixedAmountStripCosts MixedAmount
ma
    sep :: WideBuilder
sep    = Builder -> Int -> WideBuilder
WideBuilder ([Char] -> Builder
TB.fromString [Char]
", ") Int
2
    n :: Int
n      = [AmountDisplay] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AmountDisplay]
astrs

    pad :: WideBuilder -> WideBuilder
pad = (Builder -> Int -> WideBuilder
WideBuilder (CommoditySymbol -> Builder
TB.fromText (CommoditySymbol -> Builder) -> CommoditySymbol -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> CommoditySymbol -> CommoditySymbol
T.replicate Int
w CommoditySymbol
" ") Int
w WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<>)
      where w :: Int
w = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
mmin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
width

    elided :: [AmountDisplay]
elided = ([AmountDisplay] -> [AmountDisplay])
-> (Int -> [AmountDisplay] -> [AmountDisplay])
-> Maybe Int
-> [AmountDisplay]
-> [AmountDisplay]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [AmountDisplay] -> [AmountDisplay]
forall a. a -> a
id Int -> [AmountDisplay] -> [AmountDisplay]
elideTo Maybe Int
mmax [AmountDisplay]
astrs
    elideTo :: Int -> [AmountDisplay] -> [AmountDisplay]
elideTo Int
m = [(AmountDisplay, Maybe AmountDisplay)] -> [AmountDisplay]
forall {a}. [(a, Maybe a)] -> [a]
addElide ([(AmountDisplay, Maybe AmountDisplay)] -> [AmountDisplay])
-> ([AmountDisplay] -> [(AmountDisplay, Maybe AmountDisplay)])
-> [AmountDisplay]
-> [AmountDisplay]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [(AmountDisplay, Maybe AmountDisplay)]
-> [(AmountDisplay, Maybe AmountDisplay)]
takeFitting Int
m ([(AmountDisplay, Maybe AmountDisplay)]
 -> [(AmountDisplay, Maybe AmountDisplay)])
-> ([AmountDisplay] -> [(AmountDisplay, Maybe AmountDisplay)])
-> [AmountDisplay]
-> [(AmountDisplay, Maybe AmountDisplay)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AmountDisplay] -> [(AmountDisplay, Maybe AmountDisplay)]
withElided
    -- Add the last elision string to the end of the display list
    addElide :: [(a, Maybe a)] -> [a]
addElide [] = []
    addElide [(a, Maybe a)]
xs = Maybe a -> [a] -> [a]
forall a. Maybe a -> [a] -> [a]
maybeAppend ((a, Maybe a) -> Maybe a
forall a b. (a, b) -> b
snd ((a, Maybe a) -> Maybe a) -> (a, Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$ [(a, Maybe a)] -> (a, Maybe a)
forall a. HasCallStack => [a] -> a
last [(a, Maybe a)]
xs) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ ((a, Maybe a) -> a) -> [(a, Maybe a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Maybe a) -> a
forall a b. (a, b) -> a
fst [(a, Maybe a)]
xs
    -- Return the elements of the display list which fit within the maximum width
    -- (including their elision strings). Always display at least one amount,
    -- regardless of width.
    takeFitting :: Int
-> [(AmountDisplay, Maybe AmountDisplay)]
-> [(AmountDisplay, Maybe AmountDisplay)]
takeFitting Int
_ []     = []
    takeFitting Int
m ((AmountDisplay, Maybe AmountDisplay)
x:[(AmountDisplay, Maybe AmountDisplay)]
xs) = (AmountDisplay, Maybe AmountDisplay)
x (AmountDisplay, Maybe AmountDisplay)
-> [(AmountDisplay, Maybe AmountDisplay)]
-> [(AmountDisplay, Maybe AmountDisplay)]
forall a. a -> [a] -> [a]
: ((AmountDisplay, Maybe AmountDisplay) -> Bool)
-> [(AmountDisplay, Maybe AmountDisplay)]
-> [(AmountDisplay, Maybe AmountDisplay)]
forall {t :: * -> *} {a}. Foldable t => (a -> Bool) -> t a -> [a]
dropWhileRev (\(AmountDisplay
a,Maybe AmountDisplay
e) -> Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< AmountDisplay -> Int
adTotal (AmountDisplay -> Maybe AmountDisplay -> AmountDisplay
forall a. a -> Maybe a -> a
fromMaybe AmountDisplay
a Maybe AmountDisplay
e)) [(AmountDisplay, Maybe AmountDisplay)]
xs
    dropWhileRev :: (a -> Bool) -> t a -> [a]
dropWhileRev a -> Bool
p = (a -> [a] -> [a]) -> [a] -> t a -> [a]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x [a]
xs -> if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs Bool -> Bool -> Bool
&& a -> Bool
p a
x then [] else a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) []

    -- Add the elision strings (if any) to each amount
    withElided :: [AmountDisplay] -> [(AmountDisplay, Maybe AmountDisplay)]
withElided = (Int -> AmountDisplay -> (AmountDisplay, Maybe AmountDisplay))
-> [Int]
-> [AmountDisplay]
-> [(AmountDisplay, Maybe AmountDisplay)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
n2 AmountDisplay
amt -> (AmountDisplay
amt, Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay
elisionDisplay Maybe Int
forall a. Maybe a
Nothing (WideBuilder -> Int
wbWidth WideBuilder
sep) Int
n2 AmountDisplay
amt)) [Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2..Int
0]

-- Get a mixed amount's component amounts with a bit of cleanup,
-- optionally preserving multiple zeros in different commodities,
-- optionally sorting them according to a commodity display order.
orderedAmounts :: AmountFormat -> MixedAmount -> [Amount]
orderedAmounts :: AmountFormat -> MixedAmount -> [Amount]
orderedAmounts AmountFormat{displayZeroCommodity :: AmountFormat -> Bool
displayZeroCommodity=Bool
preservezeros, displayCommodityOrder :: AmountFormat -> Maybe [CommoditySymbol]
displayCommodityOrder=Maybe [CommoditySymbol]
mcommodityorder} =
  if Bool
preservezeros then MixedAmount -> [Amount]
amountsPreservingZeros else MixedAmount -> [Amount]
amounts
  (MixedAmount -> [Amount])
-> ([Amount] -> [Amount]) -> MixedAmount -> [Amount]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([Amount] -> [Amount])
-> ([CommoditySymbol] -> [Amount] -> [Amount])
-> Maybe [CommoditySymbol]
-> [Amount]
-> [Amount]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Amount] -> [Amount]
forall a. a -> a
id ((CommoditySymbol -> [Amount] -> Amount)
-> [CommoditySymbol] -> [Amount] -> [Amount]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CommoditySymbol -> [Amount] -> Amount
findfirst) Maybe [CommoditySymbol]
mcommodityorder  -- maybe sort them (somehow..)
  where
    -- Find the first amount with the given commodity, otherwise a null amount in that commodity.
    findfirst :: CommoditySymbol -> [Amount] -> Amount
    findfirst :: CommoditySymbol -> [Amount] -> Amount
findfirst CommoditySymbol
c = Amount -> Maybe Amount -> Amount
forall a. a -> Maybe a -> a
fromMaybe Amount
nullamtc (Maybe Amount -> Amount)
-> ([Amount] -> Maybe Amount) -> [Amount] -> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> Bool) -> [Amount] -> Maybe Amount
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((CommoditySymbol
cCommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
==) (CommoditySymbol -> Bool)
-> (Amount -> CommoditySymbol) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> CommoditySymbol
acommodity)
      where
        nullamtc :: Amount
nullamtc = CommoditySymbol -> Amount -> Amount
amountWithCommodity CommoditySymbol
c Amount
nullamt

data AmountDisplay = AmountDisplay
  { AmountDisplay -> WideBuilder
adBuilder :: !WideBuilder  -- ^ String representation of the Amount
  , AmountDisplay -> Int
adTotal   :: !Int            -- ^ Cumulative length of MixedAmount this Amount is part of,
                                --   including separators
  } deriving (Int -> AmountDisplay -> ShowS
[AmountDisplay] -> ShowS
AmountDisplay -> [Char]
(Int -> AmountDisplay -> ShowS)
-> (AmountDisplay -> [Char])
-> ([AmountDisplay] -> ShowS)
-> Show AmountDisplay
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AmountDisplay -> ShowS
showsPrec :: Int -> AmountDisplay -> ShowS
$cshow :: AmountDisplay -> [Char]
show :: AmountDisplay -> [Char]
$cshowList :: [AmountDisplay] -> ShowS
showList :: [AmountDisplay] -> ShowS
Show)

nullAmountDisplay :: AmountDisplay
nullAmountDisplay :: AmountDisplay
nullAmountDisplay = WideBuilder -> Int -> AmountDisplay
AmountDisplay WideBuilder
forall a. Monoid a => a
mempty Int
0

amtDisplayList :: Int -> (Amount -> WideBuilder) -> [Amount] -> [AmountDisplay]
amtDisplayList :: Int -> (Amount -> WideBuilder) -> [Amount] -> [AmountDisplay]
amtDisplayList Int
sep Amount -> WideBuilder
showamt = (Int, [AmountDisplay]) -> [AmountDisplay]
forall a b. (a, b) -> b
snd ((Int, [AmountDisplay]) -> [AmountDisplay])
-> ([Amount] -> (Int, [AmountDisplay]))
-> [Amount]
-> [AmountDisplay]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Amount -> (Int, AmountDisplay))
-> Int -> [Amount] -> (Int, [AmountDisplay])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Int -> Amount -> (Int, AmountDisplay)
display (-Int
sep)
  where
    display :: Int -> Amount -> (Int, AmountDisplay)
display Int
tot Amount
amt = (Int
tot', WideBuilder -> Int -> AmountDisplay
AmountDisplay WideBuilder
str Int
tot')
      where
        str :: WideBuilder
str  = Amount -> WideBuilder
showamt Amount
amt
        tot' :: Int
tot' = Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (WideBuilder -> Int
wbWidth WideBuilder
str) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sep

-- The string "m more", added to the previous running total
elisionDisplay :: Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay
elisionDisplay :: Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay
elisionDisplay Maybe Int
mmax Int
sep Int
n AmountDisplay
lastAmt
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     = AmountDisplay -> Maybe AmountDisplay
forall a. a -> Maybe a
Just (AmountDisplay -> Maybe AmountDisplay)
-> AmountDisplay -> Maybe AmountDisplay
forall a b. (a -> b) -> a -> b
$ WideBuilder -> Int -> AmountDisplay
AmountDisplay (Builder -> Int -> WideBuilder
WideBuilder (CommoditySymbol -> Builder
TB.fromText CommoditySymbol
str) Int
len) (AmountDisplay -> Int
adTotal AmountDisplay
lastAmt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
  | Bool
otherwise = Maybe AmountDisplay
forall a. Maybe a
Nothing
  where
    fullString :: CommoditySymbol
fullString = [Char] -> CommoditySymbol
T.pack ([Char] -> CommoditySymbol) -> [Char] -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" more.."
    -- sep from the separator, 7 from " more..", numDigits n from number
    fullLength :: Int
fullLength = Int
sep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Integral a => Int -> a
numDigitsInt Int
n

    str :: CommoditySymbol
str | Just Int
m <- Maybe Int
mmax, Int
fullLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m = Int -> CommoditySymbol -> CommoditySymbol
T.take (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) CommoditySymbol
fullString CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol
".."
        | Bool
otherwise                      = CommoditySymbol
fullString
    len :: Int
len = case Maybe Int
mmax of Maybe Int
Nothing -> Int
fullLength
                       Just Int
m  -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
m Int
fullLength

maybeAppend :: Maybe a -> [a] -> [a]
maybeAppend :: forall a. Maybe a -> [a] -> [a]
maybeAppend Maybe a
Nothing  = [a] -> [a]
forall a. a -> a
id
maybeAppend (Just a
a) = ([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a
a])

-- | Set the display precision in the amount's commodities.
mixedAmountSetPrecision :: AmountPrecision -> MixedAmount -> MixedAmount
mixedAmountSetPrecision :: AmountPrecision -> MixedAmount -> MixedAmount
mixedAmountSetPrecision AmountPrecision
p = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe (AmountPrecision -> Amount -> Amount
amountSetPrecision AmountPrecision
p)

-- | In each component amount, increase the display precision sufficiently
-- to render it exactly (showing all significant decimal digits).
mixedAmountSetFullPrecision :: MixedAmount -> MixedAmount
mixedAmountSetFullPrecision :: MixedAmount -> MixedAmount
mixedAmountSetFullPrecision = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe Amount -> Amount
amountSetFullPrecision

-- | In each component amount, increase the display precision sufficiently
-- to render it exactly if possible, but not more than the given max precision,
-- and if no max precision is given and the amount has infinite decimals,
-- limit display precision to a hard-coded smaller number (8).
-- See amountSetFullPrecisionUpTo.
mixedAmountSetFullPrecisionUpTo :: Maybe Word8 -> MixedAmount -> MixedAmount
mixedAmountSetFullPrecisionUpTo :: Maybe Word8 -> MixedAmount -> MixedAmount
mixedAmountSetFullPrecisionUpTo Maybe Word8
mmaxp = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe (Maybe Word8 -> Amount -> Amount
amountSetFullPrecisionUpTo Maybe Word8
mmaxp)

-- | In each component amount, ensure the display precision is at least the given value.
-- Makes all amounts have an explicit Precision.
mixedAmountSetPrecisionMin :: Word8 -> MixedAmount -> MixedAmount
mixedAmountSetPrecisionMin :: Word8 -> MixedAmount -> MixedAmount
mixedAmountSetPrecisionMin Word8
p = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe (Word8 -> Amount -> Amount
amountSetPrecisionMin Word8
p)

-- | In each component amount, ensure the display precision is at most the given value.
-- Makes all amounts have an explicit Precision.
mixedAmountSetPrecisionMax :: Word8 -> MixedAmount -> MixedAmount
mixedAmountSetPrecisionMax :: Word8 -> MixedAmount -> MixedAmount
mixedAmountSetPrecisionMax Word8
p = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe (Word8 -> Amount -> Amount
amountSetPrecisionMax Word8
p)

-- | Remove all costs from a MixedAmount.
mixedAmountStripCosts :: MixedAmount -> MixedAmount
mixedAmountStripCosts :: MixedAmount -> MixedAmount
mixedAmountStripCosts (Mixed Map MixedAmountKey Amount
ma) =
    (MixedAmount -> Amount -> MixedAmount)
-> MixedAmount -> Map MixedAmountKey Amount -> MixedAmount
forall b a. (b -> a -> b) -> b -> Map MixedAmountKey a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\MixedAmount
m Amount
a -> MixedAmount -> Amount -> MixedAmount
maAddAmount MixedAmount
m Amount
a{acost=Nothing}) (Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
noCosts) Map MixedAmountKey Amount
withCosts
  where (Map MixedAmountKey Amount
noCosts, Map MixedAmountKey Amount
withCosts) = (Amount -> Bool)
-> Map MixedAmountKey Amount
-> (Map MixedAmountKey Amount, Map MixedAmountKey Amount)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition (Maybe AmountCost -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe AmountCost -> Bool)
-> (Amount -> Maybe AmountCost) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Maybe AmountCost
acost) Map MixedAmountKey Amount
ma


-------------------------------------------------------------------------------
-- tests

tests_Amount :: TestTree
tests_Amount = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Amount" [
   [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Amount" [

     [Char] -> Assertion -> TestTree
testCase [Char]
"amountCost" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
       Amount -> Amount
amountCost (Quantity -> Amount
eur Quantity
1) Amount -> Amount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Quantity -> Amount
eur Quantity
1
       Amount -> Amount
amountCost (Quantity -> Amount
eur Quantity
2){acost=Just $ UnitCost $ usd 2} Amount -> Amount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Quantity -> Amount
usd Quantity
4
       Amount -> Amount
amountCost (Quantity -> Amount
eur Quantity
1){acost=Just $ TotalCost $ usd 2} Amount -> Amount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Quantity -> Amount
usd Quantity
2
       Amount -> Amount
amountCost (Quantity -> Amount
eur (-Quantity
1)){acost=Just $ TotalCost $ usd (-2)} Amount -> Amount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Quantity -> Amount
usd (-Quantity
2)

    ,[Char] -> Assertion -> TestTree
testCase [Char]
"amountLooksZero" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
       HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Amount -> Bool
amountLooksZero Amount
nullamt
       HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Amount -> Bool
amountLooksZero (Amount -> Bool) -> Amount -> Bool
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
0

    ,[Char] -> Assertion -> TestTree
testCase [Char]
"negating amounts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
       Amount -> Amount
forall a. Num a => a -> a
negate (Quantity -> Amount
usd Quantity
1) Amount -> Amount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Quantity -> Amount
usd Quantity
1){aquantity= -1}
       let b :: Amount
b = (Quantity -> Amount
usd Quantity
1){acost=Just $ UnitCost $ eur 2} in Amount -> Amount
forall a. Num a => a -> a
negate Amount
b Amount -> Amount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Amount
b{aquantity= -1}

    ,[Char] -> Assertion -> TestTree
testCase [Char]
"adding amounts without costs" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
       (Quantity -> Amount
usd Quantity
1.23 Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Quantity -> Amount
usd (-Quantity
1.23)) Amount -> Amount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Quantity -> Amount
usd Quantity
0
       (Quantity -> Amount
usd Quantity
1.23 Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Quantity -> Amount
usd (-Quantity
1.23)) Amount -> Amount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Quantity -> Amount
usd Quantity
0
       (Quantity -> Amount
usd (-Quantity
1.23) Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Quantity -> Amount
usd (-Quantity
1.23)) Amount -> Amount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Quantity -> Amount
usd (-Quantity
2.46)
       [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Quantity -> Amount
usd Quantity
1.23,Quantity -> Amount
usd (-Quantity
1.23),Quantity -> Amount
usd (-Quantity
1.23),-(Quantity -> Amount
usd (-Quantity
1.23))] Amount -> Amount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Quantity -> Amount
usd Quantity
0
       -- highest precision is preserved
       AmountStyle -> AmountPrecision
asprecision (Amount -> AmountStyle
astyle (Amount -> AmountStyle) -> Amount -> AmountStyle
forall a b. (a -> b) -> a -> b
$ [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Quantity -> Amount
usd Quantity
1 Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
1, Quantity -> Amount
usd Quantity
1 Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
3]) AmountPrecision -> AmountPrecision -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Word8 -> AmountPrecision
Precision Word8
3
       AmountStyle -> AmountPrecision
asprecision (Amount -> AmountStyle
astyle (Amount -> AmountStyle) -> Amount -> AmountStyle
forall a b. (a -> b) -> a -> b
$ [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Quantity -> Amount
usd Quantity
1 Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
3, Quantity -> Amount
usd Quantity
1 Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
1]) AmountPrecision -> AmountPrecision -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Word8 -> AmountPrecision
Precision Word8
3
       -- adding different commodities assumes conversion rate 1
       HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Amount -> Bool
amountLooksZero (Quantity -> Amount
usd Quantity
1.23 Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
- Quantity -> Amount
eur Quantity
1.23)

    ,[Char] -> Assertion -> TestTree
testCase [Char]
"showAmount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Amount -> [Char]
showAmount (Quantity -> Amount
usd Quantity
0 Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Quantity -> Amount
gbp Quantity
0) [Char] -> [Char] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Char]
"0"

  ]

  ,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"MixedAmount" [

     [Char] -> Assertion -> TestTree
testCase [Char]
"comparing mixed amounts compares based on quantities" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
       let usdpos :: MixedAmount
usdpos = [Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
1]
           usdneg :: MixedAmount
usdneg = [Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd (-Quantity
1)]
           eurneg :: MixedAmount
eurneg = [Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
eur (-Quantity
12)]
       MixedAmount -> MixedAmount -> Ordering
forall a. Ord a => a -> a -> Ordering
compare MixedAmount
usdneg MixedAmount
usdpos Ordering -> Ordering -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Ordering
LT
       MixedAmount -> MixedAmount -> Ordering
forall a. Ord a => a -> a -> Ordering
compare MixedAmount
eurneg MixedAmount
usdpos Ordering -> Ordering -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Ordering
LT

     ,[Char] -> Assertion -> TestTree
testCase [Char]
"adding mixed amounts to zero, the commodity and amount style are preserved" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
      [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum ((Amount -> MixedAmount) -> [Amount] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> MixedAmount
mixedAmount
        [Quantity -> Amount
usd Quantity
1.25
        ,Quantity -> Amount
usd (-Quantity
1) Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
3
        ,Quantity -> Amount
usd (-Quantity
0.25)
        ])
        MixedAmount -> MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
0 Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
3)

    ,[Char] -> Assertion -> TestTree
testCase [Char]
"adding mixed amounts with total costs" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum ((Amount -> MixedAmount) -> [Amount] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> MixedAmount
mixedAmount
        [Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
1
        ,Quantity -> Amount
usd (-Quantity
2) Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
1
        ])
        MixedAmount -> MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd (-Quantity
1) Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
2)

    ,[Char] -> Assertion -> TestTree
testCase [Char]
"showMixedAmount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
       MixedAmount -> [Char]
showMixedAmount (Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
1)) [Char] -> [Char] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Char]
"$1.00"
       MixedAmount -> [Char]
showMixedAmount (Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
2)) [Char] -> [Char] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Char]
"$1.00 @ €2.00"
       MixedAmount -> [Char]
showMixedAmount (Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
0)) [Char] -> [Char] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Char]
"0"
       MixedAmount -> [Char]
showMixedAmount MixedAmount
nullmixedamt [Char] -> [Char] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Char]
"0"
       MixedAmount -> [Char]
showMixedAmount MixedAmount
missingmixedamt [Char] -> [Char] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Char]
""

    ,[Char] -> Assertion -> TestTree
testCase [Char]
"showMixedAmountWithoutCost" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      let a :: Amount
a = Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
2
      Bool -> MixedAmount -> [Char]
showMixedAmountWithoutCost Bool
False (Amount -> MixedAmount
mixedAmount (Amount
a)) [Char] -> [Char] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Char]
"$1.00"
      Bool -> MixedAmount -> [Char]
showMixedAmountWithoutCost Bool
False ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Amount
a, -Amount
a]) [Char] -> [Char] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Char]
"0"

    ,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"amounts" [
       [Char] -> Assertion -> TestTree
testCase [Char]
"a missing amount overrides any other amounts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> [Amount]
amounts ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
1, Amount
missingamt]) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Amount
missingamt]
      ,[Char] -> Assertion -> TestTree
testCase [Char]
"costless same-commodity amounts are combined" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> [Amount]
amounts ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
0, Quantity -> Amount
usd Quantity
2]) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Quantity -> Amount
usd Quantity
2]
      ,[Char] -> Assertion -> TestTree
testCase [Char]
"amounts with same unit cost are combined" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> [Amount]
amounts ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1, Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1]) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Quantity -> Amount
usd Quantity
2 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1]
      ,[Char] -> Assertion -> TestTree
testCase [Char]
"amounts with different unit costs are not combined" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> [Amount]
amounts ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1, Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
2]) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1, Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
2]
      ,[Char] -> Assertion -> TestTree
testCase [Char]
"amounts with total costs are combined" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> [Amount]
amounts ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
1, Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
1]) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Quantity -> Amount
usd Quantity
2 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
2]
    ]

    ,[Char] -> Assertion -> TestTree
testCase [Char]
"mixedAmountStripCosts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
       MixedAmount -> [Amount]
amounts (MixedAmount -> MixedAmount
mixedAmountStripCosts MixedAmount
nullmixedamt) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Amount
nullamt]
       HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ MixedAmount -> Bool
mixedAmountLooksZero (MixedAmount -> Bool) -> MixedAmount -> Bool
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
mixedAmountStripCosts
        ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
10
               ,Quantity -> Amount
usd Quantity
10 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
7
               ,Quantity -> Amount
usd (-Quantity
10)
               ,Quantity -> Amount
usd (-Quantity
10) Amount -> Amount -> Amount
@@ Quantity -> Amount
eur (-Quantity
7)
               ])

  ]

 ]