1 {-|
    2 An 'Amount' is some quantity of money, shares, or anything else.
    3 
    4 A simple amount is a 'Commodity', quantity pair:
    5 
    6 @
    7   $1 
    8   £-50
    9   EUR 3.44 
   10   GOOG 500
   11   1.5h
   12   90apples
   13   0 
   14 @
   15 
   16 A 'MixedAmount' is zero or more simple amounts:
   17 
   18 @
   19   $50, EUR 3, AAPL 500
   20   16h, $13.55, oranges 6
   21 @
   22 
   23 Not implemented:
   24 Commodities may be convertible or not. A mixed amount containing only
   25 convertible commodities can be converted to a simple amount. Arithmetic
   26 examples:
   27 
   28 @
   29   $1 - $5 = $-4
   30   $1 + EUR 0.76 = $2
   31   EUR0.76 + $1 = EUR 1.52
   32   EUR0.76 - $1 = 0
   33   ($5, 2h) + $1 = ($6, 2h)
   34   ($50, EUR 3, AAPL 500) + ($13.55, oranges 6) = $67.51, AAPL 500, oranges 6
   35   ($50, EUR 3) * $-1 = $-53.96
   36   ($50, AAPL 500) * $-1 = error
   37 @   
   38 -}
   39 
   40 module Ledger.Amount
   41 where
   42 import qualified Data.Map as Map
   43 import Ledger.Utils
   44 import Ledger.Types
   45 import Ledger.Commodity
   46 
   47 
   48 instance Show Amount where show = showAmount
   49 instance Show MixedAmount where show = showMixedAmount
   50 
   51 instance Num Amount where
   52     abs (Amount c q p) = Amount c (abs q) p
   53     signum (Amount c q p) = Amount c (signum q) p
   54     fromInteger i = Amount (comm "") (fromInteger i) Nothing
   55     (+) = amountop (+)
   56     (-) = amountop (-)
   57     (*) = amountop (*)
   58 
   59 instance Ord Amount where
   60     compare (Amount ac aq ap) (Amount bc bq bp) = compare (ac,aq,ap) (bc,bq,bp)
   61 
   62 instance Num MixedAmount where
   63     fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing]
   64     negate (Mixed as) = Mixed $ map negateAmountPreservingPrice as
   65     (+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs
   66     (*)    = error "programming error, mixed amounts do not support multiplication"
   67     abs    = error "programming error, mixed amounts do not support abs"
   68     signum = error "programming error, mixed amounts do not support signum"
   69 
   70 instance Ord MixedAmount where
   71     compare (Mixed as) (Mixed bs) = compare as bs
   72 
   73 negateAmountPreservingPrice a = (-a){price=price a}
   74 
   75 -- | Apply a binary arithmetic operator to two amounts - converting to the
   76 -- second one's commodity, adopting the lowest precision, and discarding
   77 -- any price information. (Using the second commodity is best since sum
   78 -- and other folds start with a no-commodity amount.)
   79 amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount
   80 amountop op a@(Amount ac aq ap) b@(Amount bc bq bp) = 
   81     Amount bc ((quantity $ convertAmountTo bc a) `op` bq) Nothing
   82 
   83 -- | Convert an amount to the commodity of its saved price, if any.
   84 costOfAmount :: Amount -> Amount
   85 costOfAmount a@(Amount _ _ Nothing) = a
   86 costOfAmount a@(Amount _ q (Just price))
   87     | isZeroMixedAmount price = nullamt
   88     | otherwise = Amount pc (pq*q) Nothing
   89     where (Amount pc pq _) = head $ amounts price
   90 
   91 -- | Convert an amount to the specified commodity using the appropriate
   92 -- exchange rate (which is currently always 1).
   93 convertAmountTo :: Commodity -> Amount -> Amount
   94 convertAmountTo c2 (Amount c1 q p) = Amount c2 (q * conversionRate c1 c2) Nothing
   95 
   96 -- | Get the string representation of an amount, based on its commodity's
   97 -- display settings.
   98 showAmount :: Amount -> String
   99 showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) q pri)
  100     | sym=="AUTO" = "" -- can display one of these in an error message
  101     | side==L = printf "%s%s%s%s" sym space quantity price
  102     | side==R = printf "%s%s%s%s" quantity space sym price
  103     where 
  104       space = if spaced then " " else ""
  105       quantity = showAmount' a
  106       price = case pri of (Just pamt) -> " @ " ++ showMixedAmount pamt
  107                           Nothing -> ""
  108 
  109 -- | Get the string representation (of the number part of) of an amount
  110 showAmount' :: Amount -> String
  111 showAmount' (Amount (Commodity {comma=comma,precision=p}) q _) = quantity
  112   where
  113     quantity = commad $ printf ("%."++show p++"f") q
  114     commad = if comma then punctuatethousands else id
  115 
  116 -- | Add thousands-separating commas to a decimal number string
  117 punctuatethousands :: String -> String
  118 punctuatethousands s =
  119     sign ++ (addcommas int) ++ frac
  120     where 
  121       (sign,num) = break isDigit s
  122       (int,frac) = break (=='.') num
  123       addcommas = reverse . concat . intersperse "," . triples . reverse
  124       triples [] = []
  125       triples l  = [take 3 l] ++ (triples $ drop 3 l)
  126 
  127 -- | Does this amount appear to be zero when displayed with its given precision ?
  128 isZeroAmount :: Amount -> Bool
  129 isZeroAmount a = null $ filter (`elem` "123456789") $ showAmount a
  130 
  131 -- | Is this amount "really" zero, regardless of the display precision ?
  132 -- Since we are using floating point, for now just test to some high precision.
  133 isReallyZeroAmount :: Amount -> Bool
  134 isReallyZeroAmount a = null $ filter (`elem` "123456789") $ printf "%.10f" $ quantity a
  135 
  136 -- | Access a mixed amount's components.
  137 amounts :: MixedAmount -> [Amount]
  138 amounts (Mixed as) = as
  139 
  140 -- | Does this mixed amount appear to be zero - empty, or
  141 -- containing only simple amounts which appear to be zero ?
  142 isZeroMixedAmount :: MixedAmount -> Bool
  143 isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount
  144 
  145 -- | Is this mixed amount "really" zero ? See isReallyZeroAmount.
  146 isReallyZeroMixedAmount :: MixedAmount -> Bool
  147 isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmount
  148 
  149 -- | MixedAmount derives Eq in Types.hs, but that doesn't know that we
  150 -- want $0 = EUR0 = 0. Yet we don't want to drag all this code in there.
  151 -- When zero equality is important, use this, for now; should be used
  152 -- everywhere.
  153 mixedAmountEquals :: MixedAmount -> MixedAmount -> Bool
  154 mixedAmountEquals a b = amounts a' == amounts b' || (isZeroMixedAmount a' && isZeroMixedAmount b')
  155     where a' = normaliseMixedAmount a
  156           b' = normaliseMixedAmount b
  157 
  158 -- | Get the string representation of a mixed amount, showing each of
  159 -- its component amounts. NB a mixed amount can have an empty amounts
  160 -- list in which case it shows as \"\".
  161 showMixedAmount :: MixedAmount -> String
  162 showMixedAmount m = concat $ intersperse "\n" $ map showfixedwidth as
  163     where 
  164       (Mixed as) = normaliseMixedAmount m
  165       width = maximum $ map (length . show) $ as
  166       showfixedwidth = printf (printf "%%%ds" width) . show
  167 
  168 -- | Get the string representation of a mixed amount, and if it
  169 -- appears to be all zero just show a bare 0, ledger-style.
  170 showMixedAmountOrZero :: MixedAmount -> String
  171 showMixedAmountOrZero a
  172     | isZeroMixedAmount a = "0"
  173     | otherwise = showMixedAmount a
  174 
  175 -- | Simplify a mixed amount by combining any component amounts which have
  176 -- the same commodity and the same price. Also removes redundant zero amounts
  177 -- and adds a single zero amount if there are no amounts at all.
  178 normaliseMixedAmount :: MixedAmount -> MixedAmount
  179 normaliseMixedAmount (Mixed as) = Mixed as''
  180     where 
  181       as'' = map sumAmountsPreservingPrice $ group $ sort as'
  182       sort = sortBy cmpsymbolandprice
  183       cmpsymbolandprice a1 a2 = compare (sym a1,price a1) (sym a2,price a2)
  184       group = groupBy samesymbolandprice 
  185       samesymbolandprice a1 a2 = (sym a1 == sym a2) && (price a1 == price a2)
  186       sym = symbol . commodity
  187       as' | null nonzeros = [head $ zeros ++ [nullamt]]
  188           | otherwise = nonzeros
  189       (zeros,nonzeros) = partition isZeroAmount as
  190 
  191 sumAmountsPreservingPrice [] = nullamt
  192 sumAmountsPreservingPrice as = (sum as){price=price $ head as}
  193 
  194 -- | Convert a mixed amount's component amounts to the commodity of their
  195 -- saved price, if any.
  196 costOfMixedAmount :: MixedAmount -> MixedAmount
  197 costOfMixedAmount (Mixed as) = Mixed $ map costOfAmount as
  198 
  199 -- | The empty simple amount.
  200 nullamt :: Amount
  201 nullamt = Amount unknown 0 Nothing
  202 
  203 -- | The empty mixed amount.
  204 nullmixedamt :: MixedAmount
  205 nullmixedamt = Mixed []
  206 
  207 -- | A temporary value for parsed transactions which had no amount specified.
  208 missingamt :: MixedAmount
  209 missingamt = Mixed [Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0}) 0 Nothing]
  210