optimise canonicaliseAmounts

First optimisation in a while. hledger -s bal on my ledger took 2s, and profiling showed:

	total time  =        0.66 secs   (33 ticks @ 20 ms)
	total alloc = 3,631,667,848 bytes  (excludes profiling overheads)

     canonicaliseAmounts                             1   0.0    0.8      69.7       92.4
      rawLedgerCommoditiesWithSymbol              3928  27.3   23.1      69.7       91.6
       rawLedgerCommodities                          0  18.2   18.7      42.4       68.5
        amounts                                7712628   3.0    0.0       3.0        0.0
        rawLedgerAmounts                             0   0.0    9.3      21.2       49.9
         rawLedgerTransactions                       0   9.1   19.5      21.2       40.5
          flattenEntry                         3408636  12.1   21.0      12.1       21.0

Now it takes 1/2s and the profile is healthier:

	total time  =        0.14 secs   (7 ticks @ 20 ms)
	total alloc = 275,520,536 bytes  (excludes profiling overheads)

     canonicaliseAmounts                             1   0.0    0.4       0.0        0.5
      amounts                                     1964   0.0    0.0       0.0        0.0
      rawLedgerTransactions                          0   0.0    0.1       0.0        0.1
       flattenEntry                                868   0.0    0.1       0.0        0.1

Ledger/RawLedger.hs

@@ -8,6 +8,7 @@ the cached 'Ledger'.
 module Ledger.RawLedger
 where
 import qualified Data.Map as Map
+import Data.Map ((!))
 import Ledger.Utils
 import Ledger.Types
 import Ledger.AccountName
@@ -92,36 +93,32 @@ filterRawLedgerEntriesByAccount apats (RawLedger ms ps es f) =
 -- detected. Also, amounts are converted to cost basis if that flag is
 -- active.
 canonicaliseAmounts :: Bool -> RawLedger -> RawLedger
-canonicaliseAmounts costbasis l@(RawLedger ms ps es f) = RawLedger ms ps (map fixEntryAmounts es) f
+canonicaliseAmounts costbasis l@(RawLedger ms ps es f) = RawLedger ms ps (map fixentry es) f
     where 
-      fixEntryAmounts (Entry d s c de co ts pr) = Entry d s c de co (map fixRawTransactionAmounts ts) pr
+      fixentry (Entry d s c de co ts pr) = Entry d s c de co (map fixrawtransaction ts) pr
-      fixRawTransactionAmounts (RawTransaction ac a c t) = RawTransaction ac (fixMixedAmount a) c t
+      fixrawtransaction (RawTransaction ac a c t) = RawTransaction ac (fixmixedamount a) c t
-      fixMixedAmount (Mixed as) = Mixed $ map fixAmount as
+      fixmixedamount (Mixed as) = Mixed $ map fixamount as
-      fixAmount | costbasis = fixcommodity . costOfAmount
+      fixamount = fixcommodity . (if costbasis then costOfAmount else id)
-                | otherwise = fixcommodity
+      fixcommodity a = a{commodity=c} where c = canonicalcommoditymap ! (symbol $ commodity a)
-      fixcommodity a = a{commodity=canonicalcommodity $ commodity a}
+      canonicalcommoditymap = 
-      canonicalcommodity c = (firstoccurrenceof c){precision=maxprecision c}
+          Map.fromList [(s,firstc{precision=maxp}) | s <- commoditysymbols,
-          where
+                        let cs = commoditymap ! s,
-            firstoccurrenceof c = head $ rawLedgerCommoditiesWithSymbol l (symbol c)
+                        let firstc = head cs,
-            maxprecision c = maximum $ map precision $ rawLedgerCommoditiesWithSymbol l (symbol c)
+                        let maxp = maximum $ map precision cs
-
+                       ]
--- | Get all amount commodities with a given symbol, in the order parsed.
+      commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols]
--- Must be called with a good symbol or it will fail.
+      commoditieswithsymbol s = filter ((s==) . symbol) commodities
-rawLedgerCommoditiesWithSymbol :: RawLedger -> String -> [Commodity]
+      commoditysymbols = nub $ map symbol commodities
-rawLedgerCommoditiesWithSymbol l s = 
+      commodities = map commodity $ concatMap (amounts . amount) $ rawLedgerTransactions l
-    fromMaybe (error $ "no such commodity "++s) (Map.lookup s map)
-    where
-      map = Map.fromList [(symbol $ head cs,cs) | cs <- groupBy same $ rawLedgerCommodities l]
-      same c1 c2 = symbol c1 == symbol c2
-
--- | Get just the ammount commodities from a ledger, in the order parsed.
-rawLedgerCommodities :: RawLedger -> [Commodity]
-rawLedgerCommodities = map commodity . concatMap amounts . rawLedgerAmounts
 
 -- | Get just the amounts from a ledger, in the order parsed.
 rawLedgerAmounts :: RawLedger -> [MixedAmount]
 rawLedgerAmounts = map amount . rawLedgerTransactions
 
+-- | Get just the ammount commodities from a ledger, in the order parsed.
+rawLedgerCommodities :: RawLedger -> [Commodity]
+rawLedgerCommodities = map commodity . concatMap amounts . rawLedgerAmounts
+
 -- | Get just the amount precisions from a ledger, in the order parsed.
 rawLedgerPrecisions :: RawLedger -> [Int]
 rawLedgerPrecisions = map precision . rawLedgerCommodities