{-|
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
@

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

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

-}

{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}

module Hledger.Data.Amount (
  -- * Commodity
  showCommoditySymbol,
  isNonsimpleCommodityChar,
  quoteCommoditySymbolIfNeeded,
  -- * 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,
  amountStripPrices,
  canonicaliseAmount,
  -- * MixedAmount
  nullmixedamt,
  missingmixedamt,
  isMissingMixedAmount,
  mixed,
  mixedAmount,
  maAddAmount,
  maAddAmounts,
  amounts,
  amountsRaw,
  maCommodities,
  filterMixedAmount,
  filterMixedAmountByCommodity,
  mapMixedAmount,
  unifyMixedAmount,
  mixedAmountStripPrices,
  -- ** arithmetic
  mixedAmountCost,
  maNegate,
  maPlus,
  maMinus,
  maSum,
  divideMixedAmount,
  multiplyMixedAmount,
  averageMixedAmounts,
  isNegativeAmount,
  isNegativeMixedAmount,
  mixedAmountIsZero,
  maIsZero,
  maIsNonZero,
  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.Applicative (liftA2)
import Control.Monad (foldM)
import Data.Char (isDigit)
import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
import Data.Default (Default(..))
import Data.Foldable (toList)
import Data.List (find, foldl', intercalate, intersperse, mapAccumL, partition)
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Data.Maybe (fromMaybe, isNothing, isJust)
import Data.Semigroup (Semigroup(..))
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TB
import Data.Word (Word8)
import Safe (headDef, lastDef, lastMay)
import System.Console.ANSI (Color(..),ColorIntensity(..))

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

import Hledger.Data.Types
import Hledger.Utils (colorB)
import Hledger.Utils.Text (textQuoteIfNeeded)
import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack)


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

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

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

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


-- | 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
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
  -- | Display amounts in this order (without the commodity symbol) and display
  -- a 0 in case a corresponding commodity does not exist
  , AmountDisplayOpts -> Maybe [Text]
displayOrder         :: Maybe [CommoditySymbol]
  } 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
-> Maybe Int
-> Maybe Int
-> Maybe [Text]
-> AmountDisplayOpts
AmountDisplayOpts { displayPrice :: Bool
displayPrice         = Bool
True
                             , displayColour :: Bool
displayColour        = Bool
False
                             , displayZeroCommodity :: Bool
displayZeroCommodity = Bool
False
                             , displayOneLine :: Bool
displayOneLine       = Bool
False
                             , displayMinWidth :: Maybe Int
displayMinWidth      = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
                             , displayMaxWidth :: Maybe Int
displayMaxWidth      = Maybe Int
forall a. Maybe a
Nothing
                             , displayOrder :: Maybe [Text]
displayOrder         = Maybe [Text]
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                       = (Quantity -> Quantity) -> Amount -> Amount
transformAmount Quantity -> Quantity
forall a. Num a => a -> a
negate
    + :: Amount -> Amount -> Amount
(+)                          = (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount
similarAmountsOp Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
(+)
    (-)                          = (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount
similarAmountsOp (-)
    * :: Amount -> Amount -> Amount
(*)                          = (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount
similarAmountsOp Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
(*)

-- | The empty simple amount.
amount, nullamt :: Amount
amount :: Amount
amount = Amount :: Text -> Quantity -> AmountStyle -> Maybe AmountPrice -> Amount
Amount{acommodity :: Text
acommodity=Text
"", aquantity :: Quantity
aquantity=Quantity
0, aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing, astyle :: AmountStyle
astyle=AmountStyle
amountstyle}
nullamt :: Amount
nullamt = Amount
amount

-- | A temporary value for parsed transactions which had no amount specified.
missingamt :: Amount
missingamt :: Amount
missingamt = Amount
amount{acommodity :: Text
acommodity=Text
"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 :: Text
acommodity=Text
"",  aquantity :: Quantity
aquantity=Quantity
n}
hrs :: Quantity -> Amount
hrs Quantity
n = Amount
amount{acommodity :: Text
acommodity=Text
"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 :: Text
acommodity=Text
"$", 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 :: Text
acommodity=Text
"€", 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 :: Text
acommodity=Text
"£", 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 :: Text
acommodity=Text
"%", 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 -> Text
acommodity=Text
_,  aquantity :: Amount -> Quantity
aquantity=Quantity
q1, astyle :: Amount -> AmountStyle
astyle=AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
p1}}
                    Amount{acommodity :: Amount -> Text
acommodity=Text
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 :: Text
acommodity=Text
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 :: Text -> Amount -> Amount
amountWithCommodity Text
c Amount
a = Amount
a{acommodity :: Text
acommodity=Text
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 Amount -> Bool
looksZero
  where
    looksZero :: Amount -> Bool
looksZero Amount{aquantity :: Amount -> Quantity
aquantity=Decimal Word8
e Integer
q, astyle :: Amount -> AmountStyle
astyle=AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
p}} = case AmountPrecision
p of
        Precision Word8
d      -> if Word8
e Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
d then Integer -> Integer
forall a. Num a => a -> a
abs Integer
q Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
5Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
10Integer -> Word8 -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Word8
eWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
dWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
1) else Integer
q Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
        AmountPrecision
NaturalPrecision -> Integer
q Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0

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

-- | 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 mainly 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 mainly 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

-- | Strip all prices from an Amount
amountStripPrices :: Amount -> Amount
amountStripPrices :: Amount -> Amount
amountStripPrices Amount
a = Amount
a{aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing}

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.
-- Also apply the style to the price (except for precision)
styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmount :: Map Text AmountStyle -> Amount -> Amount
styleAmount Map Text AmountStyle
styles Amount
a = Amount
styledAmount{aprice :: Maybe AmountPrice
aprice = Map Text AmountStyle -> Maybe AmountPrice -> Maybe AmountPrice
stylePrice Map Text AmountStyle
styles (Amount -> Maybe AmountPrice
aprice Amount
styledAmount)}
  where
    styledAmount :: Amount
styledAmount = case Text -> Map Text AmountStyle -> Maybe AmountStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Amount -> Text
acommodity Amount
a) Map Text AmountStyle
styles of
      Just AmountStyle
s -> Amount
a{astyle :: AmountStyle
astyle=AmountStyle
s}
      Maybe AmountStyle
Nothing -> Amount
a

stylePrice :: M.Map CommoditySymbol AmountStyle -> Maybe AmountPrice -> Maybe AmountPrice
stylePrice :: Map Text AmountStyle -> Maybe AmountPrice -> Maybe AmountPrice
stylePrice Map Text AmountStyle
styles (Just (UnitPrice Amount
a)) = AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just (Amount -> AmountPrice
UnitPrice (Amount -> AmountPrice) -> Amount -> AmountPrice
forall a b. (a -> b) -> a -> b
$ Map Text AmountStyle -> Amount -> Amount
styleAmountExceptPrecision Map Text AmountStyle
styles Amount
a)
stylePrice Map Text AmountStyle
styles (Just (TotalPrice Amount
a)) = AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just (Amount -> AmountPrice
TotalPrice (Amount -> AmountPrice) -> Amount -> AmountPrice
forall a b. (a -> b) -> a -> b
$ Map Text AmountStyle -> Amount -> Amount
styleAmountExceptPrecision Map Text AmountStyle
styles Amount
a)
stylePrice Map Text AmountStyle
_ Maybe AmountPrice
_  = Maybe AmountPrice
forall a. Maybe a
Nothing

-- | Like styleAmount, but keep the number of decimal places unchanged.
styleAmountExceptPrecision :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmountExceptPrecision :: Map Text AmountStyle -> Amount -> Amount
styleAmountExceptPrecision Map Text AmountStyle
styles a :: Amount
a@Amount{astyle :: Amount -> AmountStyle
astyle=AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
origp}} =
  case Text -> Map Text AmountStyle -> Maybe AmountStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Amount -> Text
acommodity Amount
a) Map Text 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 -> Text
acommodity=Text
"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 -> WideBuilder -> WideBuilder
forall p. Monoid p => p -> p -> p
showC (Text -> WideBuilder
wbFromText Text
c) 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 -> WideBuilder -> WideBuilder
forall p. Monoid p => p -> p -> p
showC WideBuilder
space (Text -> WideBuilder
wbFromText Text
c) WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
price
  where
    quantity :: WideBuilder
quantity = Amount -> WideBuilder
showamountquantity Amount
a
    (WideBuilder
quantity',Text
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,Text
"")
                  | Bool
otherwise = (WideBuilder
quantity, Text -> Text
quoteCommoditySymbolIfNeeded (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Amount -> Text
acommodity Amount
a)
    space :: WideBuilder
space = if Bool -> Bool
not (Text -> Bool
T.null Text
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
    showC :: p -> p -> p
showC p
l p
r = if Maybe [Text] -> Bool
forall a. Maybe a -> Bool
isJust (AmountDisplayOpts -> Maybe [Text]
displayOrder AmountDisplayOpts
opts) then p
forall a. Monoid a => a
mempty else p
l p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
r
    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 -> Text
acommodity=Text
"AUTO"} = String
"(missing)"
showAmountDebug Amount{Maybe AmountPrice
Quantity
Text
AmountStyle
aprice :: Maybe AmountPrice
astyle :: AmountStyle
aquantity :: Quantity
acommodity :: Text
astyle :: Amount -> AmountStyle
aprice :: Amount -> Maybe AmountPrice
acommodity :: Amount -> Text
aquantity :: Amount -> Quantity
..} =
      String
"Amount {acommodity=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
acommodity String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", aquantity=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Quantity -> String
forall a. Show a => a -> String
show Quantity
aquantity
   String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", aprice=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe AmountPrice -> String
showAmountPriceDebug Maybe AmountPrice
aprice String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", astyle=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ AmountStyle -> String
forall a. Show a => a -> String
show AmountStyle
astyle String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"

-- | 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 :: Text
strN = String -> Text
T.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs Integer
n
    len :: Int
len = Text -> Int
T.length Text
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 :: Text
padded = Int -> Text -> Text
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) Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
strN
    (Text
intPart, Text
fracPart) = Int -> Text -> (Text, Text)
T.splitAt Int
intLen Text
padded

    intB :: WideBuilder
intB = Maybe DigitGroupStyle -> Int -> Text -> WideBuilder
applyDigitGroupStyle Maybe DigitGroupStyle
mgrps Int
intLen (Text -> WideBuilder) -> Text -> WideBuilder
forall a b. (a -> b) -> a -> b
$ if Word8
e Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then Text
strN else Text
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
<> Text -> Builder
TB.fromText Text
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 -> Text -> WideBuilder
applyDigitGroupStyle Maybe DigitGroupStyle
Nothing                       Int
l Text
s = Builder -> Int -> WideBuilder
WideBuilder (Text -> Builder
TB.fromText Text
s) Int
l
applyDigitGroupStyle (Just (DigitGroups Char
_ []))     Int
l Text
s = Builder -> Int -> WideBuilder
WideBuilder (Text -> Builder
TB.fromText Text
s) Int
l
applyDigitGroupStyle (Just (DigitGroups Char
c (Word8
g:[Word8]
gs))) Int
l Text
s = NonEmpty Word8 -> Integer -> Text -> WideBuilder
forall a.
Integral a =>
NonEmpty a -> Integer -> Text -> 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) Text
s
  where
    addseps :: NonEmpty a -> Integer -> Text -> WideBuilder
addseps (a
g:|[a]
gs) Integer
l Text
s
        | Integer
l' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0    = NonEmpty a -> Integer -> Text -> WideBuilder
addseps NonEmpty a
gs' Integer
l' Text
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
<> Text -> Builder
TB.fromText Text
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 (Text -> Builder
TB.fromText Text
s) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
l)
      where
        (Text
rest, Text
part) = Int -> Text -> (Text, Text)
T.splitAt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
l') Text
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 Text AmountStyle -> Amount -> Amount
canonicaliseAmount Map Text AmountStyle
styles a :: Amount
a@Amount{acommodity :: Amount -> Text
acommodity=Text
c, astyle :: Amount -> AmountStyle
astyle=AmountStyle
s} = Amount
a{astyle :: AmountStyle
astyle=AmountStyle
s'}
  where s' :: AmountStyle
s' = AmountStyle -> Text -> Map Text AmountStyle -> AmountStyle
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault AmountStyle
s Text
c Map Text AmountStyle
styles

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

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

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

instance Num MixedAmount where
    fromInteger :: Integer -> MixedAmount
fromInteger = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount)
-> (Integer -> Amount) -> Integer -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Amount
forall a. Num a => Integer -> a
fromInteger
    negate :: MixedAmount -> MixedAmount
negate = MixedAmount -> MixedAmount
maNegate
    + :: MixedAmount -> MixedAmount -> MixedAmount
(+)    = MixedAmount -> MixedAmount -> MixedAmount
maPlus
    * :: MixedAmount -> MixedAmount -> MixedAmount
(*)    = String -> MixedAmount -> MixedAmount -> MixedAmount
forall a. HasCallStack => String -> a
error String
"error, mixed amounts do not support multiplication" -- PARTIAL:
    abs :: MixedAmount -> MixedAmount
abs    = String -> MixedAmount -> MixedAmount
forall a. HasCallStack => String -> a
error String
"error, mixed amounts do not support abs"
    signum :: MixedAmount -> MixedAmount
signum = String -> MixedAmount -> MixedAmount
forall a. HasCallStack => String -> a
error String
"error, mixed amounts do not support signum"

-- | Calculate the key used to store an Amount within a MixedAmount.
amountKey :: Amount -> MixedAmountKey
amountKey :: Amount -> MixedAmountKey
amountKey amt :: Amount
amt@Amount{acommodity :: Amount -> Text
acommodity=Text
c} = case Amount -> Maybe AmountPrice
aprice Amount
amt of
    Maybe AmountPrice
Nothing             -> Text -> MixedAmountKey
MixedAmountKeyNoPrice    Text
c
    Just (TotalPrice Amount
p) -> Text -> Text -> MixedAmountKey
MixedAmountKeyTotalPrice Text
c (Amount -> Text
acommodity Amount
p)
    Just (UnitPrice  Amount
p) -> Text -> Text -> Quantity -> MixedAmountKey
MixedAmountKeyUnitPrice  Text
c (Amount -> Text
acommodity Amount
p) (Amount -> Quantity
aquantity Amount
p)

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

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

-- | Whether a MixedAmount has a missing amount
isMissingMixedAmount :: MixedAmount -> Bool
isMissingMixedAmount :: MixedAmount -> Bool
isMissingMixedAmount (Mixed Map MixedAmountKey Amount
ma) = Amount -> MixedAmountKey
amountKey Amount
missingamt MixedAmountKey -> Map MixedAmountKey Amount -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map MixedAmountKey Amount
ma

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

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

-- | Add an Amount to a MixedAmount, normalising the result.
maAddAmount :: MixedAmount -> Amount -> MixedAmount
maAddAmount :: MixedAmount -> Amount -> MixedAmount
maAddAmount (Mixed Map MixedAmountKey Amount
ma) Amount
a = Map MixedAmountKey Amount -> MixedAmount
Mixed (Map MixedAmountKey Amount -> MixedAmount)
-> Map MixedAmountKey Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Amount -> Amount)
-> MixedAmountKey
-> Amount
-> Map MixedAmountKey Amount
-> Map MixedAmountKey Amount
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Amount -> Amount -> Amount
sumSimilarAmountsUsingFirstPrice (Amount -> MixedAmountKey
amountKey Amount
a) Amount
a Map MixedAmountKey Amount
ma

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

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

-- | Sum two MixedAmount.
maPlus :: MixedAmount -> MixedAmount -> MixedAmount
maPlus :: MixedAmount -> MixedAmount -> MixedAmount
maPlus (Mixed Map MixedAmountKey Amount
as) (Mixed Map MixedAmountKey Amount
bs) = Map MixedAmountKey Amount -> MixedAmount
Mixed (Map MixedAmountKey Amount -> MixedAmount)
-> Map MixedAmountKey Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Amount -> Amount)
-> Map MixedAmountKey Amount
-> Map MixedAmountKey Amount
-> Map MixedAmountKey Amount
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Amount -> Amount -> Amount
sumSimilarAmountsUsingFirstPrice Map MixedAmountKey Amount
as Map MixedAmountKey Amount
bs

-- | Subtract a MixedAmount from another.
maMinus :: MixedAmount -> MixedAmount -> MixedAmount
maMinus :: MixedAmount -> MixedAmount -> MixedAmount
maMinus MixedAmount
a = MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
a (MixedAmount -> MixedAmount)
-> (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> MixedAmount
maNegate

-- | Sum a collection of MixedAmounts.
maSum :: Foldable t => t MixedAmount -> MixedAmount
maSum :: t MixedAmount -> MixedAmount
maSum = (MixedAmount -> MixedAmount -> MixedAmount)
-> MixedAmount -> t MixedAmount -> MixedAmount
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
nullmixedamt

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

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

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

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

-- | Is this mixed amount negative, if we can tell that unambiguously?
-- Ie when normalised, are all individual commodity amounts negative ?
isNegativeMixedAmount :: MixedAmount -> Maybe Bool
isNegativeMixedAmount :: MixedAmount -> Maybe Bool
isNegativeMixedAmount MixedAmount
m =
  case MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
mixedAmountStripPrices 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 (Mixed Map MixedAmountKey Amount
ma) = (Amount -> Bool) -> Map MixedAmountKey Amount -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Amount -> Bool
amountLooksZero Map MixedAmountKey Amount
ma

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

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

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

-- | Get a mixed amount's component amounts.
--
-- * 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
--
amounts :: MixedAmount -> [Amount]
amounts :: MixedAmount -> [Amount]
amounts (Mixed Map MixedAmountKey Amount
ma)
  | MixedAmount -> Bool
isMissingMixedAmount (Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
ma) = [Amount
missingamt]  -- missingamt should always be alone, but detect it even if not
  | Map MixedAmountKey Amount -> Bool
forall k a. Map k a -> Bool
M.null Map MixedAmountKey Amount
nonzeros                 = [Amount
newzero]
  | Bool
otherwise                       = Map MixedAmountKey Amount -> [Amount]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map MixedAmountKey Amount
nonzeros
  where
    newzero :: Amount
newzero = Amount -> Maybe Amount -> Amount
forall a. a -> Maybe a -> a
fromMaybe Amount
nullamt (Maybe Amount -> Amount) -> Maybe Amount -> Amount
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool) -> Map MixedAmountKey Amount -> Maybe Amount
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
not (Bool -> Bool) -> (Amount -> Bool) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null (Text -> Bool) -> (Amount -> Text) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Text
acommodity) Map MixedAmountKey Amount
zeros
    (Map MixedAmountKey Amount
zeros, Map MixedAmountKey Amount
nonzeros) = (Amount -> Bool)
-> Map MixedAmountKey Amount
-> (Map MixedAmountKey Amount, Map MixedAmountKey Amount)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition Amount -> Bool
amountIsZero Map MixedAmountKey Amount
ma

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

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

-- | Unify a MixedAmount to a single commodity value if possible.
-- This consolidates amounts of the same commodity and discards zero
-- amounts; but this one insists on simplifying to a single commodity,
-- and will return Nothing if this is not possible.
unifyMixedAmount :: MixedAmount -> Maybe Amount
unifyMixedAmount :: MixedAmount -> Maybe Amount
unifyMixedAmount = (Amount -> Amount -> Maybe Amount)
-> Amount -> [Amount] -> Maybe Amount
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Amount -> Amount -> Maybe Amount
combine Amount
0 ([Amount] -> Maybe Amount)
-> (MixedAmount -> [Amount]) -> MixedAmount -> Maybe Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts
  where
    combine :: Amount -> Amount -> Maybe Amount
combine Amount
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 -> Text
acommodity Amount
amount Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> Text
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

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

-- | Return an unnormalised MixedAmount containing 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 :: Text -> MixedAmount -> MixedAmount
filterMixedAmountByCommodity Text
c (Mixed Map MixedAmountKey Amount
ma)
  | Map MixedAmountKey Amount -> Bool
forall k a. Map k a -> Bool
M.null Map MixedAmountKey Amount
ma' = Amount -> MixedAmount
mixedAmount Amount
nullamt{acommodity :: Text
acommodity=Text
c}
  | Bool
otherwise  = Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
ma'
  where ma' :: Map MixedAmountKey Amount
ma' = (Amount -> Bool)
-> Map MixedAmountKey Amount -> Map MixedAmountKey Amount
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter ((Text
cText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Bool) -> (Amount -> Text) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Text
acommodity) Map MixedAmountKey Amount
ma

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

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

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

-- -- | MixedAmount derived Eq instance in Types.hs doesn't know that we
-- -- want $0 = EUR0 = 0. Yet we don't want to drag all this code over there.
-- -- For now, use this when cross-commodity zero equality is important.
-- mixedAmountEquals :: MixedAmount -> MixedAmount -> Bool
-- mixedAmountEquals a b = amounts a' == amounts b' || (mixedAmountLooksZero a' && mixedAmountLooksZero b')
--     where a' = mixedAmountStripPrices a
--           b' = mixedAmountStripPrices 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 Text AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount Map Text AmountStyle
styles = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe (Map Text AmountStyle -> Amount -> Amount
styleAmount Map Text AmountStyle
styles)

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

-- | 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
"Mixed [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
as String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    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 to 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. There
--   will always be at least one amount displayed, even if this will
--   exceed the requested maximum width.
-- - If displayed on multiple lines, any Amounts longer than the
--   maximum width will be elided.
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
    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 list of Amounts on multiple lines. This returns
-- the list of WideBuilders: one for each Amount, and padded/elided to the appropriate
-- width. This does not honour displayOneLine: all amounts will be displayed as if
-- displayOneLine were False.
showMixedAmountLinesB :: 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
    astrs :: [AmountDisplay]
astrs = Int -> (Amount -> WideBuilder) -> [Amount] -> [AmountDisplay]
amtDisplayList (WideBuilder -> Int
wbWidth WideBuilder
sep) (AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
opts) ([Amount] -> [AmountDisplay])
-> (MixedAmount -> [Amount]) -> MixedAmount -> [AmountDisplay]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> [Amount]
orderedAmounts AmountDisplayOpts
opts (MixedAmount -> [AmountDisplay]) -> MixedAmount -> [AmountDisplay]
forall a b. (a -> b) -> a -> b
$
              if AmountDisplayOpts -> Bool
displayPrice AmountDisplayOpts
opts then MixedAmount
ma else MixedAmount -> MixedAmount
mixedAmountStripPrices MixedAmount
ma
    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
$ (AmountDisplay -> Int) -> [AmountDisplay] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder -> Int
wbWidth (WideBuilder -> Int)
-> (AmountDisplay -> WideBuilder) -> AmountDisplay -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplay -> WideBuilder
adBuilder) [AmountDisplay]
elided

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

    elided :: [AmountDisplay]
elided = ([AmountDisplay] -> [AmountDisplay])
-> (Int -> [AmountDisplay] -> [AmountDisplay])
-> Maybe Int
-> [AmountDisplay]
-> [AmountDisplay]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [AmountDisplay] -> [AmountDisplay]
forall a. a -> a
id Int -> [AmountDisplay] -> [AmountDisplay]
elideTo Maybe Int
mmax [AmountDisplay]
astrs
    elideTo :: Int -> [AmountDisplay] -> [AmountDisplay]
elideTo Int
m [AmountDisplay]
xs = Maybe AmountDisplay -> [AmountDisplay] -> [AmountDisplay]
forall a. Maybe a -> [a] -> [a]
maybeAppend Maybe AmountDisplay
elisionStr [AmountDisplay]
short
      where
        elisionStr :: Maybe AmountDisplay
elisionStr = Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay
elisionDisplay (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
m) (WideBuilder -> Int
wbWidth WideBuilder
sep) ([AmountDisplay] -> Int
forall (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
    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] -> [AmountDisplay])
-> (MixedAmount -> [Amount]) -> MixedAmount -> [AmountDisplay]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> [Amount]
orderedAmounts AmountDisplayOpts
opts (MixedAmount -> [AmountDisplay]) -> MixedAmount -> [AmountDisplay]
forall a b. (a -> b) -> a -> b
$
               if AmountDisplayOpts -> Bool
displayPrice AmountDisplayOpts
opts then MixedAmount
ma else MixedAmount -> MixedAmount
mixedAmountStripPrices MixedAmount
ma
    sep :: WideBuilder
sep    = Builder -> Int -> WideBuilder
WideBuilder (String -> Builder
TB.fromString String
", ") Int
2
    n :: Int
n      = [AmountDisplay] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AmountDisplay]
astrs

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

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

orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount]
orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount]
orderedAmounts AmountDisplayOpts
dopts = ([Amount] -> [Amount])
-> ([Text] -> [Amount] -> [Amount])
-> Maybe [Text]
-> [Amount]
-> [Amount]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Amount] -> [Amount]
forall a. a -> a
id ((Text -> [Amount] -> Amount) -> [Text] -> [Amount] -> [Amount]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> [Amount] -> Amount
forall (t :: * -> *). Foldable t => Text -> t Amount -> Amount
pad) (AmountDisplayOpts -> Maybe [Text]
displayOrder AmountDisplayOpts
dopts) ([Amount] -> [Amount])
-> (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts
  where
    pad :: Text -> t Amount -> Amount
pad Text
c = Amount -> Maybe Amount -> Amount
forall a. a -> Maybe a -> a
fromMaybe (Text -> Amount -> Amount
amountWithCommodity Text
c Amount
nullamt) (Maybe Amount -> Amount)
-> (t Amount -> Maybe Amount) -> t Amount -> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> Bool) -> t Amount -> Maybe Amount
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text
cText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Bool) -> (Amount -> Text) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Text
acommodity)


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

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

amtDisplayList :: Int -> (Amount -> WideBuilder) -> [Amount] -> [AmountDisplay]
amtDisplayList :: Int -> (Amount -> WideBuilder) -> [Amount] -> [AmountDisplay]
amtDisplayList Int
sep Amount -> WideBuilder
showamt = (Int, [AmountDisplay]) -> [AmountDisplay]
forall a b. (a, b) -> b
snd ((Int, [AmountDisplay]) -> [AmountDisplay])
-> ([Amount] -> (Int, [AmountDisplay]))
-> [Amount]
-> [AmountDisplay]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Amount -> (Int, AmountDisplay))
-> Int -> [Amount] -> (Int, [AmountDisplay])
forall (t :: * -> *) 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 (Text -> Builder
TB.fromText Text
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 :: Text
fullString = String -> Text
T.pack (String -> Text) -> String -> Text
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 :: Text
str | Just Int
m <- Maybe Int
mmax, Int
fullLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m = Int -> Text -> Text
T.take (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Text
fullString Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".."
        | Bool
otherwise                      = Text
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
a = String -> MixedAmount -> MixedAmount
forall a. String -> a -> a
trace (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ MixedAmount -> String
showMixedAmount MixedAmount
a) MixedAmount
a

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

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

-- | Remove all prices from a MixedAmount.
mixedAmountStripPrices :: MixedAmount -> MixedAmount
mixedAmountStripPrices :: MixedAmount -> MixedAmount
mixedAmountStripPrices (Mixed Map MixedAmountKey Amount
ma) =
    (MixedAmount -> Amount -> MixedAmount)
-> MixedAmount -> Map MixedAmountKey Amount -> MixedAmount
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\MixedAmount
m Amount
a -> MixedAmount -> Amount -> MixedAmount
maAddAmount MixedAmount
m Amount
a{aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing}) (Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
noPrices) Map MixedAmountKey Amount
withPrices
  where (Map MixedAmountKey Amount
noPrices, Map MixedAmountKey Amount
withPrices) = (Amount -> Bool)
-> Map MixedAmountKey Amount
-> (Map MixedAmountKey Amount, Map MixedAmountKey Amount)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition (Maybe AmountPrice -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe AmountPrice -> Bool)
-> (Amount -> Maybe AmountPrice) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Maybe AmountPrice
aprice) Map MixedAmountKey Amount
ma

-- | Canonicalise a mixed amount's display styles using the provided commodity style map.
canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount :: Map Text AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount Map Text AmountStyle
styles = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe (Map Text AmountStyle -> Amount -> Amount
canonicaliseAmount Map Text 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
testGroup String
"Amount" [
   String -> [TestTree] -> TestTree
testGroup String
"Amount" [

     String -> Assertion -> TestTree
testCase 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
testCase 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
testCase 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
testCase 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
testCase 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
testGroup String
"MixedAmount" [

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

     ,String -> Assertion -> TestTree
testCase 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 :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum ((Amount -> MixedAmount) -> [Amount] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> MixedAmount
mixedAmount
        [Quantity -> Amount
usd Quantity
1.25
        ,Quantity -> Amount
usd (-Quantity
1) Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
3
        ,Quantity -> Amount
usd (-Quantity
0.25)
        ])
        MixedAmount -> MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
0 Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
3)

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

    ,String -> Assertion -> TestTree
testCase String
"showMixedAmount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
       MixedAmount -> String
showMixedAmount (Amount -> MixedAmount
mixedAmount (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
mixedAmount (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
mixedAmount (Quantity -> Amount
usd Quantity
0)) String -> String -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= String
"0"
       MixedAmount -> String
showMixedAmount MixedAmount
nullmixedamt 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
testCase 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
mixedAmount (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
forall (t :: * -> *). Foldable t => t 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
testGroup String
"amounts" [
       String -> Assertion -> TestTree
testCase String
"a missing amount overrides any other amounts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> [Amount]
amounts ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
1, Amount
missingamt]) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Amount
missingamt]
      ,String -> Assertion -> TestTree
testCase String
"unpriced same-commodity amounts are combined" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> [Amount]
amounts ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
0, Quantity -> Amount
usd Quantity
2]) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Quantity -> Amount
usd Quantity
2]
      ,String -> Assertion -> TestTree
testCase String
"amounts with same unit price are combined" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> [Amount]
amounts ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1, Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1]) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Quantity -> Amount
usd Quantity
2 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1]
      ,String -> Assertion -> TestTree
testCase String
"amounts with different unit prices are not combined" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> [Amount]
amounts ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1, Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
2]) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1, Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
2]
      ,String -> Assertion -> TestTree
testCase String
"amounts with total prices are combined" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        MixedAmount -> [Amount]
amounts ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
1, Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
1]) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Quantity -> Amount
usd Quantity
2 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
2]
    ]

    ,String -> Assertion -> TestTree
testCase String
"mixedAmountStripPrices" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
       MixedAmount -> [Amount]
amounts (MixedAmount -> MixedAmount
mixedAmountStripPrices MixedAmount
nullmixedamt) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [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
mixedAmountStripPrices
        ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
usd Quantity
10
               ,Quantity -> Amount
usd Quantity
10 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
7
               ,Quantity -> Amount
usd (-Quantity
10)
               ,Quantity -> Amount
usd (-Quantity
10) Amount -> Amount -> Amount
@@ Quantity -> Amount
eur (-Quantity
7)
               ])

  ]

 ]