1 {-# LANGUAGE StandaloneDeriving #-} 2 {-| 3 A simple 'Amount' is some quantity of money, shares, or anything else. 4 It has a (possibly null) 'Commodity' and a numeric quantity: 5 6 @ 7 $1 8 £-50 9 EUR 3.44 10 GOOG 500 11 1.5h 12 90 apples 13 0 14 @ 15 16 It may also have an assigned 'Price', representing this amount's per-unit 17 or total cost in a different commodity. If present, this is rendered like 18 so: 19 20 @ 21 EUR 2 \@ $1.50 (unit price) 22 EUR 2 \@\@ $3 (total price) 23 @ 24 25 A 'MixedAmount' is zero or more simple amounts, so can represent multiple 26 commodities; this is the type most often used: 27 28 @ 29 0 30 $50 + EUR 3 31 16h + $13.55 + AAPL 500 + 6 oranges 32 @ 33 34 When a mixed amount has been \"normalised\", it has no more than one amount 35 in each commodity and no zero amounts; or it has just a single zero amount 36 and no others. 37 38 Limited arithmetic with simple and mixed amounts is supported, best used 39 with similar amounts since it mostly ignores assigned prices and commodity 40 exchange rates. 41 42 -} 43 44 module Hledger.Data.Amount ( 45 -- * Amount 46 nullamt, 47 canonicaliseAmountCommodity, 48 setAmountPrecision, 49 -- ** arithmetic 50 costOfAmount, 51 divideAmount, 52 -- ** rendering 53 showAmount, 54 showAmountDebug, 55 showAmountWithoutPrice, 56 maxprecision, 57 maxprecisionwithpoint, 58 -- * MixedAmount 59 nullmixedamt, 60 missingamt, 61 amounts, 62 normaliseMixedAmount, 63 canonicaliseMixedAmountCommodity, 64 setMixedAmountPrecision, 65 -- ** arithmetic 66 costOfMixedAmount, 67 divideMixedAmount, 68 isNegativeMixedAmount, 69 isZeroMixedAmount, 70 isReallyZeroMixedAmountCost, 71 -- ** rendering 72 showMixedAmount, 73 showMixedAmountDebug, 74 showMixedAmountWithoutPrice, 75 showMixedAmountWithPrecision, 76 -- * misc. 77 tests_Hledger_Data_Amount 78 ) where 79 80 import Data.Char (isDigit) 81 import Data.List 82 import Data.Map (findWithDefault) 83 import Test.HUnit 84 import Text.Printf 85 import qualified Data.Map as Map 86 87 import Hledger.Data.Types 88 import Hledger.Data.Commodity 89 import Hledger.Utils 90 91 92 deriving instance Show HistoricalPrice 93 94 ------------------------------------------------------------------------------- 95 -- Amount 96 97 instance Show Amount where show = showAmount 98 99 instance Num Amount where 100 abs (Amount c q p) = Amount c (abs q) p 101 signum (Amount c q p) = Amount c (signum q) p 102 fromInteger i = Amount (comm "") (fromInteger i) Nothing 103 negate a@Amount{quantity=q} = a{quantity=(-q)} 104 (+) = similarAmountsOp (+) 105 (-) = similarAmountsOp (-) 106 (*) = similarAmountsOp (*) 107 108 -- | The empty simple amount. 109 nullamt :: Amount 110 nullamt = Amount unknown 0 Nothing 111 112 -- | Apply a binary arithmetic operator to two amounts, ignoring and 113 -- discarding any assigned prices, and converting the first to the 114 -- commodity of the second in a simplistic way (1-1 exchange rate). 115 -- The highest precision of either amount is preserved in the result. 116 similarAmountsOp :: (Double -> Double -> Double) -> Amount -> Amount -> Amount 117 similarAmountsOp op a@(Amount Commodity{precision=ap} _ _) (Amount bc@Commodity{precision=bp} bq _) = 118 Amount bc{precision=max ap bp} (quantity (convertAmountToCommodity bc a) `op` bq) Nothing 119 120 -- | Convert an amount to the specified commodity, ignoring and discarding 121 -- any assigned prices and assuming an exchange rate of 1. 122 convertAmountToCommodity :: Commodity -> Amount -> Amount 123 convertAmountToCommodity c (Amount _ q _) = Amount c q Nothing 124 125 -- | Convert an amount to the commodity of its assigned price, if any. Notes: 126 -- 127 -- - price amounts must be MixedAmounts with exactly one component Amount (or there will be a runtime error) 128 -- 129 -- - price amounts should be positive, though this is not currently enforced 130 costOfAmount :: Amount -> Amount 131 costOfAmount a@(Amount _ q price) = 132 case price of 133 Nothing -> a 134 Just (UnitPrice (Mixed [Amount pc pq Nothing])) -> Amount pc (pq*q) Nothing 135 Just (TotalPrice (Mixed [Amount pc pq Nothing])) -> Amount pc (pq*signum q) Nothing 136 _ -> error' "costOfAmount: Malformed price encountered, programmer error" 137 138 -- | Divide an amount's quantity by a constant. 139 divideAmount :: Amount -> Double -> Amount 140 divideAmount a@Amount{quantity=q} d = a{quantity=q/d} 141 142 -- | Is this amount negative ? The price is ignored. 143 isNegativeAmount :: Amount -> Bool 144 isNegativeAmount Amount{quantity=q} = q < 0 145 146 -- | Does this amount appear to be zero when displayed with its given precision ? 147 isZeroAmount :: Amount -> Bool 148 isZeroAmount = null . filter (`elem` "123456789") . showAmountWithoutPriceOrCommodity 149 150 -- | Is this amount "really" zero, regardless of the display precision ? 151 -- Since we are using floating point, for now just test to some high precision. 152 isReallyZeroAmount :: Amount -> Bool 153 isReallyZeroAmount = null . filter (`elem` "123456789") . printf ("%."++show zeroprecision++"f") . quantity 154 where zeroprecision = 8 155 156 -- | Get the string representation of an amount, based on its commodity's 157 -- display settings except using the specified precision. 158 showAmountWithPrecision :: Int -> Amount -> String 159 showAmountWithPrecision p = showAmount . setAmountPrecision p 160 161 -- | Set the display precision in the amount's commodity. 162 setAmountPrecision :: Int -> Amount -> Amount 163 setAmountPrecision p a@Amount{commodity=c} = a{commodity=c{precision=p}} 164 165 -- | Get the unambiguous string representation of an amount, for debugging. 166 showAmountDebug :: Amount -> String 167 showAmountDebug (Amount c q pri) = printf "Amount {commodity = %s, quantity = %s, price = %s}" 168 (show c) (show q) (maybe "" showPriceDebug pri) 169 170 -- | Get the string representation of an amount, without any \@ price. 171 showAmountWithoutPrice :: Amount -> String 172 showAmountWithoutPrice a = showAmount a{price=Nothing} 173 174 -- | Get the string representation of an amount, without any price or commodity symbol. 175 showAmountWithoutPriceOrCommodity :: Amount -> String 176 showAmountWithoutPriceOrCommodity a@Amount{commodity=c} = showAmount a{commodity=c{symbol=""}, price=Nothing} 177 178 showPrice :: Price -> String 179 showPrice (UnitPrice pa) = " @ " ++ showMixedAmount pa 180 showPrice (TotalPrice pa) = " @@ " ++ showMixedAmount pa 181 182 showPriceDebug :: Price -> String 183 showPriceDebug (UnitPrice pa) = " @ " ++ showMixedAmountDebug pa 184 showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa 185 186 -- | Get the string representation of an amount, based on its commodity's 187 -- display settings. String representations equivalent to zero are 188 -- converted to just \"0\". 189 showAmount :: Amount -> String 190 showAmount (Amount (Commodity {symbol="AUTO"}) _ _) = "" -- can appear in an error message 191 showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) _ pri) = 192 case side of 193 L -> printf "%s%s%s%s" sym' space quantity' price 194 R -> printf "%s%s%s%s" quantity' space sym' price 195 where 196 quantity = showamountquantity a 197 displayingzero = null $ filter (`elem` "123456789") $ quantity 198 (quantity',sym') | displayingzero = ("0","") 199 | otherwise = (quantity,quoteCommoditySymbolIfNeeded sym) 200 space = if (not (null sym') && spaced) then " " else "" 201 price = maybe "" showPrice pri 202 203 -- | Get the string representation of the number part of of an amount, 204 -- using the display settings from its commodity. 205 showamountquantity :: Amount -> String 206 showamountquantity (Amount (Commodity {decimalpoint=d,precision=p,separator=s,separatorpositions=spos}) q _) = 207 punctuatenumber d s spos $ qstr 208 where 209 -- isint n = fromIntegral (round n) == n 210 qstr -- p == maxprecision && isint q = printf "%d" (round q::Integer) 211 | p == maxprecisionwithpoint = printf "%f" q 212 | p == maxprecision = chopdotzero $ printf "%f" q 213 | otherwise = printf ("%."++show p++"f") q 214 215 -- | Replace a number string's decimal point with the specified character, 216 -- and add the specified digit group separators. 217 punctuatenumber :: Char -> Char -> [Int] -> String -> String 218 punctuatenumber dec sep grps str = sign ++ reverse (addseps sep (extend grps) (reverse int)) ++ frac'' 219 where 220 (sign,num) = break isDigit str 221 (int,frac) = break (=='.') num 222 frac' = dropWhile (=='.') frac 223 frac'' | null frac' = "" 224 | otherwise = dec:frac' 225 extend [] = [] 226 extend gs = init gs ++ repeat (last gs) 227 addseps _ [] str = str 228 addseps sep (g:gs) str 229 | length str <= g = str 230 | otherwise = let (s,rest) = splitAt g str 231 in s ++ [sep] ++ addseps sep gs rest 232 233 chopdotzero str = reverse $ case reverse str of 234 '0':'.':s -> s 235 s -> s 236 237 -- | For rendering: a special precision value which means show all available digits. 238 maxprecision :: Int 239 maxprecision = 999998 240 241 -- | For rendering: a special precision value which forces display of a decimal point. 242 maxprecisionwithpoint :: Int 243 maxprecisionwithpoint = 999999 244 245 -- | Replace an amount's commodity with the canonicalised version from 246 -- the provided commodity map. 247 canonicaliseAmountCommodity :: Maybe (Map.Map String Commodity) -> Amount -> Amount 248 canonicaliseAmountCommodity Nothing = id 249 canonicaliseAmountCommodity (Just canonicalcommoditymap) = fixamount 250 where 251 -- like journalCanonicaliseAmounts 252 fixamount a@Amount{commodity=c} = a{commodity=fixcommodity c} 253 fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap 254 255 ------------------------------------------------------------------------------- 256 -- MixedAmount 257 258 instance Show MixedAmount where show = showMixedAmount 259 260 instance Num MixedAmount where 261 fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing] 262 negate (Mixed as) = Mixed $ map negate as 263 (+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs 264 (*) = error' "programming error, mixed amounts do not support multiplication" 265 abs = error' "programming error, mixed amounts do not support abs" 266 signum = error' "programming error, mixed amounts do not support signum" 267 268 -- | The empty mixed amount. 269 nullmixedamt :: MixedAmount 270 nullmixedamt = Mixed [] 271 272 -- | A temporary value for parsed transactions which had no amount specified. 273 missingamt :: MixedAmount 274 missingamt = Mixed [Amount unknown{symbol="AUTO"} 0 Nothing] 275 276 -- | Simplify a mixed amount by removing redundancy in its component amounts, 277 -- as follows: 278 -- 279 -- 1. combine amounts which have the same commodity, discarding all but the first's price. 280 -- 281 -- 2. remove zero amounts 282 -- 283 -- 3. if there are no amounts at all, add a single zero amount 284 normaliseMixedAmount :: MixedAmount -> MixedAmount 285 normaliseMixedAmount (Mixed as) = Mixed as'' 286 where 287 as'' = if null nonzeros then [nullamt] else nonzeros 288 (_,nonzeros) = partition (\a -> isReallyZeroAmount a && Mixed [a] /= missingamt) as' 289 as' = map sumAmountsDiscardingAllButFirstPrice $ group $ sort as 290 sort = sortBy (\a1 a2 -> compare (sym a1) (sym a2)) 291 group = groupBy (\a1 a2 -> sym a1 == sym a2) 292 sym = symbol . commodity 293 294 sumAmountsDiscardingAllButFirstPrice [] = nullamt 295 sumAmountsDiscardingAllButFirstPrice as = (sum as){price=price $ head as} 296 297 -- | Get a mixed amount's component amounts. 298 amounts :: MixedAmount -> [Amount] 299 amounts (Mixed as) = as 300 301 -- | Convert a mixed amount's component amounts to the commodity of their 302 -- assigned price, if any. 303 costOfMixedAmount :: MixedAmount -> MixedAmount 304 costOfMixedAmount (Mixed as) = Mixed $ map costOfAmount as 305 306 -- | Divide a mixed amount's quantities by a constant. 307 divideMixedAmount :: MixedAmount -> Double -> MixedAmount 308 divideMixedAmount (Mixed as) d = Mixed $ map (flip divideAmount d) as 309 310 -- | Is this mixed amount negative, if it can be normalised to a single commodity ? 311 isNegativeMixedAmount :: MixedAmount -> Maybe Bool 312 isNegativeMixedAmount m = case as of [a] -> Just $ isNegativeAmount a 313 _ -> Nothing 314 where as = amounts $ normaliseMixedAmount m 315 316 -- | Does this mixed amount appear to be zero when displayed with its given precision ? 317 isZeroMixedAmount :: MixedAmount -> Bool 318 isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount 319 320 -- | Is this mixed amount "really" zero ? See isReallyZeroAmount. 321 isReallyZeroMixedAmount :: MixedAmount -> Bool 322 isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmount 323 324 -- | Is this mixed amount "really" zero, after converting to cost 325 -- commodities where possible ? 326 isReallyZeroMixedAmountCost :: MixedAmount -> Bool 327 isReallyZeroMixedAmountCost = isReallyZeroMixedAmount . costOfMixedAmount 328 329 -- -- | Convert a mixed amount to the specified commodity, assuming an exchange rate of 1. 330 -- convertMixedAmountToCommodity :: Commodity -> MixedAmount -> Amount 331 -- convertMixedAmountToCommodity c (Mixed as) = Amount c total Nothing 332 -- where 333 -- total = sum $ map (quantity . convertAmountToCommodity c) as 334 335 -- -- | MixedAmount derived Eq instance in Types.hs doesn't know that we 336 -- -- want $0 = EUR0 = 0. Yet we don't want to drag all this code over there. 337 -- -- For now, use this when cross-commodity zero equality is important. 338 -- mixedAmountEquals :: MixedAmount -> MixedAmount -> Bool 339 -- mixedAmountEquals a b = amounts a' == amounts b' || (isZeroMixedAmount a' && isZeroMixedAmount b') 340 -- where a' = normaliseMixedAmount a 341 -- b' = normaliseMixedAmount b 342 343 -- | Get the string representation of a mixed amount, showing each of 344 -- its component amounts. NB a mixed amount can have an empty amounts 345 -- list in which case it shows as \"\". 346 showMixedAmount :: MixedAmount -> String 347 showMixedAmount m = vConcatRightAligned $ map show $ amounts $ normaliseMixedAmount m 348 349 -- | Set the display precision in the amount's commodities. 350 setMixedAmountPrecision :: Int -> MixedAmount -> MixedAmount 351 setMixedAmountPrecision p (Mixed as) = Mixed $ map (setAmountPrecision p) as 352 353 -- | Get the string representation of a mixed amount, showing each of its 354 -- component amounts with the specified precision, ignoring their 355 -- commoditys' display precision settings. 356 showMixedAmountWithPrecision :: Int -> MixedAmount -> String 357 showMixedAmountWithPrecision p m = 358 vConcatRightAligned $ map (showAmountWithPrecision p) $ amounts $ normaliseMixedAmount m 359 360 -- | Get an unambiguous string representation of a mixed amount for debugging. 361 showMixedAmountDebug :: MixedAmount -> String 362 showMixedAmountDebug m = printf "Mixed [%s]" as 363 where as = intercalate "\n " $ map showAmountDebug $ amounts $ normaliseMixedAmount m 364 365 -- | Get the string representation of a mixed amount, but without 366 -- any \@ prices. 367 showMixedAmountWithoutPrice :: MixedAmount -> String 368 showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth as 369 where 370 (Mixed as) = normaliseMixedAmount $ stripPrices m 371 stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{price=Nothing} 372 width = maximum $ map (length . show) as 373 showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice 374 375 -- | Replace a mixed amount's commodity with the canonicalised version from 376 -- the provided commodity map. 377 canonicaliseMixedAmountCommodity :: Maybe (Map.Map String Commodity) -> MixedAmount -> MixedAmount 378 canonicaliseMixedAmountCommodity canonicalcommoditymap (Mixed as) = Mixed $ map (canonicaliseAmountCommodity canonicalcommoditymap) as 379 380 ------------------------------------------------------------------------------- 381 -- misc 382 383 tests_Hledger_Data_Amount = TestList [ 384 385 -- Amount 386 387 "costOfAmount" ~: do 388 costOfAmount (euros 1) `is` euros 1 389 costOfAmount (euros 2){price=Just $ UnitPrice $ Mixed [dollars 2]} `is` dollars 4 390 costOfAmount (euros 1){price=Just $ TotalPrice $ Mixed [dollars 2]} `is` dollars 2 391 costOfAmount (euros (-1)){price=Just $ TotalPrice $ Mixed [dollars 2]} `is` dollars (-2) 392 393 ,"isZeroAmount" ~: do 394 assertBool "" $ isZeroAmount $ Amount unknown 0 Nothing 395 assertBool "" $ isZeroAmount $ dollars 0 396 397 ,"negating amounts" ~: do 398 let a = dollars 1 399 negate a `is` a{quantity=(-1)} 400 let b = (dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]} 401 negate b `is` b{quantity=(-1)} 402 403 ,"adding amounts" ~: do 404 let a1 = dollars 1.23 405 let a2 = dollars (-1.23) 406 let a3 = dollars (-1.23) 407 (a1 + a2) `is` Amount (comm "$") 0 Nothing 408 (a1 + a3) `is` Amount (comm "$") 0 Nothing 409 (a2 + a3) `is` Amount (comm "$") (-2.46) Nothing 410 (a3 + a3) `is` Amount (comm "$") (-2.46) Nothing 411 sum [a1,a2,a3,-a3] `is` Amount (comm "$") 0 Nothing 412 -- highest precision is preserved 413 let ap1 = (dollars 1){commodity=dollar{precision=1}} 414 ap3 = (dollars 1){commodity=dollar{precision=3}} 415 (sum [ap1,ap3]) `is` ap3{quantity=2} 416 (sum [ap3,ap1]) `is` ap3{quantity=2} 417 -- adding different commodities assumes conversion rate 1 418 assertBool "" $ isZeroAmount (a1 - euros 1.23) 419 420 ,"showAmount" ~: do 421 showAmount (dollars 0 + pounds 0) `is` "0" 422 423 -- MixedAmount 424 425 ,"normaliseMixedAmount" ~: do 426 normaliseMixedAmount (Mixed []) `is` Mixed [nullamt] 427 assertBool "" $ isZeroMixedAmount $ normaliseMixedAmount (Mixed [Amount {commodity=dollar, quantity=10, price=Nothing} 428 ,Amount {commodity=dollar, quantity=10, price=Just (TotalPrice (Mixed [Amount {commodity=euro, quantity=7, price=Nothing}]))} 429 ,Amount {commodity=dollar, quantity=(-10), price=Nothing} 430 ,Amount {commodity=dollar, quantity=(-10), price=Just (TotalPrice (Mixed [Amount {commodity=euro, quantity=7, price=Nothing}]))} 431 ]) 432 433 ,"adding mixed amounts" ~: do 434 let dollar0 = dollar{precision=0} 435 (sum $ map (Mixed . (\a -> [a])) 436 [Amount dollar 1.25 Nothing, 437 Amount dollar0 (-1) Nothing, 438 Amount dollar (-0.25) Nothing]) 439 `is` Mixed [Amount unknown 0 Nothing] 440 441 ,"showMixedAmount" ~: do 442 showMixedAmount (Mixed [dollars 1]) `is` "$1.00" 443 showMixedAmount (Mixed [(dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]}]) `is` "$1.00 @ €2.00" 444 showMixedAmount (Mixed [dollars 0]) `is` "0" 445 showMixedAmount (Mixed []) `is` "0" 446 showMixedAmount missingamt `is` "" 447 448 ,"showMixedAmountWithoutPrice" ~: do 449 let a = (dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]} 450 showMixedAmountWithoutPrice (Mixed [a]) `is` "$1.00" 451 showMixedAmountWithoutPrice (Mixed [a, (-a)]) `is` "0" 452 453 ]