From cafa59ac3d685569a96c13ea8d581ea8bd980f53 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Wed, 25 Nov 2009 12:15:53 +0000
Subject: [PATCH] price history support, first cut P directives now work, but
 differently from current c++ ledger for now. Each posting amount is assigned
 a fixed unit price from the price history when available (unless overridden
 by @). This is simple and useful for fixed-rate transactions such as foreign
 currency expenses.

---
 Ledger/RawLedger.hs | 38 ++++++++++++++++++++++++--------------
 Ledger/Types.hs     |  2 +-
 2 files changed, 25 insertions(+), 15 deletions(-)

diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs
index d90761693..928544c60 100644
--- a/Ledger/RawLedger.hs
+++ b/Ledger/RawLedger.hs
@@ -132,26 +132,37 @@ rawLedgerSelectingDate EffectiveDate rl =
 -- | Give all a ledger's amounts their canonical display settings.  That
 -- is, in each commodity, amounts will use the display settings of the
 -- first amount detected, and the greatest precision of the amounts
--- detected. Also, amounts are converted to cost basis if that flag is
--- active.
+-- detected.
+-- Also, missing unit prices are added if known from the price history.
+-- Also, amounts are converted to cost basis if that flag is active.
 canonicaliseAmounts :: Bool -> RawLedger -> RawLedger
-canonicaliseAmounts costbasis l@(RawLedger ms ps ts tls hs f fp ft) = RawLedger ms ps (map fixledgertransaction ts) tls hs f fp ft
+canonicaliseAmounts costbasis rl@(RawLedger ms ps ts tls hs f fp ft) = RawLedger ms ps (map fixledgertransaction ts) tls hs f fp ft
     where
       fixledgertransaction (LedgerTransaction d ed s c de co ts pr) = LedgerTransaction d ed s c de co (map fixrawposting ts) pr
-      fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t
-      fixmixedamount (Mixed as) = Mixed $ map fixamount as
-      fixamount = fixcommodity . (if costbasis then costOfAmount else id)
-      fixcommodity a = a{commodity=c} where c = canonicalcommoditymap ! symbol (commodity a)
-      canonicalcommoditymap =
-          Map.fromList [(s,firstc{precision=maxp}) | s <- commoditysymbols,
+          where
+            fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t
+            fixmixedamount (Mixed as) = Mixed $ map fixamount as
+            fixamount = (if costbasis then costOfAmount else id) . fixprice . fixcommodity
+            fixcommodity a = a{commodity=c} where c = canonicalcommoditymap ! symbol (commodity a)
+            canonicalcommoditymap =
+                Map.fromList [(s,firstc{precision=maxp}) | s <- commoditysymbols,
                         let cs = commoditymap ! s,
                         let firstc = head cs,
                         let maxp = maximum $ map precision cs
                        ]
-      commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols]
-      commoditieswithsymbol s = filter ((s==) . symbol) commodities
-      commoditysymbols = nub $ map symbol commodities
-      commodities = map commodity $ concatMap (amounts . tamount) $ rawLedgerTransactions l
+            commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols]
+            commoditieswithsymbol s = filter ((s==) . symbol) commodities
+            commoditysymbols = nub $ map symbol commodities
+            commodities = map commodity $ concatMap (amounts . tamount) $ rawLedgerTransactions rl
+            fixprice a@Amount{price=Just _} = a
+            fixprice a@Amount{commodity=c} = a{price=rawLedgerHistoricalPriceFor rl c d}
+
+            -- | Get the price for commodity on the specified day from the price database, if known.
+            rawLedgerHistoricalPriceFor :: RawLedger -> Commodity -> Day -> Maybe MixedAmount
+            rawLedgerHistoricalPriceFor rl c@Commodity{symbol=s} d = do
+              let ps = reverse $ filter ((<= d).hdate) $ filter ((s==).hsymbol1) $ sortBy (comparing hdate) $ historical_prices rl
+              case ps of (HistoricalPrice {hdate=d, hsymbol2=s, hprice=q}:_) -> Just $ Mixed [Amount{commodity=canonicalcommoditymap ! s,quantity=q,price=Nothing}]
+                         _ -> Nothing
 
 -- | Get just the amounts from a ledger, in the order parsed.
 rawLedgerAmounts :: RawLedger -> [MixedAmount]
@@ -172,7 +183,6 @@ rawLedgerConvertTimeLog t l0 = l0 { ledger_txns = convertedTimeLog ++ ledger_txn
                                   }
     where convertedTimeLog = entriesFromTimeLogEntries t $ open_timelog_entries l0
 
-
 -- | The (fully specified) date span containing all the raw ledger's transactions,
 -- or DateSpan Nothing Nothing if there are none.
 rawLedgerDateSpan :: RawLedger -> DateSpan
diff --git a/Ledger/Types.hs b/Ledger/Types.hs
index 947dc0909..0ceabc3fa 100644
--- a/Ledger/Types.hs
+++ b/Ledger/Types.hs
@@ -54,7 +54,7 @@ data Commodity = Commodity {
 data Amount = Amount {
       commodity :: Commodity,
       quantity :: Double,
-      price :: Maybe MixedAmount  -- ^ optional per-unit price for this amount at the time of entry
+      price :: Maybe MixedAmount  -- ^ unit price for this amount at posting time, if known (from @ or P)
     } deriving (Eq)
 
 newtype MixedAmount = Mixed [Amount] deriving (Eq)