{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
module Hledger.Data.Amount (
showCommoditySymbol,
isNonsimpleCommodityChar,
quoteCommoditySymbolIfNeeded,
nullamt,
missingamt,
num,
usd,
eur,
gbp,
per,
hrs,
at,
(@@),
amountWithCommodity,
amountCost,
amountIsZero,
amountLooksZero,
divideAmount,
multiplyAmount,
invertAmount,
amountstyle,
canonicaliseAmount,
styleAmount,
amountSetStyles,
amountStyleSetRounding,
amountStylesSetRounding,
amountUnstyled,
AmountDisplayOpts(..),
noColour,
noCost,
oneLine,
csvDisplay,
showAmountB,
showAmount,
showAmountWith,
showAmountCostB,
cshowAmount,
showAmountWithZeroCommodity,
showAmountDebug,
showAmountWithoutPrice,
amountSetPrecision,
amountSetPrecisionMin,
amountSetPrecisionMax,
withPrecision,
amountSetFullPrecision,
amountSetFullPrecisionOr,
amountInternalPrecision,
amountDisplayPrecision,
defaultMaxPrecision,
setAmountInternalPrecision,
withInternalPrecision,
setAmountDecimalPoint,
withDecimalPoint,
amountStripCost,
nullmixedamt,
missingmixedamt,
isMissingMixedAmount,
mixed,
mixedAmount,
maAddAmount,
maAddAmounts,
amounts,
amountsRaw,
amountsPreservingZeros,
maCommodities,
filterMixedAmount,
filterMixedAmountByCommodity,
mapMixedAmount,
unifyMixedAmount,
mixedAmountStripPrices,
mixedAmountCost,
maNegate,
maPlus,
maMinus,
maSum,
divideMixedAmount,
multiplyMixedAmount,
averageMixedAmounts,
isNegativeAmount,
isNegativeMixedAmount,
mixedAmountIsZero,
maIsZero,
maIsNonZero,
mixedAmountLooksZero,
canonicaliseMixedAmount,
styleMixedAmount,
mixedAmountSetStyles,
mixedAmountUnstyled,
showMixedAmount,
showMixedAmountWith,
showMixedAmountOneLine,
showMixedAmountDebug,
showMixedAmountWithoutPrice,
showMixedAmountOneLineWithoutPrice,
showMixedAmountElided,
showMixedAmountWithZeroCommodity,
showMixedAmountB,
showMixedAmountLinesB,
wbToText,
wbUnpack,
mixedAmountSetPrecision,
mixedAmountSetFullPrecision,
mixedAmountSetPrecisionMin,
mixedAmountSetPrecisionMax,
tests_Amount
) where
import Prelude hiding (Applicative(..))
import Control.Applicative (Applicative(..))
import Control.Monad (foldM)
import Data.Char (isDigit)
import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
import Data.Default (Default(..))
import Data.Foldable (toList)
import Data.List (find, 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)
import Data.Semigroup (Semigroup(..))
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TB
import Data.Word (Word8)
import Safe (headDef, lastDef, lastMay)
import System.Console.ANSI (Color(..),ColorIntensity(..))
import Test.Tasty (testGroup)
import Test.Tasty.HUnit ((@?=), assertBool, testCase)
import Hledger.Data.Types
import Hledger.Utils (colorB, numDigitsInt, numDigitsInteger)
import Hledger.Utils.Text (textQuoteIfNeeded)
import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack)
import Data.Functor ((<&>))
showCommoditySymbol :: T.Text -> T.Text
showCommoditySymbol :: Text -> Text
showCommoditySymbol = Text -> Text
textQuoteIfNeeded
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
data AmountDisplayOpts = AmountDisplayOpts
{ AmountDisplayOpts -> Bool
displayCommodity :: Bool
, AmountDisplayOpts -> Bool
displayZeroCommodity :: Bool
, AmountDisplayOpts -> Maybe [Text]
displayCommodityOrder :: Maybe [CommoditySymbol]
, AmountDisplayOpts -> Bool
displayDigitGroups :: Bool
, AmountDisplayOpts -> Bool
displayForceDecimalMark :: Bool
, AmountDisplayOpts -> Bool
displayOneLine :: Bool
, AmountDisplayOpts -> Maybe Int
displayMinWidth :: Maybe Int
, AmountDisplayOpts -> Maybe Int
displayMaxWidth :: Maybe Int
, AmountDisplayOpts -> Bool
displayCost :: Bool
, AmountDisplayOpts -> Bool
displayColour :: Bool
} 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)
instance Default AmountDisplayOpts where def :: AmountDisplayOpts
def = AmountDisplayOpts
noColour
noColour :: AmountDisplayOpts
noColour :: AmountDisplayOpts
noColour = AmountDisplayOpts :: Bool
-> Bool
-> Maybe [Text]
-> Bool
-> Bool
-> Bool
-> Maybe Int
-> Maybe Int
-> Bool
-> Bool
-> AmountDisplayOpts
AmountDisplayOpts {
displayCommodity :: Bool
displayCommodity = Bool
True
, displayZeroCommodity :: Bool
displayZeroCommodity = Bool
False
, displayCommodityOrder :: Maybe [Text]
displayCommodityOrder = Maybe [Text]
forall a. Maybe a
Nothing
, displayDigitGroups :: Bool
displayDigitGroups = Bool
True
, displayForceDecimalMark :: Bool
displayForceDecimalMark = Bool
False
, displayOneLine :: Bool
displayOneLine = Bool
False
, displayMinWidth :: Maybe Int
displayMinWidth = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
, displayMaxWidth :: Maybe Int
displayMaxWidth = Maybe Int
forall a. Maybe a
Nothing
, displayCost :: Bool
displayCost = Bool
True
, displayColour :: Bool
displayColour = Bool
False
}
noCost :: AmountDisplayOpts
noCost :: AmountDisplayOpts
noCost = AmountDisplayOpts
forall a. Default a => a
def{displayCost :: Bool
displayCost=Bool
False}
oneLine :: AmountDisplayOpts
oneLine :: AmountDisplayOpts
oneLine = AmountDisplayOpts
forall a. Default a => a
def{displayOneLine :: Bool
displayOneLine=Bool
True, displayCost :: Bool
displayCost=Bool
False}
csvDisplay :: AmountDisplayOpts
csvDisplay :: AmountDisplayOpts
csvDisplay = AmountDisplayOpts
oneLine{displayDigitGroups :: Bool
displayDigitGroups=Bool
False}
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
(*)
nullamt :: Amount
nullamt :: Amount
nullamt = 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}
missingamt :: Amount
missingamt :: Amount
missingamt = Amount
nullamt{acommodity :: Text
acommodity=Text
"AUTO"}
num :: Quantity -> Amount
num Quantity
n = Amount
nullamt{acommodity :: Text
acommodity=Text
"", aquantity :: Quantity
aquantity=Quantity
n}
hrs :: Quantity -> Amount
hrs Quantity
n = Amount
nullamt{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
nullamt{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
nullamt{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
nullamt{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
nullamt{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}
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}} =
Amount
nullamt{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}}
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}
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}
amountStripCost :: Amount -> Amount
amountStripCost :: Amount -> Amount
amountStripCost Amount
a = Amount
a{aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing}
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 a1 :: Amount
a1@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
pq}) = Amount -> AmountPrice
TotalPrice Amount
a1{aquantity :: Quantity
aquantity = Quantity -> Quantity
f Quantity
pq}
f' AmountPrice
p' = AmountPrice
p'
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)
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)
invertAmount :: Amount -> Amount
invertAmount :: Amount -> Amount
invertAmount a :: Amount
a@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
q} = Amount
a{aquantity :: Quantity
aquantity=Quantity
1Quantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/Quantity
q}
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
amountRoundedQuantity :: Amount -> Quantity
amountRoundedQuantity :: Amount -> Quantity
amountRoundedQuantity Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
q, astyle :: Amount -> AmountStyle
astyle=AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
mp}} = case AmountPrecision
mp of
AmountPrecision
NaturalPrecision -> Quantity
q
Precision Word8
p -> Word8 -> Quantity -> Quantity
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
p Quantity
q
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
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
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)
amountHasMaxDigits :: Amount -> Bool
amountHasMaxDigits :: Amount -> Bool
amountHasMaxDigits = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
255) (Int -> Bool) -> (Amount -> Int) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
numDigitsInteger (Integer -> Int) -> (Amount -> Integer) -> Amount -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity -> Integer
forall i. DecimalRaw i -> i
decimalMantissa (Quantity -> Integer) -> (Amount -> Quantity) -> Amount -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Quantity
aquantity
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
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}}
amountSetPrecisionMin :: Word8 -> Amount -> Amount
amountSetPrecisionMin :: Word8 -> Amount -> Amount
amountSetPrecisionMin Word8
minp Amount
a = AmountPrecision -> Amount -> Amount
amountSetPrecision AmountPrecision
p Amount
a
where p :: AmountPrecision
p = Word8 -> AmountPrecision
Precision (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max Word8
minp (Amount -> Word8
amountDisplayPrecision Amount
a)
amountSetPrecisionMax :: Word8 -> Amount -> Amount
amountSetPrecisionMax :: Word8 -> Amount -> Amount
amountSetPrecisionMax Word8
maxp Amount
a = AmountPrecision -> Amount -> Amount
amountSetPrecision AmountPrecision
p Amount
a
where p :: AmountPrecision
p = Word8 -> AmountPrecision
Precision (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
min Word8
maxp (Amount -> Word8
amountDisplayPrecision Amount
a)
amountSetFullPrecision :: Amount -> Amount
amountSetFullPrecision :: Amount -> Amount
amountSetFullPrecision Amount
a = AmountPrecision -> Amount -> Amount
amountSetPrecision AmountPrecision
p Amount
a
where
p :: AmountPrecision
p = AmountPrecision -> AmountPrecision -> AmountPrecision
forall a. Ord a => a -> a -> a
max AmountPrecision
displayprecision AmountPrecision
naturalprecision
displayprecision :: AmountPrecision
displayprecision = AmountStyle -> AmountPrecision
asprecision (AmountStyle -> AmountPrecision) -> AmountStyle -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
a
naturalprecision :: AmountPrecision
naturalprecision = Word8 -> AmountPrecision
Precision (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> Word8
amountInternalPrecision Amount
a
amountSetFullPrecisionOr :: Maybe Word8 -> Amount -> Amount
amountSetFullPrecisionOr :: Maybe Word8 -> Amount -> Amount
amountSetFullPrecisionOr Maybe Word8
mmaxp Amount
a = AmountPrecision -> Amount -> Amount
amountSetPrecision (Word8 -> AmountPrecision
Precision Word8
p2) Amount
a
where
p1 :: Word8
p1 = if
Amount -> Bool
amountHasMaxDigits Amount
a then Word8
defaultMaxPrecision else Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max Word8
disp Word8
intp
where
intp :: Word8
intp = Amount -> Word8
amountInternalPrecision Amount
a
disp :: Word8
disp = Amount -> Word8
amountDisplayPrecision Amount
a
p2 :: Word8
p2 = Word8 -> (Word8 -> Word8) -> Maybe Word8 -> Word8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word8
p1 (Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
min Word8
p1) Maybe Word8
mmaxp
defaultMaxPrecision :: Word8
defaultMaxPrecision :: Word8
defaultMaxPrecision = Word8
8
amountInternalPrecision :: Amount -> Word8
amountInternalPrecision :: Amount -> Word8
amountInternalPrecision = Quantity -> Word8
forall i. DecimalRaw i -> Word8
decimalPlaces (Quantity -> Word8) -> (Amount -> Quantity) -> Amount -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity -> Quantity
forall i. Integral i => DecimalRaw i -> DecimalRaw i
normalizeDecimal (Quantity -> Quantity)
-> (Amount -> Quantity) -> Amount -> Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Quantity
aquantity
amountDisplayPrecision :: Amount -> Word8
amountDisplayPrecision :: Amount -> Word8
amountDisplayPrecision Amount
a =
case AmountStyle -> AmountPrecision
asprecision (AmountStyle -> AmountPrecision) -> AmountStyle -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
a of
Precision Word8
n -> Word8
n
AmountPrecision
NaturalPrecision -> Amount -> Word8
amountInternalPrecision Amount
a
setAmountInternalPrecision :: Word8 -> Amount -> Amount
setAmountInternalPrecision :: Word8 -> Amount -> Amount
setAmountInternalPrecision Word8
p a :: Amount
a@Amount{ aquantity :: Amount -> Quantity
aquantity=Quantity
q, astyle :: Amount -> AmountStyle
astyle=AmountStyle
s } = Amount
a{
aquantity :: Quantity
aquantity=Word8 -> Quantity -> Quantity
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
p Quantity
q
,astyle :: AmountStyle
astyle=AmountStyle
s{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
p}
}
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
{-# DEPRECATED canonicaliseAmount "please use styleAmounts instead" #-}
canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
canonicaliseAmount :: Map Text AmountStyle -> Amount -> Amount
canonicaliseAmount = Map Text AmountStyle -> Amount -> Amount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts
{-# DEPRECATED styleAmount "please use styleAmounts instead" #-}
styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmount :: Map Text AmountStyle -> Amount -> Amount
styleAmount = Map Text AmountStyle -> Amount -> Amount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts
{-# DEPRECATED amountSetStyles "please use styleAmounts instead" #-}
amountSetStyles :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
amountSetStyles :: Map Text AmountStyle -> Amount -> Amount
amountSetStyles = Map Text AmountStyle -> Amount -> Amount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts
instance HasAmounts Amount where
styleAmounts :: Map Text AmountStyle -> Amount -> Amount
styleAmounts Map Text AmountStyle
styles a :: Amount
a@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
qty, acommodity :: Amount -> Text
acommodity=Text
comm, astyle :: Amount -> AmountStyle
astyle=AmountStyle
oldstyle, aprice :: Amount -> Maybe AmountPrice
aprice=Maybe AmountPrice
mcost0} =
Amount
a{astyle :: AmountStyle
astyle=AmountStyle
newstyle, aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
mcost1}
where
newstyle :: AmountStyle
newstyle = Bool -> Quantity -> AmountStyle -> Text -> AmountStyle
mknewstyle Bool
False Quantity
qty AmountStyle
oldstyle Text
comm
mcost1 :: Maybe AmountPrice
mcost1 = case Maybe AmountPrice
mcost0 of
Maybe AmountPrice
Nothing -> Maybe AmountPrice
forall a. Maybe a
Nothing
Just (UnitPrice ca :: Amount
ca@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
cq, astyle :: Amount -> AmountStyle
astyle=AmountStyle
cs, acommodity :: Amount -> Text
acommodity=Text
ccomm}) -> 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
ca{astyle :: AmountStyle
astyle=Bool -> Quantity -> AmountStyle -> Text -> AmountStyle
mknewstyle Bool
True Quantity
cq AmountStyle
cs Text
ccomm}
Just (TotalPrice ca :: Amount
ca@Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
cq, astyle :: Amount -> AmountStyle
astyle=AmountStyle
cs, acommodity :: Amount -> Text
acommodity=Text
ccomm}) -> 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
ca{astyle :: AmountStyle
astyle=Bool -> Quantity -> AmountStyle -> Text -> AmountStyle
mknewstyle Bool
True Quantity
cq AmountStyle
cs Text
ccomm}
mknewstyle :: Bool -> Quantity -> AmountStyle -> CommoditySymbol -> AmountStyle
mknewstyle :: Bool -> Quantity -> AmountStyle -> Text -> AmountStyle
mknewstyle Bool
iscost Quantity
oldq AmountStyle
olds Text
com =
case Text -> Map Text AmountStyle -> Maybe AmountStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
com Map Text AmountStyle
styles of
Just AmountStyle
s ->
Bool -> Quantity -> AmountStyle -> AmountStyle -> AmountStyle
amountStyleApplyWithRounding Bool
iscost Quantity
oldq
(
AmountStyle
s)
(
AmountStyle
olds)
Maybe AmountStyle
Nothing -> AmountStyle
olds
amountStyleApplyWithRounding :: Bool -> Quantity -> AmountStyle -> AmountStyle -> AmountStyle
amountStyleApplyWithRounding :: Bool -> Quantity -> AmountStyle -> AmountStyle -> AmountStyle
amountStyleApplyWithRounding Bool
iscost Quantity
q news :: AmountStyle
news@AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
newp, asrounding :: AmountStyle -> Rounding
asrounding=Rounding
newr} AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision=AmountPrecision
oldp} =
case Rounding
newr of
Rounding
NoRounding -> AmountStyle
news{asprecision :: AmountPrecision
asprecision=AmountPrecision
oldp}
Rounding
SoftRounding -> AmountStyle
news{asprecision :: AmountPrecision
asprecision=if Bool
iscost then AmountPrecision
oldp else AmountPrecision
newp'}
where
newp' :: AmountPrecision
newp' = case (AmountPrecision
newp, AmountPrecision
oldp) of
(Precision Word8
new, Precision Word8
old) ->
if Word8
new Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
old
then Word8 -> AmountPrecision
Precision Word8
new
else Word8 -> AmountPrecision
Precision (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max (Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
min Word8
old Word8
internal) Word8
new
where internal :: Word8
internal = Quantity -> Word8
forall i. DecimalRaw i -> Word8
decimalPlaces (Quantity -> Word8) -> Quantity -> Word8
forall a b. (a -> b) -> a -> b
$ Quantity -> Quantity
forall i. Integral i => DecimalRaw i -> DecimalRaw i
normalizeDecimal Quantity
q
(AmountPrecision, AmountPrecision)
_ -> AmountPrecision
NaturalPrecision
Rounding
HardRounding -> AmountStyle
news{asprecision :: AmountPrecision
asprecision=if Bool
iscost then AmountPrecision
oldp else AmountPrecision
newp}
Rounding
AllRounding -> AmountStyle
news
amountStyleSetRounding :: Rounding -> AmountStyle -> AmountStyle
amountStyleSetRounding :: Rounding -> AmountStyle -> AmountStyle
amountStyleSetRounding Rounding
r AmountStyle
as = AmountStyle
as{asrounding :: Rounding
asrounding=Rounding
r}
amountStylesSetRounding :: Rounding -> M.Map CommoditySymbol AmountStyle -> M.Map CommoditySymbol AmountStyle
amountStylesSetRounding :: Rounding -> Map Text AmountStyle -> Map Text AmountStyle
amountStylesSetRounding Rounding
r = (AmountStyle -> AmountStyle)
-> Map Text AmountStyle -> Map Text AmountStyle
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Rounding -> AmountStyle -> AmountStyle
amountStyleSetRounding Rounding
r)
amountstyle :: AmountStyle
amountstyle = Side
-> Bool
-> Maybe DigitGroupStyle
-> Maybe Char
-> AmountPrecision
-> Rounding
-> AmountStyle
AmountStyle Side
L Bool
False Maybe DigitGroupStyle
forall a. Maybe a
Nothing (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') (Word8 -> AmountPrecision
Precision Word8
0) Rounding
NoRounding
amountUnstyled :: Amount -> Amount
amountUnstyled :: Amount -> Amount
amountUnstyled Amount
a = Amount
a{astyle :: AmountStyle
astyle=AmountStyle
amountstyle}
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{asdecimalmark :: Maybe Char
asdecimalmark=Maybe Char
mc} }
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
showAmountCostB :: Amount -> WideBuilder
showAmountCostB :: Amount -> WideBuilder
showAmountCostB 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{displayZeroCommodity :: Bool
displayZeroCommodity=Bool
True} 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{displayZeroCommodity :: Bool
displayZeroCommodity=Bool
True} (Amount -> Amount
sign Amount
pa)
where sign :: Amount -> Amount
sign = if Amount -> Quantity
aquantity Amount
amt Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
0 then Amount -> Amount
forall a. Num a => a -> a
negate else Amount -> Amount
forall a. a -> a
id
showAmountCostDebug :: Maybe AmountPrice -> String
showAmountCostDebug :: Maybe AmountPrice -> String
showAmountCostDebug Maybe AmountPrice
Nothing = String
""
showAmountCostDebug (Just (UnitPrice Amount
pa)) = String
" @ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Amount -> String
showAmountDebug Amount
pa
showAmountCostDebug (Just (TotalPrice Amount
pa)) = String
" @@ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Amount -> String
showAmountDebug Amount
pa
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
showAmountWith :: AmountDisplayOpts -> Amount -> String
showAmountWith :: AmountDisplayOpts -> Amount -> String
showAmountWith AmountDisplayOpts
fmt = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (Amount -> WideBuilder) -> Amount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
fmt
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{Bool
displayCommodity :: Bool
displayCommodity :: AmountDisplayOpts -> Bool
displayCommodity, Bool
displayZeroCommodity :: Bool
displayZeroCommodity :: AmountDisplayOpts -> Bool
displayZeroCommodity, Bool
displayDigitGroups :: Bool
displayDigitGroups :: AmountDisplayOpts -> Bool
displayDigitGroups
,Bool
displayForceDecimalMark :: Bool
displayForceDecimalMark :: AmountDisplayOpts -> Bool
displayForceDecimalMark, Bool
displayCost :: Bool
displayCost :: AmountDisplayOpts -> Bool
displayCost, Bool
displayColour :: Bool
displayColour :: AmountDisplayOpts -> Bool
displayColour}
a :: Amount
a@Amount{astyle :: Amount -> AmountStyle
astyle=AmountStyle
style} =
WideBuilder -> WideBuilder
color (WideBuilder -> WideBuilder) -> WideBuilder -> WideBuilder
forall a b. (a -> b) -> a -> b
$ case AmountStyle -> Side
ascommodityside AmountStyle
style of
Side
L -> (if Bool
displayCommodity then Text -> WideBuilder
wbFromText Text
comm WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
space else WideBuilder
forall a. Monoid a => a
mempty) WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
quantity' WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
price
Side
R -> WideBuilder
quantity' WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> (if Bool
displayCommodity then WideBuilder
space WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> WideBuilder
wbFromText Text
comm else WideBuilder
forall a. Monoid a => a
mempty) WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
price
where
color :: WideBuilder -> WideBuilder
color = if Bool
displayColour Bool -> Bool -> Bool
&& Amount -> Bool
isNegativeAmount Amount
a then ColorIntensity -> Color -> WideBuilder -> WideBuilder
colorB ColorIntensity
Dull Color
Red else WideBuilder -> WideBuilder
forall a. a -> a
id
quantity :: WideBuilder
quantity = Bool -> Amount -> WideBuilder
showAmountQuantity Bool
displayForceDecimalMark (Amount -> WideBuilder) -> Amount -> WideBuilder
forall a b. (a -> b) -> a -> b
$
if Bool
displayDigitGroups then Amount
a else Amount
a{astyle :: AmountStyle
astyle=(Amount -> AmountStyle
astyle Amount
a){asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
forall a. Maybe a
Nothing}}
(WideBuilder
quantity', Text
comm)
| Amount -> Bool
amountLooksZero Amount
a Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
displayZeroCommodity = (Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
'0') Int
1, 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
comm) Bool -> Bool -> Bool
&& AmountStyle -> Bool
ascommodityspaced AmountStyle
style then Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
' ') Int
1 else WideBuilder
forall a. Monoid a => a
mempty
price :: WideBuilder
price = if Bool
displayCost then Amount -> WideBuilder
showAmountCostB Amount
a else WideBuilder
forall a. Monoid a => a
mempty
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}
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
noCost
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}
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
showAmountCostDebug 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
"}"
showAmountQuantity :: Bool -> Amount -> WideBuilder
showAmountQuantity :: Bool -> Amount -> WideBuilder
showAmountQuantity Bool
disambiguate amt :: Amount
amt@Amount{astyle :: Amount -> AmountStyle
astyle=AmountStyle{asdecimalmark :: AmountStyle -> Maybe Char
asdecimalmark=Maybe Char
mdec, asdigitgroups :: AmountStyle -> Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps}} =
WideBuilder
signB WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
intB WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
fracB
where
Decimal Word8
decplaces Integer
mantissa = Amount -> Quantity
amountRoundedQuantity Amount
amt
numtxt :: Text
numtxt = 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
mantissa
numlen :: Int
numlen = Text -> Int
T.length Text
numtxt
intLen :: Int
intLen = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
numlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
decplaces
dec :: Char
dec = Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
'.' Maybe Char
mdec
numtxtwithzero :: Text
numtxtwithzero = Int -> Text -> Text
T.replicate (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
decplaces Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numlen) Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
numtxt
(Text
intPart, Text
fracPart) = Int -> Text -> (Text, Text)
T.splitAt Int
intLen Text
numtxtwithzero
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
decplaces Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then Text
numtxt else Text
intPart
signB :: WideBuilder
signB = if Integer
mantissa Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
'-') Int
1 else WideBuilder
forall a. Monoid a => a
mempty
fracB :: WideBuilder
fracB = if Word8
decplaces Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0 Bool -> Bool -> Bool
|| (Bool
isshowingdigitgroupseparator Bool -> Bool -> Bool
&& Bool
disambiguate)
then Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
dec Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText Text
fracPart) (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
decplaces)
else WideBuilder
forall a. Monoid a => a
mempty
where
isshowingdigitgroupseparator :: Bool
isshowingdigitgroupseparator = case Maybe DigitGroupStyle
mgrps of
Just (DigitGroups Char
_ (Word8
rightmostgrplen:[Word8]
_)) -> Int
intLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
rightmostgrplen
Maybe DigitGroupStyle
_ -> Bool
False
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
g0:[Word8]
gs0))) Int
l0 Text
s0 = NonEmpty Word8 -> Integer -> Text -> WideBuilder
forall a.
Integral a =>
NonEmpty a -> Integer -> Text -> WideBuilder
addseps (Word8
g0Word8 -> [Word8] -> NonEmpty Word8
forall a. a -> [a] -> NonEmpty a
:|[Word8]
gs0) (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
l0) Text
s0
where
addseps :: NonEmpty a -> Integer -> Text -> WideBuilder
addseps (a
g1:|[a]
gs1) Integer
l1 Text
s1
| Integer
l2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = NonEmpty a -> Integer -> Text -> WideBuilder
addseps NonEmpty a
gs2 Integer
l2 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
g1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = Builder -> Int -> WideBuilder
WideBuilder (Text -> Builder
TB.fromText Text
s1) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
l1)
where
(Text
rest, Text
part) = Int -> Text -> (Text, Text)
T.splitAt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
l2) Text
s1
gs2 :: NonEmpty a
gs2 = NonEmpty a -> Maybe (NonEmpty a) -> NonEmpty a
forall a. a -> Maybe a -> a
fromMaybe (a
g1a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[]) (Maybe (NonEmpty a) -> NonEmpty a)
-> Maybe (NonEmpty a) -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [a]
gs1
l2 :: Integer
l2 = Integer
l1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- a -> Integer
forall a. Integral a => a -> Integer
toInteger a
g1
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"
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"
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)
nullmixedamt :: MixedAmount
nullmixedamt :: MixedAmount
nullmixedamt = Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
forall a. Monoid a => a
mempty
missingmixedamt :: MixedAmount
missingmixedamt :: MixedAmount
missingmixedamt = Amount -> MixedAmount
mixedAmount Amount
missingamt
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
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
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
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
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
maNegate :: MixedAmount -> MixedAmount
maNegate :: MixedAmount -> MixedAmount
maNegate = (Quantity -> Quantity) -> MixedAmount -> MixedAmount
transformMixedAmount Quantity -> Quantity
forall a. Num a => a -> a
negate
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
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
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
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)
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)
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)
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
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
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
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
maIsZero :: MixedAmount -> Bool
maIsZero :: MixedAmount -> Bool
maIsZero = MixedAmount -> Bool
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
amounts :: MixedAmount -> [Amount]
amounts :: MixedAmount -> [Amount]
amounts (Mixed Map MixedAmountKey Amount
ma)
| MixedAmount -> Bool
isMissingMixedAmount (Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
ma) = [Amount
missingamt]
| Map MixedAmountKey Amount -> Bool
forall k a. Map k a -> Bool
M.null Map MixedAmountKey Amount
nonzeros = [Amount
newzero]
| Bool
otherwise = Map MixedAmountKey Amount -> [Amount]
forall (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
amountsPreservingZeros :: MixedAmount -> [Amount]
amountsPreservingZeros :: MixedAmount -> [Amount]
amountsPreservingZeros (Mixed Map MixedAmountKey Amount
ma)
| MixedAmount -> Bool
isMissingMixedAmount (Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
ma) = [Amount
missingamt]
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map MixedAmountKey Amount -> Bool
forall k a. Map k a -> Bool
M.null Map MixedAmountKey Amount
nonzeros = Map MixedAmountKey Amount -> [Amount]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map MixedAmountKey Amount
nonzeros
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map MixedAmountKey Amount -> Bool
forall k a. Map k a -> Bool
M.null Map MixedAmountKey Amount
zeros = Map MixedAmountKey Amount -> [Amount]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map MixedAmountKey Amount
zeros
| Bool
otherwise = [Amount
nullamt]
where
(Map MixedAmountKey Amount
zeros, Map MixedAmountKey Amount
nonzeros) = (Amount -> Bool)
-> Map MixedAmountKey Amount
-> (Map MixedAmountKey Amount, Map MixedAmountKey Amount)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition Amount -> Bool
amountIsZero Map MixedAmountKey Amount
ma
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
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
unifyMixedAmount :: MixedAmount -> Maybe Amount
unifyMixedAmount :: MixedAmount -> Maybe Amount
unifyMixedAmount = (Amount -> Amount -> Maybe Amount)
-> Amount -> [Amount] -> Maybe Amount
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Amount -> Amount -> Maybe Amount
combine Amount
0 ([Amount] -> Maybe Amount)
-> (MixedAmount -> [Amount]) -> MixedAmount -> Maybe Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts
where
combine :: Amount -> Amount -> Maybe Amount
combine Amount
amt Amount
result
| Amount -> Bool
amountIsZero Amount
amt = Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
result
| Amount -> Bool
amountIsZero Amount
result = Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
amt
| Amount -> Text
acommodity Amount
amt 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
amt Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Amount
result
| Bool
otherwise = Maybe Amount
forall a. Maybe a
Nothing
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
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
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
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
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
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
{-# DEPRECATED canonicaliseMixedAmount "please use mixedAmountSetStyle False (or styleAmounts) instead" #-}
canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount :: Map Text AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount = Map Text AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts
{-# DEPRECATED styleMixedAmount "please use styleAmounts instead" #-}
styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount :: Map Text AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount = Map Text AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts
{-# DEPRECATED mixedAmountSetStyles "please use styleAmounts instead" #-}
mixedAmountSetStyles :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
mixedAmountSetStyles :: Map Text AmountStyle -> MixedAmount -> MixedAmount
mixedAmountSetStyles = Map Text AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts
instance HasAmounts MixedAmount where
styleAmounts :: Map Text AmountStyle -> MixedAmount -> MixedAmount
styleAmounts Map Text AmountStyle
styles = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe (Map Text AmountStyle -> Amount -> Amount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles)
instance HasAmounts Account where
styleAmounts :: Map Text AmountStyle -> Account -> Account
styleAmounts Map Text AmountStyle
styles acct :: Account
acct@Account{MixedAmount
aebalance :: Account -> MixedAmount
aebalance :: MixedAmount
aebalance,MixedAmount
aibalance :: Account -> MixedAmount
aibalance :: MixedAmount
aibalance} =
Account
acct{aebalance :: MixedAmount
aebalance=Map Text AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles MixedAmount
aebalance, aibalance :: MixedAmount
aibalance=Map Text AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles MixedAmount
aibalance}
mixedAmountUnstyled :: MixedAmount -> MixedAmount
mixedAmountUnstyled :: MixedAmount -> MixedAmount
mixedAmountUnstyled = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe Amount -> Amount
amountUnstyled
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
showMixedAmountWith :: AmountDisplayOpts -> MixedAmount -> String
showMixedAmountWith :: AmountDisplayOpts -> MixedAmount -> String
showMixedAmountWith AmountDisplayOpts
fmt = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
fmt
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{displayCost :: Bool
displayCost=Bool
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}
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
noCost{displayColour :: Bool
displayColour=Bool
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}
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}
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
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]
ls) Int
width
where
ls :: [WideBuilder]
ls = 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]
ls
sep :: WideBuilder
sep = Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
'\n') Int
0
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
displayCost 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
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
displayCost 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
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
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) []
withElided :: [AmountDisplay] -> [(AmountDisplay, Maybe AmountDisplay)]
withElided = (Int -> AmountDisplay -> (AmountDisplay, Maybe AmountDisplay))
-> [Int]
-> [AmountDisplay]
-> [(AmountDisplay, Maybe AmountDisplay)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
n2 AmountDisplay
amt -> (AmountDisplay
amt, Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay
elisionDisplay Maybe Int
forall a. Maybe a
Nothing (WideBuilder -> Int
wbWidth WideBuilder
sep) Int
n2 AmountDisplay
amt)) [Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2..Int
0]
orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount]
orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount]
orderedAmounts AmountDisplayOpts{displayZeroCommodity :: AmountDisplayOpts -> Bool
displayZeroCommodity=Bool
preservezeros, displayCommodityOrder :: AmountDisplayOpts -> Maybe [Text]
displayCommodityOrder=Maybe [Text]
mcommodityorder} =
if Bool
preservezeros then MixedAmount -> [Amount]
amountsPreservingZeros else MixedAmount -> [Amount]
amounts
(MixedAmount -> [Amount])
-> ([Amount] -> [Amount]) -> MixedAmount -> [Amount]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([Amount] -> [Amount])
-> ([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
findfirst) Maybe [Text]
mcommodityorder
where
findfirst :: CommoditySymbol -> [Amount] -> Amount
findfirst :: Text -> [Amount] -> Amount
findfirst Text
c = Amount -> Maybe Amount -> Amount
forall a. a -> Maybe a -> a
fromMaybe Amount
nullamtc (Maybe Amount -> Amount)
-> ([Amount] -> Maybe Amount) -> [Amount] -> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> Bool) -> [Amount] -> Maybe Amount
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((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)
where
nullamtc :: Amount
nullamtc = Text -> Amount -> Amount
amountWithCommodity Text
c Amount
nullamt
data AmountDisplay = AmountDisplay
{ AmountDisplay -> WideBuilder
adBuilder :: !WideBuilder
, AmountDisplay -> Int
adTotal :: !Int
} 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
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.."
fullLength :: Int
fullLength = Int
sep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Integral a => Int -> a
numDigitsInt Int
n
str :: 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])
mixedAmountSetPrecision :: AmountPrecision -> MixedAmount -> MixedAmount
mixedAmountSetPrecision :: AmountPrecision -> MixedAmount -> MixedAmount
mixedAmountSetPrecision AmountPrecision
p = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe (AmountPrecision -> Amount -> Amount
amountSetPrecision AmountPrecision
p)
mixedAmountSetFullPrecision :: MixedAmount -> MixedAmount
mixedAmountSetFullPrecision :: MixedAmount -> MixedAmount
mixedAmountSetFullPrecision = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe Amount -> Amount
amountSetFullPrecision
mixedAmountSetPrecisionMin :: Word8 -> MixedAmount -> MixedAmount
mixedAmountSetPrecisionMin :: Word8 -> MixedAmount -> MixedAmount
mixedAmountSetPrecisionMin Word8
p = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe (Word8 -> Amount -> Amount
amountSetPrecisionMin Word8
p)
mixedAmountSetPrecisionMax :: Word8 -> MixedAmount -> MixedAmount
mixedAmountSetPrecisionMax :: Word8 -> MixedAmount -> MixedAmount
mixedAmountSetPrecisionMax Word8
p = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmountUnsafe (Word8 -> Amount -> Amount
amountSetPrecisionMax Word8
p)
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
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
nullamt
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
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
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)
])
]
]