From 4c97ca55149d76ee1b5f2cca2554f969756a7f95 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Sat, 22 Nov 2008 20:30:43 +0000
Subject: [PATCH] smarter handling of priced amounts. Normalising and some
 basic arithmetic now preserve prices. Currently, amounts with the same
 commodity but different prices are kept separate. Useful ?

---
 Ledger/Amount.hs | 28 +++++++++++++++++++++-------
 Ledger/Types.hs  |  4 ++--
 2 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/Ledger/Amount.hs b/Ledger/Amount.hs
index ff43cd0ec..020509cd4 100644
--- a/Ledger/Amount.hs
+++ b/Ledger/Amount.hs
@@ -55,14 +55,22 @@ instance Num Amount where
     (-) = amountop (-)
     (*) = amountop (*)
 
+instance Ord Amount where
+    compare (Amount ac aq ap) (Amount bc bq bp) = compare (ac,aq,ap) (bc,bq,bp)
+
 instance Num MixedAmount where
     fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing]
-    negate (Mixed as) = Mixed $ map negate as
+    negate (Mixed as) = Mixed $ map negateAmountPreservingPrice as
     (+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ filter (not . isZeroAmount) $ as ++ bs
     (*)    = error "programming error, mixed amounts do not support multiplication"
     abs    = error "programming error, mixed amounts do not support abs"
     signum = error "programming error, mixed amounts do not support signum"
 
+instance Ord MixedAmount where
+    compare (Mixed as) (Mixed bs) = compare as bs
+
+negateAmountPreservingPrice a = (-a){price=price a}
+
 -- | Apply a binary arithmetic operator to two amounts - converting to the
 -- second one's commodity, adopting the lowest precision, and discarding
 -- any price information. (Using the second commodity is best since sum
@@ -136,14 +144,20 @@ showMixedAmountOrZero a
     | isZeroMixedAmount a = "0"
     | otherwise = showMixedAmount a
 
--- | Simplify a mixed amount by combining any of its component amounts
--- which have the same commodity.
+-- | Simplify a mixed amount by combining any component amounts which have
+-- the same commodity and the same price.
 normaliseMixedAmount :: MixedAmount -> MixedAmount
-normaliseMixedAmount (Mixed as) = Mixed $ map sum $ grouped
+normaliseMixedAmount (Mixed as) = Mixed as'
     where 
-      grouped = [filter (hassymbol s) as | s <- symbols]
-      symbols = sort $ nub $ map (symbol . commodity) as
-      hassymbol s a = s == (symbol $ commodity a)
+      as' = map sumAmountsPreservingPrice $ group $ sort as
+      sort = sortBy cmpsymbolandprice
+      cmpsymbolandprice a1 a2 = compare (sym a1,price a1) (sym a2,price a2)
+      group = groupBy samesymbolandprice 
+      samesymbolandprice a1 a2 = (sym a1 == sym a2) && (price a1 == price a2)
+      sym = symbol . commodity
+
+sumAmountsPreservingPrice [] = nullamt
+sumAmountsPreservingPrice as = (sum as){price=price $ head as}
 
 -- | Convert a mixed amount's component amounts to the commodity of their
 -- saved price, if any.
diff --git a/Ledger/Types.hs b/Ledger/Types.hs
index de5f938c7..1dc65c906 100644
--- a/Ledger/Types.hs
+++ b/Ledger/Types.hs
@@ -13,7 +13,7 @@ import qualified Data.Map as Map
 
 type AccountName = String
 
-data Side = L | R deriving (Eq,Show) 
+data Side = L | R deriving (Eq,Show,Ord) 
 
 data Commodity = Commodity {
       symbol :: String,  -- ^ the commodity's symbol
@@ -23,7 +23,7 @@ data Commodity = Commodity {
       spaced :: Bool,    -- ^ should there be a space between symbol and quantity
       comma :: Bool,     -- ^ should thousands be comma-separated
       precision :: Int   -- ^ number of decimal places to display
-    } deriving (Eq,Show)
+    } deriving (Eq,Show,Ord)
 
 data Amount = Amount {
       commodity :: Commodity,