{-|
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 assigned 'Price', 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 price)
  EUR 2 \@\@ $3   (total price)
@

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
@

When a mixed amount has been \"normalised\", it has no more than one amount
in each commodity and no zero amounts; or it has just a single zero amount
and no others.

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

-}

{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE CPP                #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE StandaloneDeriving #-}

module Hledger.Data.Amount (
  -- * Amount
  amount,
  nullamt,
  missingamt,
  num,
  usd,
  eur,
  gbp,
  per,
  hrs,
  at,
  (@@),
  amountWithCommodity,
  -- ** arithmetic
  amountCost,
  amountIsZero,
  amountLooksZero,
  divideAmount,
  multiplyAmount,
  amountTotalPriceToUnitPrice,
  -- ** rendering
  AmountDisplayOpts(..),
  noColour,
  noPrice,
  oneLine,
  amountstyle,
  styleAmount,
  styleAmountExceptPrecision,
  amountUnstyled,
  showAmountB,
  showAmount,
  cshowAmount,
  showAmountWithZeroCommodity,
  showAmountDebug,
  showAmountWithoutPrice,
  amountSetPrecision,
  withPrecision,
  amountSetFullPrecision,
  setAmountInternalPrecision,
  withInternalPrecision,
  setAmountDecimalPoint,
  withDecimalPoint,
  canonicaliseAmount,
  -- * MixedAmount
  nullmixedamt,
  missingmixedamt,
  mixed,
  amounts,
  filterMixedAmount,
  filterMixedAmountByCommodity,
  mapMixedAmount,
  normaliseMixedAmountSquashPricesForDisplay,
  normaliseMixedAmount,
  unifyMixedAmount,
  mixedAmountStripPrices,
  -- ** arithmetic
  mixedAmountCost,
  divideMixedAmount,
  multiplyMixedAmount,
  averageMixedAmounts,
  isNegativeAmount,
  isNegativeMixedAmount,
  mixedAmountIsZero,
  mixedAmountLooksZero,
  mixedAmountTotalPriceToUnitPrice,
  -- ** rendering
  styleMixedAmount,
  mixedAmountUnstyled,
  showMixedAmount,
  showMixedAmountOneLine,
  showMixedAmountDebug,
  showMixedAmountWithoutPrice,
  showMixedAmountOneLineWithoutPrice,
  showMixedAmountElided,
  showMixedAmountWithZeroCommodity,
  showMixedAmountB,
  showMixedAmountLinesB,
  wbToText,
  wbUnpack,
  mixedAmountSetPrecision,
  mixedAmountSetFullPrecision,
  canonicaliseMixedAmount,
  -- * misc.
  ltraceamount,
  tests_Amount
) where

import Control.Monad (foldM)
import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
import Data.Default (Default(..))
import Data.Foldable (toList)
import Data.List (intercalate, intersperse, mapAccumL, partition)
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TB
import Data.Word (Word8)
import Safe (headDef, lastDef, lastMay)
import Text.Printf (printf)

import Hledger.Data.Types
import Hledger.Data.Commodity
import Hledger.Utils

deriving instance Show MarketPrice


-- | Options for the display of Amount and MixedAmount.
data AmountDisplayOpts = AmountDisplayOpts
  { AmountDisplayOpts -> Bool
displayPrice         :: Bool       -- ^ Whether to display the Price of an Amount.
  , AmountDisplayOpts -> Bool
displayZeroCommodity :: Bool       -- ^ If the Amount rounds to 0, whether to display its commodity string.
  , AmountDisplayOpts -> Bool
displayColour        :: Bool       -- ^ Whether to colourise negative Amounts.
  , AmountDisplayOpts -> Bool
displayNormalised    :: Bool       -- ^ Whether to normalise MixedAmounts before displaying.
  , AmountDisplayOpts -> Bool
displayOneLine       :: Bool       -- ^ Whether to display on one line.
  , AmountDisplayOpts -> Maybe Int
displayMinWidth      :: Maybe Int  -- ^ Minimum width to pad to
  , AmountDisplayOpts -> Maybe Int
displayMaxWidth      :: Maybe Int  -- ^ Maximum width to clip to
  } deriving (Int -> AmountDisplayOpts -> ShowS
[AmountDisplayOpts] -> ShowS
AmountDisplayOpts -> String
(Int -> AmountDisplayOpts -> ShowS)
-> (AmountDisplayOpts -> String)
-> ([AmountDisplayOpts] -> ShowS)
-> Show AmountDisplayOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AmountDisplayOpts] -> ShowS
$cshowList :: [AmountDisplayOpts] -> ShowS
show :: AmountDisplayOpts -> String
$cshow :: AmountDisplayOpts -> String
showsPrec :: Int -> AmountDisplayOpts -> ShowS
$cshowsPrec :: Int -> AmountDisplayOpts -> ShowS
Show)

-- | Display Amount and MixedAmount with no colour.
instance Default AmountDisplayOpts where def :: AmountDisplayOpts
def = AmountDisplayOpts
noColour

-- | Display Amount and MixedAmount with no colour.
noColour :: AmountDisplayOpts
noColour :: AmountDisplayOpts
noColour = AmountDisplayOpts :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Int
-> Maybe Int
-> AmountDisplayOpts
AmountDisplayOpts { displayPrice :: Bool
displayPrice         = Bool
True
                             , displayColour :: Bool
displayColour        = Bool
False
                             , displayZeroCommodity :: Bool
displayZeroCommodity = Bool
False
                             , displayNormalised :: Bool
displayNormalised    = Bool
True
                             , displayOneLine :: Bool
displayOneLine       = Bool
False
                             , displayMinWidth :: Maybe Int
displayMinWidth      = Maybe Int
forall a. Maybe a
Nothing
                             , displayMaxWidth :: Maybe Int
displayMaxWidth      = Maybe Int
forall a. Maybe a
Nothing
                             }

-- | Display Amount and MixedAmount with no prices.
noPrice :: AmountDisplayOpts
noPrice :: AmountDisplayOpts
noPrice = AmountDisplayOpts
forall a. Default a => a
def{displayPrice :: Bool
displayPrice=Bool
False}

-- | Display Amount and MixedAmount on one line with no prices.
oneLine :: AmountDisplayOpts
oneLine :: AmountDisplayOpts
oneLine = AmountDisplayOpts
forall a. Default a => a
def{displayOneLine :: Bool
displayOneLine=Bool
True, displayPrice :: Bool
displayPrice=Bool
False}

-------------------------------------------------------------------------------
-- Amount styles

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

-------------------------------------------------------------------------------
-- Amount

instance Num Amount where
    abs :: Amount -> Amount
abs a :: Amount
a@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
q}    = Amount
a{aquantity :: Quantity
aquantity=Quantity -> Quantity
forall a. Num a => a -> a
abs Quantity
q}
    signum :: Amount -> Amount
signum a :: Amount
a@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
q} = Amount
a{aquantity :: Quantity
aquantity=Quantity -> Quantity
forall a. Num a => a -> a
signum Quantity
q}
    fromInteger :: Integer -> Amount
fromInteger Integer
i                = Amount
nullamt{aquantity :: Quantity
aquantity=Integer -> Quantity
forall a. Num a => Integer -> a
fromInteger Integer
i}
    negate :: Amount -> Amount
negate Amount
a                     = (Quantity -> Quantity) -> Amount -> Amount
transformAmount Quantity -> Quantity
forall a. Num a => a -> a
negate Amount
a
    + :: 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.
amount, nullamt :: Amount
amount :: Amount
amount = Amount :: CommoditySymbol
-> Quantity -> Bool -> AmountStyle -> Maybe AmountPrice -> Amount
Amount{acommodity :: CommoditySymbol
acommodity=CommoditySymbol
"", aquantity :: Quantity
aquantity=Quantity
0, aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing, astyle :: AmountStyle
astyle=AmountStyle
amountstyle, aismultiplier :: Bool
aismultiplier=Bool
False}
nullamt :: Amount
nullamt = Amount
amount

-- | A temporary value for parsed transactions which had no amount specified.
missingamt :: Amount
missingamt :: Amount
missingamt = Amount
amount{acommodity :: CommoditySymbol
acommodity=CommoditySymbol
"AUTO"}

-- Handy amount constructors for tests.
-- usd/eur/gbp round their argument to a whole number of pennies/cents.
num :: Quantity -> Amount
num Quantity
n = Amount
amount{acommodity :: CommoditySymbol
acommodity=CommoditySymbol
"",  aquantity :: Quantity
aquantity=Quantity
n}
hrs :: Quantity -> Amount
hrs Quantity
n = Amount
amount{acommodity :: CommoditySymbol
acommodity=CommoditySymbol
"h", aquantity :: Quantity
aquantity=Quantity
n,           astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
2, ascommodityside :: Side
ascommodityside=Side
R}}
usd :: Quantity -> Amount
usd Quantity
n = Amount
amount{acommodity :: CommoditySymbol
acommodity=CommoditySymbol
"$", aquantity :: Quantity
aquantity=Word8 -> Quantity -> Quantity
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
2 Quantity
n, astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
2}}
eur :: Quantity -> Amount
eur Quantity
n = Amount
amount{acommodity :: CommoditySymbol
acommodity=CommoditySymbol
"€", aquantity :: Quantity
aquantity=Word8 -> Quantity -> Quantity
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
2 Quantity
n, astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
2}}
gbp :: Quantity -> Amount
gbp Quantity
n = Amount
amount{acommodity :: CommoditySymbol
acommodity=CommoditySymbol
"£", aquantity :: Quantity
aquantity=Word8 -> Quantity -> Quantity
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
2 Quantity
n, astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
2}}
per :: Quantity -> Amount
per Quantity
n = Amount
amount{acommodity :: CommoditySymbol
acommodity=CommoditySymbol
"%", aquantity :: Quantity
aquantity=Quantity
n,           astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
1, ascommodityside :: Side
ascommodityside=Side
R, ascommodityspaced :: Bool
ascommodityspaced=Bool
True}}
Amount
amt at :: Amount -> Amount -> Amount
`at` Amount
priceamt = Amount
amt{aprice :: Maybe AmountPrice
aprice=AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just (AmountPrice -> Maybe AmountPrice)
-> AmountPrice -> Maybe AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
UnitPrice Amount
priceamt}
Amount
amt @@ :: Amount -> Amount -> Amount
@@ Amount
priceamt = Amount
amt{aprice :: Maybe AmountPrice
aprice=AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just (AmountPrice -> Maybe AmountPrice)
-> AmountPrice -> Maybe AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
TotalPrice Amount
priceamt}

-- | 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.
-- Prices 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
amount{acommodity :: CommoditySymbol
acommodity=CommoditySymbol
c2, aquantity :: Quantity
aquantity=Quantity
q1 Quantity -> Quantity -> Quantity
`op` Quantity
q2, astyle :: AmountStyle
astyle=AmountStyle
s2{asprecision :: AmountPrecision
asprecision=AmountPrecision -> AmountPrecision -> AmountPrecision
forall a. Ord a => a -> a -> a
max AmountPrecision
p1 AmountPrecision
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 assigned prices and assuming an exchange rate of 1.
amountWithCommodity :: CommoditySymbol -> Amount -> Amount
amountWithCommodity :: CommoditySymbol -> Amount -> Amount
amountWithCommodity CommoditySymbol
c Amount
a = Amount
a{acommodity :: CommoditySymbol
acommodity=CommoditySymbol
c, aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing}

-- | Convert a amount to its "cost" or "selling price" in another commodity,
-- using its attached transaction price if it has one.  Notes:
--
-- - price amounts must be MixedAmounts with exactly one component Amount
--   (or there will be a runtime error XXX)
--
-- - price 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, aprice :: Amount -> Maybe AmountPrice
aprice=Maybe AmountPrice
mp} =
    case Maybe AmountPrice
mp of
      Maybe AmountPrice
Nothing                                  -> Amount
a
      Just (UnitPrice  p :: Amount
p@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
pq}) -> Amount
p{aquantity :: Quantity
aquantity=Quantity
pq Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
* Quantity
q}
      Just (TotalPrice p :: Amount
p@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
pq}) -> Amount
p{aquantity :: Quantity
aquantity=Quantity
pq}

-- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice.
-- Has no effect on amounts without one.
-- Also increases the unit price's display precision to show one extra decimal place,
-- to help keep transaction amounts balancing.
-- Does Decimal division, might be some rounding/irrational number issues.
amountTotalPriceToUnitPrice :: Amount -> Amount
amountTotalPriceToUnitPrice :: Amount -> Amount
amountTotalPriceToUnitPrice
    a :: Amount
a@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
q, aprice :: Amount -> Maybe AmountPrice
aprice=Just (TotalPrice pa :: Amount
pa@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
pq, astyle :: Amount -> AmountStyle
astyle=AmountStyle
ps})}
    = Amount
a{aprice :: Maybe AmountPrice
aprice = AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just (AmountPrice -> Maybe AmountPrice)
-> AmountPrice -> Maybe AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
UnitPrice Amount
pa{aquantity :: Quantity
aquantity=Quantity -> Quantity
forall a. Num a => a -> a
abs (Quantity
pqQuantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/Quantity
q), astyle :: AmountStyle
astyle=AmountStyle
ps{asprecision :: AmountPrecision
asprecision=AmountPrecision
pp}}}
  where
    -- Increase the precision by 1, capping at the max bound.
    pp :: AmountPrecision
pp = case AmountStyle -> AmountPrecision
asprecision AmountStyle
ps of
                AmountPrecision
NaturalPrecision -> AmountPrecision
NaturalPrecision
                Precision Word8
p      -> Word8 -> AmountPrecision
Precision (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ if Word8
p Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
forall a. Bounded a => a
maxBound then Word8
forall a. Bounded a => a
maxBound else Word8
p Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1
amountTotalPriceToUnitPrice Amount
a = Amount
a

-- | Apply a function to an amount's quantity (and its total price, 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,aprice :: Amount -> Maybe AmountPrice
aprice=Maybe AmountPrice
p} = Amount
a{aquantity :: Quantity
aquantity=Quantity -> Quantity
f Quantity
q, aprice :: Maybe AmountPrice
aprice=AmountPrice -> AmountPrice
f' (AmountPrice -> AmountPrice)
-> Maybe AmountPrice -> Maybe AmountPrice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AmountPrice
p}
  where
    f' :: AmountPrice -> AmountPrice
f' (TotalPrice a :: Amount
a@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
pq}) = Amount -> AmountPrice
TotalPrice Amount
a{aquantity :: Quantity
aquantity = Quantity -> Quantity
f Quantity
pq}
    f' AmountPrice
p = AmountPrice
p

-- | Divide an amount's quantity (and its total price, if it has one) by a constant.
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 price, 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)

-- | Is this amount negative ? The price 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 to its specified display precision. If that is
-- 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
p}} = case AmountPrecision
p 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 price, if it has one.
testAmountAndTotalPrice :: (Amount -> Bool) -> Amount -> Bool
testAmountAndTotalPrice :: (Amount -> Bool) -> Amount -> Bool
testAmountAndTotalPrice Amount -> Bool
f Amount
amt = case Amount -> Maybe AmountPrice
aprice Amount
amt of
    Just (TotalPrice Amount
price) -> Amount -> Bool
f Amount
amt Bool -> Bool -> Bool
&& Amount -> Bool
f Amount
price
    Maybe AmountPrice
_                       -> Amount -> Bool
f Amount
amt

-- | Do this Amount and (and its total price, if it has one) appear to be zero when rendered with its
-- display precision ?
amountLooksZero :: Amount -> Bool
amountLooksZero :: Amount -> Bool
amountLooksZero = (Amount -> Bool) -> Amount -> Bool
testAmountAndTotalPrice ((Quantity
0Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
==) (Quantity -> Bool) -> (Amount -> Quantity) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Quantity
amountRoundedQuantity)

-- | Is this Amount (and its total price, if it has one) exactly zero, ignoring its display precision ?
amountIsZero :: Amount -> Bool
amountIsZero :: Amount -> Bool
amountIsZero = (Amount -> Bool) -> Amount -> Bool
testAmountAndTotalPrice ((Quantity
0Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
==) (Quantity -> Bool) -> (Amount -> Quantity) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Quantity
aquantity)

-- | 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 :: AmountStyle
astyle=AmountStyle
s{asprecision :: AmountPrecision
asprecision=AmountPrecision
p}}

-- | Increase an amount's display precision, if needed, to enough decimal places
-- to show it exactly (showing all significant decimal digits, excluding trailing
-- zeros).
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)
-> (Quantity -> Word8) -> Quantity -> AmountPrecision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity -> Word8
forall i. DecimalRaw i -> Word8
decimalPlaces (Quantity -> Word8) -> (Quantity -> Quantity) -> Quantity -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity -> Quantity
forall i. Integral i => DecimalRaw i -> DecimalRaw i
normalizeDecimal (Quantity -> AmountPrecision) -> Quantity -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
a

-- | Set an amount's internal precision, ie rounds the Decimal representing
-- the amount's quantity to some 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)".
-- Does not change the amount's display precision.
-- Intended only for internal use, eg when comparing amounts in tests.
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{
   astyle :: AmountStyle
astyle=AmountStyle
s{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
p}
  ,aquantity :: Quantity
aquantity=Word8 -> Quantity -> Quantity
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
p Quantity
q
  }

-- | Set an amount's internal precision, flipped.
-- Intended only for internal use, eg when comparing amounts in tests.
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

-- | 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 :: AmountStyle
astyle=AmountStyle
s{asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
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

showAmountPrice :: Amount -> WideBuilder
showAmountPrice :: Amount -> WideBuilder
showAmountPrice Amount
amt = case Amount -> Maybe AmountPrice
aprice Amount
amt of
    Maybe AmountPrice
Nothing              -> WideBuilder
forall a. Monoid a => a
mempty
    Just (UnitPrice  Amount
pa) -> Builder -> Int -> WideBuilder
WideBuilder (String -> Builder
TB.fromString String
" @ ")  Int
3 WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
noColour Amount
pa
    Just (TotalPrice Amount
pa) -> Builder -> Int -> WideBuilder
WideBuilder (String -> Builder
TB.fromString String
" @@ ") Int
4 WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
noColour (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

showAmountPriceDebug :: Maybe AmountPrice -> String
showAmountPriceDebug :: Maybe AmountPrice -> String
showAmountPriceDebug Maybe AmountPrice
Nothing                = String
""
showAmountPriceDebug (Just (UnitPrice Amount
pa))  = String
" @ "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Amount -> String
showAmountDebug Amount
pa
showAmountPriceDebug (Just (TotalPrice Amount
pa)) = String
" @@ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Amount -> String
showAmountDebug Amount
pa

-- | Given a map of standard commodity display styles, apply the
-- appropriate one to this amount. If there's no standard style for
-- this amount's commodity, return the amount unchanged.
styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmount :: Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmount Map CommoditySymbol AmountStyle
styles Amount
a =
  case CommoditySymbol
-> Map CommoditySymbol AmountStyle -> Maybe AmountStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Amount -> CommoditySymbol
acommodity Amount
a) Map CommoditySymbol AmountStyle
styles of
    Just AmountStyle
s  -> Amount
a{astyle :: AmountStyle
astyle=AmountStyle
s}
    Maybe AmountStyle
Nothing -> Amount
a

-- | Like styleAmount, but keep the number of decimal places unchanged.
styleAmountExceptPrecision :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmountExceptPrecision :: Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmountExceptPrecision Map CommoditySymbol AmountStyle
styles a :: Amount
a@Amount{astyle :: Amount -> AmountStyle
astyle=AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
origp}} =
  case CommoditySymbol
-> Map CommoditySymbol AmountStyle -> Maybe AmountStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Amount -> CommoditySymbol
acommodity Amount
a) Map CommoditySymbol AmountStyle
styles of
    Just AmountStyle
s  -> Amount
a{astyle :: AmountStyle
astyle=AmountStyle
s{asprecision :: AmountPrecision
asprecision=AmountPrecision
origp}}
    Maybe AmountStyle
Nothing -> Amount
a

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

-- | Get the string representation of an amount, based on its
-- commodity's display settings. String representations equivalent to
-- zero are converted to just \"0\". The special "missing" amount is
-- displayed as the empty string.
--
-- > showAmount = wbUnpack . showAmountB noColour
showAmount :: Amount -> String
showAmount :: Amount -> String
showAmount = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (Amount -> WideBuilder) -> Amount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
noColour

-- | General function to generate a WideBuilder for an Amount, according the
-- supplied AmountDisplayOpts. The special "missing" amount is displayed as
-- the empty string. This is the main function to use for showing
-- Amounts, constructing a builder; it can then be converted to a Text with
-- wbToText, or to a String with wbUnpack.
showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder
showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
_ Amount{acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
"AUTO"} = WideBuilder
forall a. Monoid a => a
mempty
showAmountB AmountDisplayOpts
opts 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 -> WideBuilder
c' WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
space WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
quantity' WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
price
      Side
R -> WideBuilder
quantity' WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
space WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
c' WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
price
  where
    quantity :: WideBuilder
quantity = Amount -> WideBuilder
showamountquantity Amount
a
    (WideBuilder
quantity',CommoditySymbol
c) | Amount -> Bool
amountLooksZero Amount
a Bool -> Bool -> Bool
&& Bool -> Bool
not (AmountDisplayOpts -> Bool
displayZeroCommodity AmountDisplayOpts
opts) = (Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
'0') Int
1,CommoditySymbol
"")
                  | Bool
otherwise = (WideBuilder
quantity, CommoditySymbol -> CommoditySymbol
quoteCommoditySymbolIfNeeded (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
c) 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
    c' :: WideBuilder
c' = Builder -> Int -> WideBuilder
WideBuilder (CommoditySymbol -> Builder
TB.fromText CommoditySymbol
c) (CommoditySymbol -> Int
textWidth CommoditySymbol
c)
    price :: WideBuilder
price = if AmountDisplayOpts -> Bool
displayPrice AmountDisplayOpts
opts then Amount -> WideBuilder
showAmountPrice Amount
a else WideBuilder
forall a. Monoid a => a
mempty
    color :: WideBuilder -> WideBuilder
color = if AmountDisplayOpts -> Bool
displayColour AmountDisplayOpts
opts 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

-- | 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 -> String
cshowAmount = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (Amount -> WideBuilder) -> Amount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
forall a. Default a => a
def{displayColour :: Bool
displayColour=Bool
True}

-- | Get the string representation of an amount, without any \@ price.
--
-- > showAmountWithoutPrice = wbUnpack . showAmountB noPrice
showAmountWithoutPrice :: Amount -> String
showAmountWithoutPrice :: Amount -> String
showAmountWithoutPrice = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (Amount -> WideBuilder) -> Amount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
noPrice

-- | Like showAmount, but show a zero amount's commodity if it has one.
--
-- > showAmountWithZeroCommodity = wbUnpack . showAmountB noColour{displayZeryCommodity=True}
showAmountWithZeroCommodity :: Amount -> String
showAmountWithZeroCommodity :: Amount -> String
showAmountWithZeroCommodity = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (Amount -> WideBuilder) -> Amount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
noColour{displayZeroCommodity :: Bool
displayZeroCommodity=Bool
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 -> String
showAmountDebug Amount{acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
"AUTO"} = String
"(missing)"
showAmountDebug Amount{Bool
Maybe AmountPrice
Quantity
CommoditySymbol
AmountStyle
aprice :: Maybe AmountPrice
astyle :: AmountStyle
aismultiplier :: Bool
aquantity :: Quantity
acommodity :: CommoditySymbol
aismultiplier :: Amount -> Bool
astyle :: Amount -> AmountStyle
aprice :: Amount -> Maybe AmountPrice
acommodity :: Amount -> CommoditySymbol
aquantity :: Amount -> Quantity
..} = String -> String -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (CommoditySymbol -> String
forall a. Show a => a -> String
show CommoditySymbol
acommodity) (Quantity -> String
forall a. Show a => a -> String
show Quantity
aquantity) (Maybe AmountPrice -> String
showAmountPriceDebug Maybe AmountPrice
aprice) (AmountStyle -> String
forall a. Show a => a -> String
show AmountStyle
astyle)

-- | 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.
showamountquantity :: Amount -> WideBuilder
showamountquantity :: Amount -> WideBuilder
showamountquantity amt :: Amount
amt@Amount{astyle :: Amount -> AmountStyle
astyle=AmountStyle{asdecimalpoint :: AmountStyle -> Maybe Char
asdecimalpoint=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
e Integer
n = Amount -> Quantity
amountRoundedQuantity Amount
amt

    strN :: CommoditySymbol
strN = String -> CommoditySymbol
T.pack (String -> CommoditySymbol)
-> (Integer -> String) -> Integer -> CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> CommoditySymbol) -> Integer -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs Integer
n
    len :: Int
len = CommoditySymbol -> Int
T.length CommoditySymbol
strN
    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
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
e
    dec :: Char
dec = Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
'.' Maybe Char
mdec
    padded :: CommoditySymbol
padded = Int -> CommoditySymbol -> CommoditySymbol
T.replicate (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) CommoditySymbol
"0" CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol
strN
    (CommoditySymbol
intPart, CommoditySymbol
fracPart) = Int -> CommoditySymbol -> (CommoditySymbol, CommoditySymbol)
T.splitAt Int
intLen CommoditySymbol
padded

    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
e Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then CommoditySymbol
strN else CommoditySymbol
intPart
    signB :: WideBuilder
signB = if Integer
n 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
e Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0 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) (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) else WideBuilder
forall a. Monoid a => a
mempty

-- | Split a string representation into chunks according to DigitGroupStyle,
-- returning a Text builder and the number of 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
g:[Word8]
gs))) Int
l CommoditySymbol
s = NonEmpty Word8 -> Integer -> CommoditySymbol -> WideBuilder
forall a.
Integral a =>
NonEmpty a -> Integer -> CommoditySymbol -> WideBuilder
addseps (Word8
gWord8 -> [Word8] -> NonEmpty Word8
forall a. a -> [a] -> NonEmpty a
:|[Word8]
gs) (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
l) CommoditySymbol
s
  where
    addseps :: NonEmpty a -> Integer -> CommoditySymbol -> WideBuilder
addseps (a
g:|[a]
gs) Integer
l CommoditySymbol
s
        | Integer
l' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0    = NonEmpty a -> Integer -> CommoditySymbol -> WideBuilder
addseps NonEmpty a
gs' Integer
l' 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
g Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise = Builder -> Int -> WideBuilder
WideBuilder (CommoditySymbol -> Builder
TB.fromText CommoditySymbol
s) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
l)
      where
        (CommoditySymbol
rest, CommoditySymbol
part) = Int -> CommoditySymbol -> (CommoditySymbol, CommoditySymbol)
T.splitAt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
l') CommoditySymbol
s
        gs' :: NonEmpty a
gs' = NonEmpty a -> Maybe (NonEmpty a) -> NonEmpty a
forall a. a -> Maybe a -> a
fromMaybe (a
ga -> [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]
gs
        l' :: Integer
l' = Integer
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- a -> Integer
forall a. Integral a => a -> Integer
toInteger a
g

-- like journalCanonicaliseAmounts
-- | Canonicalise an amount's display style using the provided commodity style map.
canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
canonicaliseAmount :: Map CommoditySymbol AmountStyle -> Amount -> Amount
canonicaliseAmount Map CommoditySymbol AmountStyle
styles a :: Amount
a@Amount{acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
c, astyle :: Amount -> AmountStyle
astyle=AmountStyle
s} = Amount
a{astyle :: AmountStyle
astyle=AmountStyle
s'}
  where s' :: AmountStyle
s' = AmountStyle
-> CommoditySymbol
-> Map CommoditySymbol AmountStyle
-> AmountStyle
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault AmountStyle
s CommoditySymbol
c Map CommoditySymbol AmountStyle
styles

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

instance Num MixedAmount where
    fromInteger :: Integer -> MixedAmount
fromInteger Integer
i = [Amount] -> MixedAmount
Mixed [Integer -> Amount
forall a. Num a => Integer -> a
fromInteger Integer
i]
    negate :: MixedAmount -> MixedAmount
negate (Mixed [Amount]
as) = [Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Amount) -> [Amount] -> [Amount]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> Amount
forall a. Num a => a -> a
negate [Amount]
as
    + :: MixedAmount -> MixedAmount -> MixedAmount
(+) (Mixed [Amount]
as) (Mixed [Amount]
bs) = MixedAmount -> MixedAmount
normaliseMixedAmount (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ [Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ [Amount]
as [Amount] -> [Amount] -> [Amount]
forall a. [a] -> [a] -> [a]
++ [Amount]
bs
    * :: MixedAmount -> MixedAmount -> MixedAmount
(*)    = String -> MixedAmount -> MixedAmount -> MixedAmount
forall a. String -> a
error' String
"error, mixed amounts do not support multiplication" -- PARTIAL:
    abs :: MixedAmount -> MixedAmount
abs    = String -> MixedAmount -> MixedAmount
forall a. String -> a
error' String
"error, mixed amounts do not support abs"
    signum :: MixedAmount -> MixedAmount
signum = String -> MixedAmount -> MixedAmount
forall a. String -> a
error' String
"error, mixed amounts do not support signum"

-- | The empty mixed amount.
nullmixedamt :: MixedAmount
nullmixedamt :: MixedAmount
nullmixedamt = [Amount] -> MixedAmount
Mixed []

-- | A temporary value for parsed transactions which had no amount specified.
missingmixedamt :: MixedAmount
missingmixedamt :: MixedAmount
missingmixedamt = [Amount] -> MixedAmount
Mixed [Amount
missingamt]

-- | Convert amounts in various commodities into a normalised MixedAmount.
mixed :: [Amount] -> MixedAmount
mixed :: [Amount] -> MixedAmount
mixed = MixedAmount -> MixedAmount
normaliseMixedAmount (MixedAmount -> MixedAmount)
-> ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Amount] -> MixedAmount
Mixed

-- | Simplify a mixed amount's component amounts:
--
-- * amounts in the same commodity are combined unless they have different prices or total prices
--
-- * 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
--
normaliseMixedAmount :: MixedAmount -> MixedAmount
normaliseMixedAmount :: MixedAmount -> MixedAmount
normaliseMixedAmount = Bool -> MixedAmount -> MixedAmount
normaliseHelper Bool
False

normaliseHelper :: Bool -> MixedAmount -> MixedAmount
normaliseHelper :: Bool -> MixedAmount -> MixedAmount
normaliseHelper Bool
squashprices (Mixed [Amount]
as)
  | (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity))
missingkey (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity))
-> Map
     (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
-> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map
  (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
amtMap = MixedAmount
missingmixedamt -- missingamt should always be alone, but detect it even if not
  | Map
  (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
-> Bool
forall k a. Map k a -> Bool
M.null Map
  (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
nonzeros= [Amount] -> MixedAmount
Mixed [Amount
newzero]
  | Bool
otherwise      = [Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Map
  (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
-> [Amount]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map
  (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
nonzeros
  where
    newzero :: Amount
newzero = Amount
-> (((CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)),
     Amount)
    -> Amount)
-> Maybe
     ((CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)),
      Amount)
-> Amount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Amount
nullamt ((CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)),
 Amount)
-> Amount
forall a b. (a, b) -> b
snd (Maybe
   ((CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)),
    Amount)
 -> Amount)
-> (Map
      (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
    -> Maybe
         ((CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)),
          Amount))
-> Map
     (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
-> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map
  (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
-> Maybe
     ((CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)),
      Amount)
forall k a. Map k a -> Maybe (k, a)
M.lookupMin (Map
   (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
 -> Amount)
-> Map
     (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
-> Amount
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool)
-> Map
     (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
-> Map
     (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (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
  (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
zeros
    (Map
  (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
zeros, Map
  (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
nonzeros) = (Amount -> Bool)
-> Map
     (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
-> (Map
      (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount,
    Map
      (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition Amount -> Bool
amountIsZero Map
  (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
amtMap
    amtMap :: Map
  (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
amtMap = (Amount
 -> Map
      (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
 -> Map
      (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount)
-> Map
     (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
-> [Amount]
-> Map
     (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Amount
a -> (Amount -> Amount -> Amount)
-> (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity))
-> Amount
-> Map
     (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
-> Map
     (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Amount -> Amount -> Amount
sumSimilarAmountsUsingFirstPrice (Amount
-> (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity))
key Amount
a) Amount
a) Map
  (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity)) Amount
forall a. Monoid a => a
mempty [Amount]
as
    key :: Amount
-> (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity))
key Amount{acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
c,aprice :: Amount -> Maybe AmountPrice
aprice=Maybe AmountPrice
p} = (CommoditySymbol
c, if Bool
squashprices then Maybe (CommoditySymbol, Maybe Quantity)
forall a. Maybe a
Nothing else AmountPrice -> (CommoditySymbol, Maybe Quantity)
priceKey (AmountPrice -> (CommoditySymbol, Maybe Quantity))
-> Maybe AmountPrice -> Maybe (CommoditySymbol, Maybe Quantity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AmountPrice
p)
      where
        priceKey :: AmountPrice -> (CommoditySymbol, Maybe Quantity)
priceKey (UnitPrice  Amount
x) = (Amount -> CommoditySymbol
acommodity Amount
x, Quantity -> Maybe Quantity
forall a. a -> Maybe a
Just (Quantity -> Maybe Quantity) -> Quantity -> Maybe Quantity
forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
x)
        priceKey (TotalPrice Amount
x) = (Amount -> CommoditySymbol
acommodity Amount
x, Maybe Quantity
forall a. Maybe a
Nothing)
    missingkey :: (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity))
missingkey = Amount
-> (CommoditySymbol, Maybe (CommoditySymbol, Maybe Quantity))
key Amount
missingamt

-- | Like normaliseMixedAmount, but combine each commodity's amounts
-- into just one by throwing away all prices except the first. This is
-- only used as a rendering helper, and could show a misleading price.
normaliseMixedAmountSquashPricesForDisplay :: MixedAmount -> MixedAmount
normaliseMixedAmountSquashPricesForDisplay :: MixedAmount -> MixedAmount
normaliseMixedAmountSquashPricesForDisplay = Bool -> MixedAmount -> MixedAmount
normaliseHelper Bool
True

-- | Unify a MixedAmount to a single commodity value if possible.
-- Like normaliseMixedAmount, this consolidates amounts of the same commodity
-- and discards zero amounts; but this one insists on simplifying to
-- a single commodity, and will return Nothing if this is not possible.
unifyMixedAmount :: MixedAmount -> Maybe Amount
unifyMixedAmount :: 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
amount Amount
result
      | Amount -> Bool
amountIsZero Amount
amount                    = 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
amount
      | Amount -> CommoditySymbol
acommodity Amount
amount 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
amount 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
-- price to the result and discarding any other prices. Only used as a
-- rendering helper.
sumSimilarAmountsUsingFirstPrice :: Amount -> Amount -> Amount
sumSimilarAmountsUsingFirstPrice :: Amount -> Amount -> Amount
sumSimilarAmountsUsingFirstPrice Amount
a Amount
b = (Amount
a Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Amount
b){aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
p}
  where
    p :: Maybe AmountPrice
p = case (Amount -> Maybe AmountPrice
aprice Amount
a, Amount -> Maybe AmountPrice
aprice Amount
b) of
        (Just (TotalPrice Amount
ap), Just (TotalPrice Amount
bp))
          -> AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just (AmountPrice -> Maybe AmountPrice)
-> (Amount -> AmountPrice) -> Amount -> Maybe AmountPrice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> AmountPrice
TotalPrice (Amount -> Maybe AmountPrice) -> Amount -> Maybe AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount
ap{aquantity :: Quantity
aquantity = Amount -> Quantity
aquantity Amount
ap Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
+ Amount -> Quantity
aquantity Amount
bp }
        (Maybe AmountPrice, Maybe AmountPrice)
_ -> Amount -> Maybe AmountPrice
aprice Amount
a

-- -- | Sum same-commodity amounts. If there were different prices, set
-- -- the price to a special marker indicating "various". Only used as a
-- -- rendering helper.
-- sumSimilarAmountsNotingPriceDifference :: [Amount] -> Amount
-- sumSimilarAmountsNotingPriceDifference [] = nullamt
-- sumSimilarAmountsNotingPriceDifference as = undefined

-- | Get a mixed amount's component amounts.
amounts :: MixedAmount -> [Amount]
amounts :: MixedAmount -> [Amount]
amounts (Mixed [Amount]
as) = [Amount]
as

-- | 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 [Amount]
as) = [Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool) -> [Amount] -> [Amount]
forall a. (a -> Bool) -> [a] -> [a]
filter Amount -> Bool
p [Amount]
as

-- | Return an unnormalised MixedAmount containing exactly one Amount
-- with the specified commodity and the quantity of that commodity
-- found in the original. NB if Amount's quantity is zero it will be
-- discarded next time the MixedAmount gets normalised.
filterMixedAmountByCommodity :: CommoditySymbol -> MixedAmount -> MixedAmount
filterMixedAmountByCommodity :: CommoditySymbol -> MixedAmount -> MixedAmount
filterMixedAmountByCommodity CommoditySymbol
c (Mixed [Amount]
as) = [Amount] -> MixedAmount
Mixed [Amount]
as'
  where
    as' :: [Amount]
as' = case (Amount -> Bool) -> [Amount] -> [Amount]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
==CommoditySymbol
c) (CommoditySymbol -> Bool)
-> (Amount -> CommoditySymbol) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> CommoditySymbol
acommodity) [Amount]
as of
            []   -> [Amount
nullamt{acommodity :: CommoditySymbol
acommodity=CommoditySymbol
c}]
            [Amount]
as'' -> [[Amount] -> Amount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Amount]
as'']

-- | 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 [Amount]
as) = [Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Amount) -> [Amount] -> [Amount]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> Amount
f [Amount]
as

-- | Convert all component amounts to cost/selling price where
-- possible (see amountCost).
mixedAmountCost :: MixedAmount -> MixedAmount
mixedAmountCost :: MixedAmount -> MixedAmount
mixedAmountCost = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount Amount -> Amount
amountCost

-- | Divide a mixed amount's quantities (and total prices, if any) by a constant.
divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount
divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount
divideMixedAmount Quantity
n = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount (Quantity -> Amount -> Amount
divideAmount Quantity
n)

-- | Multiply a mixed amount's quantities (and total prices, if any) by a constant.
multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount
multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount
multiplyMixedAmount Quantity
n = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount (Quantity -> Amount -> Amount
multiplyAmount Quantity
n)

-- | Calculate the average of some mixed amounts.
averageMixedAmounts :: [MixedAmount] -> MixedAmount
averageMixedAmounts :: [MixedAmount] -> MixedAmount
averageMixedAmounts [] = MixedAmount
0
averageMixedAmounts [MixedAmount]
as = Int -> Quantity
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([MixedAmount] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MixedAmount]
as) Quantity -> MixedAmount -> MixedAmount
`divideMixedAmount` [MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [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
normaliseMixedAmountSquashPricesForDisplay 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?
-- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),
-- and zero quantity for each unit price?
mixedAmountLooksZero :: MixedAmount -> Bool
mixedAmountLooksZero :: MixedAmount -> Bool
mixedAmountLooksZero = (Amount -> Bool) -> [Amount] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Amount -> Bool
amountLooksZero ([Amount] -> Bool)
-> (MixedAmount -> [Amount]) -> MixedAmount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount])
-> (MixedAmount -> MixedAmount) -> MixedAmount -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> MixedAmount
normaliseMixedAmountSquashPricesForDisplay

-- | Is this mixed amount exactly to be zero, ignoring its display precision?
-- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),
-- and zero quantity for each unit price?
mixedAmountIsZero :: MixedAmount -> Bool
mixedAmountIsZero :: MixedAmount -> Bool
mixedAmountIsZero = (Amount -> Bool) -> [Amount] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Amount -> Bool
amountIsZero ([Amount] -> Bool)
-> (MixedAmount -> [Amount]) -> MixedAmount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount])
-> (MixedAmount -> MixedAmount) -> MixedAmount -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> MixedAmount
normaliseMixedAmountSquashPricesForDisplay

-- -- | 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' = normaliseMixedAmountSquashPricesForDisplay a
--           b' = normaliseMixedAmountSquashPricesForDisplay b

-- | Given a map of standard commodity display styles, apply the
-- appropriate one to each individual amount.
styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount :: Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount Map CommoditySymbol AmountStyle
styles = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount (Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmount Map CommoditySymbol AmountStyle
styles)

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

-- | Get the string representation of a mixed amount, after
-- normalising it to one amount per commodity. Assumes amounts have
-- no or similar prices, otherwise this can show misleading prices.
--
-- > showMixedAmount = wbUnpack . showMixedAmountB noColour
showMixedAmount :: MixedAmount -> String
showMixedAmount :: MixedAmount -> String
showMixedAmount = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour

-- | Get the one-line string representation of a mixed amount.
--
-- > showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLine
showMixedAmountOneLine :: MixedAmount -> String
showMixedAmountOneLine :: MixedAmount -> String
showMixedAmountOneLine = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
oneLine

-- | Like showMixedAmount, but zero amounts are shown with their
-- commodity if they have one.
--
-- > showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZeroCommodity=True}
showMixedAmountWithZeroCommodity :: MixedAmount -> String
showMixedAmountWithZeroCommodity :: MixedAmount -> String
showMixedAmountWithZeroCommodity = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour{displayZeroCommodity :: Bool
displayZeroCommodity=Bool
True}

-- | Get the string representation of a mixed amount, without showing any transaction prices.
-- With a True argument, adds ANSI codes to show negative amounts in red.
--
-- > showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noPrice{displayColour=c}
showMixedAmountWithoutPrice :: Bool -> MixedAmount -> String
showMixedAmountWithoutPrice :: Bool -> MixedAmount -> String
showMixedAmountWithoutPrice Bool
c = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noPrice{displayColour :: Bool
displayColour=Bool
c}

-- | Get the one-line string representation of a mixed amount, but without
-- any \@ prices.
-- With a True argument, adds ANSI codes to show negative amounts in red.
--
-- > showMixedAmountOneLineWithoutPrice c = wbUnpack . showMixedAmountB oneLine{displayColour=c}
showMixedAmountOneLineWithoutPrice :: Bool -> MixedAmount -> String
showMixedAmountOneLineWithoutPrice :: Bool -> MixedAmount -> String
showMixedAmountOneLineWithoutPrice Bool
c = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
oneLine{displayColour :: Bool
displayColour=Bool
c}

-- | Like showMixedAmountOneLineWithoutPrice, 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.
--
-- > showMixedAmountElided w c = wbUnpack . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w}
showMixedAmountElided :: Int -> Bool -> MixedAmount -> String
showMixedAmountElided :: Int -> Bool -> MixedAmount -> String
showMixedAmountElided Int
w Bool
c = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
oneLine{displayColour :: Bool
displayColour=Bool
c, displayMaxWidth :: Maybe Int
displayMaxWidth=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w}

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

-- | General function to generate a WideBuilder for a MixedAmount, according the
-- supplied AmountDisplayOpts. This is the main function to use for showing
-- MixedAmounts, constructing a builder; it can then be converted to a Text with
-- wbToText, or to a String with wbUnpack.
--
-- 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.
-- - If displayed on multiple lines, any Amounts longer than the
--   maximum width will be elided.
showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
opts MixedAmount
ma
    | AmountDisplayOpts -> Bool
displayOneLine AmountDisplayOpts
opts = AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountOneLineB AmountDisplayOpts
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]
lines) Int
width
  where
    ma' :: MixedAmount
ma' = if AmountDisplayOpts -> Bool
displayPrice AmountDisplayOpts
opts then MixedAmount
ma else MixedAmount -> MixedAmount
mixedAmountStripPrices MixedAmount
ma
    lines :: [WideBuilder]
lines = AmountDisplayOpts -> MixedAmount -> [WideBuilder]
showMixedAmountLinesB AmountDisplayOpts
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]
lines
    sep :: WideBuilder
sep = Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
'\n') Int
0

-- | Helper for showMixedAmountB to show a MixedAmount on multiple lines. This returns
-- the list of WideBuilders: one for each Amount in the MixedAmount (possibly
-- normalised), and padded/elided to the appropriate width. This does not
-- honour displayOneLine: all amounts will be displayed as if displayOneLine
-- were False.
showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [WideBuilder]
showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [WideBuilder]
showMixedAmountLinesB opts :: AmountDisplayOpts
opts@AmountDisplayOpts{displayMaxWidth :: AmountDisplayOpts -> Maybe Int
displayMaxWidth=Maybe Int
mmax,displayMinWidth :: AmountDisplayOpts -> Maybe Int
displayMinWidth=Maybe Int
mmin} MixedAmount
ma =
    (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
  where
    Mixed [Amount]
amts = if AmountDisplayOpts -> Bool
displayNormalised AmountDisplayOpts
opts then MixedAmount -> MixedAmount
normaliseMixedAmountSquashPricesForDisplay MixedAmount
ma else MixedAmount
ma

    astrs :: [AmountDisplay]
astrs = Int -> (Amount -> WideBuilder) -> [Amount] -> [AmountDisplay]
amtDisplayList (WideBuilder -> Int
wbWidth WideBuilder
sep) (AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
opts) [Amount]
amts
    sep :: WideBuilder
sep   = Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
'\n') Int
0
    width :: Int
width = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
mmin Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (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 = AmountDisplay
amt{ adBuilder :: WideBuilder
adBuilder = 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
<> AmountDisplay -> WideBuilder
adBuilder AmountDisplay
amt }
      where w :: Int
w = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth (AmountDisplay -> WideBuilder
adBuilder 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 (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 :: AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountOneLineB :: AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountOneLineB opts :: AmountDisplayOpts
opts@AmountDisplayOpts{displayMaxWidth :: AmountDisplayOpts -> Maybe Int
displayMaxWidth=Maybe Int
mmax,displayMinWidth :: AmountDisplayOpts -> 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
    Mixed [Amount]
amts = if AmountDisplayOpts -> Bool
displayNormalised AmountDisplayOpts
opts then MixedAmount -> MixedAmount
normaliseMixedAmountSquashPricesForDisplay MixedAmount
ma else MixedAmount
ma

    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) (AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
opts) [Amount]
amts
    sep :: WideBuilder
sep    = Builder -> Int -> WideBuilder
WideBuilder (String -> Builder
TB.fromString String
", ") Int
2
    n :: Int
n      = [Amount] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Amount]
amts

    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)]
forall (t :: * -> *).
Foldable t =>
Int
-> t (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. [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)
    takeFitting :: Int
-> t (AmountDisplay, Maybe AmountDisplay)
-> [(AmountDisplay, Maybe AmountDisplay)]
takeFitting Int
m = ((AmountDisplay, Maybe AmountDisplay) -> Bool)
-> t (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))
    dropWhileRev :: (a -> Bool) -> t a -> [a]
dropWhileRev a -> Bool
p = (a -> [a] -> [a]) -> [a] -> t a -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x [a]
xs -> if [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
num 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
num 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]

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
  }

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 :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
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 = String -> CommoditySymbol
T.pack (String -> CommoditySymbol) -> String -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" more.."
    -- sep from the separator, 7 from " more..", 1 + floor (logBase 10 n) from number
    fullLength :: Int
fullLength = Int
sep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 :: 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])

-- | Compact labelled trace of a mixed amount, for debugging.
ltraceamount :: String -> MixedAmount -> MixedAmount
ltraceamount :: String -> MixedAmount -> MixedAmount
ltraceamount String
s = (MixedAmount -> String) -> MixedAmount -> MixedAmount
forall a. Show a => (a -> String) -> a -> a
traceWith (((String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": ") String -> ShowS
forall a. [a] -> [a] -> [a]
++)ShowS -> (MixedAmount -> String) -> MixedAmount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MixedAmount -> String
showMixedAmount)

-- | Set the display precision in the amount's commodities.
mixedAmountSetPrecision :: AmountPrecision -> MixedAmount -> MixedAmount
mixedAmountSetPrecision :: AmountPrecision -> MixedAmount -> MixedAmount
mixedAmountSetPrecision AmountPrecision
p = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount (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
mapMixedAmount Amount -> Amount
amountSetFullPrecision

mixedAmountStripPrices :: MixedAmount -> MixedAmount
mixedAmountStripPrices :: MixedAmount -> MixedAmount
mixedAmountStripPrices = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount (\Amount
a -> Amount
a{aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing})

-- | Canonicalise a mixed amount's display styles using the provided commodity style map.
canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount :: Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount Map CommoditySymbol AmountStyle
styles = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount (Map CommoditySymbol AmountStyle -> Amount -> Amount
canonicaliseAmount Map CommoditySymbol AmountStyle
styles)

-- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice.
-- Has no effect on amounts without one.
-- Does Decimal division, might be some rounding/irrational number issues.
mixedAmountTotalPriceToUnitPrice :: MixedAmount -> MixedAmount
mixedAmountTotalPriceToUnitPrice :: MixedAmount -> MixedAmount
mixedAmountTotalPriceToUnitPrice = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount Amount -> Amount
amountTotalPriceToUnitPrice


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

tests_Amount :: TestTree
tests_Amount = String -> [TestTree] -> TestTree
tests String
"Amount" [
   String -> [TestTree] -> TestTree
tests String
"Amount" [

     String -> Assertion -> TestTree
test String
"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){aprice :: Maybe AmountPrice
aprice=AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just (AmountPrice -> Maybe AmountPrice)
-> AmountPrice -> Maybe AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
UnitPrice (Amount -> AmountPrice) -> Amount -> AmountPrice
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
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){aprice :: Maybe AmountPrice
aprice=AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just (AmountPrice -> Maybe AmountPrice)
-> AmountPrice -> Maybe AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
TotalPrice (Amount -> AmountPrice) -> Amount -> AmountPrice
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
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)){aprice :: Maybe AmountPrice
aprice=AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just (AmountPrice -> Maybe AmountPrice)
-> AmountPrice -> Maybe AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
TotalPrice (Amount -> AmountPrice) -> Amount -> AmountPrice
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd (-Quantity
2)} Amount -> Amount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Quantity -> Amount
usd (-Quantity
2)

    ,String -> Assertion -> TestTree
test String
"amountLooksZero" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
       HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Amount -> Bool
amountLooksZero Amount
amount
       HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (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

    ,String -> Assertion -> TestTree
test String
"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 :: Quantity
aquantity= -Quantity
1}
       let b :: Amount
b = (Quantity -> Amount
usd Quantity
1){aprice :: Maybe AmountPrice
aprice=AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just (AmountPrice -> Maybe AmountPrice)
-> AmountPrice -> Maybe AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
UnitPrice (Amount -> AmountPrice) -> Amount -> AmountPrice
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
eur Quantity
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 :: Quantity
aquantity= -Quantity
1}

    ,String -> Assertion -> TestTree
test String
"adding amounts without prices" (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 (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 (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 (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 => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (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)

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

  ]

  ,String -> [TestTree] -> TestTree
tests String
"MixedAmount" [

     String -> Assertion -> TestTree
test String
"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 :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Amount -> MixedAmount) -> [Amount] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map ([Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount)
-> (Amount -> [Amount]) -> Amount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> [Amount] -> [Amount]
forall a. a -> [a] -> [a]
:[]))
               [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
Mixed [Quantity -> Amount
usd Quantity
0 Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
3]

    ,String -> Assertion -> TestTree
test String
"adding mixed amounts with total prices" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      [MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Amount -> MixedAmount) -> [Amount] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map ([Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount)
-> (Amount -> [Amount]) -> Amount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> [Amount] -> [Amount]
forall a. a -> [a] -> [a]
:[]))
       [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
Mixed [Quantity -> Amount
usd (-Quantity
1) Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
2 ]

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

    ,String -> Assertion -> TestTree
test String
"showMixedAmountWithoutPrice" (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 -> String
showMixedAmountWithoutPrice Bool
False ([Amount] -> MixedAmount
Mixed [Amount
a]) String -> String -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= String
"$1.00"
      Bool -> MixedAmount -> String
showMixedAmountWithoutPrice Bool
False ([Amount] -> MixedAmount
Mixed [Amount
a, -Amount
a]) String -> String -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= String
"0"

    ,String -> [TestTree] -> TestTree
tests String
"normaliseMixedAmount" [
       String -> Assertion -> TestTree
test String
"a missing amount overrides any other amounts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> MixedAmount
normaliseMixedAmount ([Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1, Amount
missingamt]) MixedAmount -> MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= MixedAmount
missingmixedamt
      ,String -> Assertion -> TestTree
test String
"unpriced same-commodity amounts are combined" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> MixedAmount
normaliseMixedAmount ([Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
0, Quantity -> Amount
usd Quantity
2]) MixedAmount -> MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
2]
      ,String -> Assertion -> TestTree
test String
"amounts with same unit price are combined" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> MixedAmount
normaliseMixedAmount ([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]) MixedAmount -> MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
2 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1]
      ,String -> Assertion -> TestTree
test String
"amounts with different unit prices are not combined" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> MixedAmount
normaliseMixedAmount ([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]) MixedAmount -> MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [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]
      ,String -> Assertion -> TestTree
test String
"amounts with total prices are combined" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> MixedAmount
normaliseMixedAmount ([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]) MixedAmount -> MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
2 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
2]
    ]

    ,String -> Assertion -> TestTree
test String
"normaliseMixedAmountSquashPricesForDisplay" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
       MixedAmount -> MixedAmount
normaliseMixedAmountSquashPricesForDisplay ([Amount] -> MixedAmount
Mixed []) MixedAmount -> MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Amount] -> MixedAmount
Mixed [Amount
nullamt]
       HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (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
normaliseMixedAmountSquashPricesForDisplay
        ([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
               ])

  ]

 ]