Added support for reading historical prices from files

Ledger/Parse.hs

@@ -59,6 +59,7 @@ ledgerFile = do entries <- many1 ledgerAnyEntry
                                   , liftM (return . addEntry)         ledgerEntry
                                   , liftM (return . addModifierEntry) ledgerModifierEntry
                                   , liftM (return . addPeriodicEntry) ledgerPeriodicEntry
+                                  , liftM (return . addHistoricalPrice) ledgerHistoricalPrice
                                   , emptyLine >> return (return id)
                                   , liftM (return . addTimeLogEntry)  timelogentry
                                   ]
@@ -220,6 +221,18 @@ ledgerPeriodicEntry = do
   transactions <- ledgertransactions
   return $ PeriodicEntry periodexpr transactions
 
+ledgerHistoricalPrice :: GenParser Char LedgerFileCtx HistoricalPrice
+ledgerHistoricalPrice = do
+  char 'P' <?> "hprice"
+  many spacenonewline
+  date <- ledgerdate
+  many spacenonewline
+  symbol1 <- commoditysymbol
+  many spacenonewline
+  (Mixed [Amount c price pri]) <- someamount
+  restofline
+  return $ HistoricalPrice date symbol1 (symbol c) price
+
 ledgerEntry :: GenParser Char LedgerFileCtx Entry
 ledgerEntry = do
   date <- ledgerdate <?> "entry"

Ledger/RawLedger.hs

@@ -34,6 +34,7 @@ rawLedgerEmpty = RawLedger { modifier_entries = []
                            , periodic_entries = []
                            , entries = []
                            , open_timelog_entries = []
+                           , historical_prices = []
                            , final_comment_lines = []
                            }
 
@@ -46,6 +47,9 @@ addModifierEntry me l0 = l0 { modifier_entries = me : (modifier_entries l0) }
 addPeriodicEntry :: PeriodicEntry -> RawLedger -> RawLedger
 addPeriodicEntry pe l0 = l0 { periodic_entries = pe : (periodic_entries l0) }
 
+addHistoricalPrice :: HistoricalPrice -> RawLedger -> RawLedger
+addHistoricalPrice h l0 = l0 { historical_prices = h : (historical_prices l0) }
+
 addTimeLogEntry :: TimeLogEntry -> RawLedger -> RawLedger
 addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : (open_timelog_entries l0) }
 
@@ -74,16 +78,16 @@ filterRawLedger span pats clearedonly realonly =
 
 -- | Keep only entries whose description matches the description patterns.
 filterRawLedgerEntriesByDescription :: [String] -> RawLedger -> RawLedger
-filterRawLedgerEntriesByDescription pats (RawLedger ms ps es tls f) = 
+filterRawLedgerEntriesByDescription pats (RawLedger ms ps es tls hs f) = 
-    RawLedger ms ps (filter matchdesc es) tls f
+    RawLedger ms ps (filter matchdesc es) tls hs f
     where matchdesc = matchpats pats . edescription
 
 -- | Keep only entries which fall between begin and end dates. 
 -- We include entries on the begin date and exclude entries on the end
 -- date, like ledger.  An empty date string means no restriction.
 filterRawLedgerEntriesByDate :: DateSpan -> RawLedger -> RawLedger
-filterRawLedgerEntriesByDate (DateSpan begin end) (RawLedger ms ps es tls f) = 
+filterRawLedgerEntriesByDate (DateSpan begin end) (RawLedger ms ps es tls hs f) = 
-    RawLedger ms ps (filter matchdate es) tls f
+    RawLedger ms ps (filter matchdate es) tls hs f
     where 
       matchdate e = (maybe True (edate e>=) begin) && (maybe True (edate e<) end)
 
@@ -91,21 +95,21 @@ filterRawLedgerEntriesByDate (DateSpan begin end) (RawLedger ms ps es tls f) =
 -- do no filtering.
 filterRawLedgerEntriesByClearedStatus :: Bool -> RawLedger -> RawLedger
 filterRawLedgerEntriesByClearedStatus False l = l
-filterRawLedgerEntriesByClearedStatus True  (RawLedger ms ps es tls f) =
+filterRawLedgerEntriesByClearedStatus True  (RawLedger ms ps es tls hs f) =
-    RawLedger ms ps (filter estatus es) tls f
+    RawLedger ms ps (filter estatus es) tls hs f
 
 -- | Strip out any virtual transactions, if the flag is true, otherwise do
 -- no filtering.
 filterRawLedgerTransactionsByRealness :: Bool -> RawLedger -> RawLedger
 filterRawLedgerTransactionsByRealness False l = l
-filterRawLedgerTransactionsByRealness True (RawLedger ms ps es tls f) =
+filterRawLedgerTransactionsByRealness True (RawLedger ms ps es tls hs f) =
-    RawLedger ms ps (map filtertxns es) tls f
+    RawLedger ms ps (map filtertxns es) tls hs f
     where filtertxns e@Entry{etransactions=ts} = e{etransactions=filter isReal ts}
 
 -- | Keep only entries which affect accounts matched by the account patterns.
 filterRawLedgerEntriesByAccount :: [String] -> RawLedger -> RawLedger
-filterRawLedgerEntriesByAccount apats (RawLedger ms ps es tls f) =
+filterRawLedgerEntriesByAccount apats (RawLedger ms ps es tls hs f) =
-    RawLedger ms ps (filter (any (matchpats apats . taccount) . etransactions) es) tls f
+    RawLedger ms ps (filter (any (matchpats apats . taccount) . etransactions) es) tls hs f
 
 -- | Give all a ledger's amounts their canonical display settings.  That
 -- is, in each commodity, amounts will use the display settings of the
@@ -113,7 +117,7 @@ filterRawLedgerEntriesByAccount apats (RawLedger ms ps es tls 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 tls f) = RawLedger ms ps (map fixentry es) tls f
+canonicaliseAmounts costbasis l@(RawLedger ms ps es tls hs f) = RawLedger ms ps (map fixentry es) tls hs f
     where 
       fixentry (Entry d s c de co ts pr) = Entry d s c de co (map fixrawtransaction ts) pr
       fixrawtransaction (RawTransaction ac a c t) = RawTransaction ac (fixmixedamount a) c t

Ledger/Types.hs

@@ -73,11 +73,19 @@ data Entry = Entry {
       epreceding_comment_lines :: String
     } deriving (Eq)
 
+data HistoricalPrice = HistoricalPrice {
+     hdate :: Day,
+     hsymbol1 :: String,
+     hsymbol2 :: String,
+     hprice :: Double
+} deriving (Eq,Show)
+
 data RawLedger = RawLedger {
       modifier_entries :: [ModifierEntry],
       periodic_entries :: [PeriodicEntry],
       entries :: [Entry],
       open_timelog_entries :: [TimeLogEntry],
+      historical_prices :: [HistoricalPrice],
       final_comment_lines :: String
     } deriving (Eq)
 

Tests.hs

@@ -220,7 +220,9 @@ misc_tests = TestList [
      [
       nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses",          amount=Mixed [dollars 15]}
      ]
-
+  ,
+  "ledgerentry"        ~: do
+    assertparseequal price1 (parseWithCtx ledgerHistoricalPrice price1_str)
   ]
 
 balancereportacctnames_tests = TestList 
@@ -829,7 +831,8 @@ rawledger7 = RawLedger
              ],
              epreceding_comment_lines=""
            }
-          ]
+          ] 
+          []
           []
           ""
 
@@ -856,6 +859,9 @@ timelog1 = TimeLog [
             timelogentry2
            ]
 
+price1_str = "P 2004/05/01 XYZ $55\n"
+price1 = HistoricalPrice (parsedate "2004/05/01") "XYZ" "$" 55
+
 a1 = Mixed [(hours 1){price=Just $ Mixed [Amount (comm "$") 10 Nothing]}]
 a2 = Mixed [(hours 2){price=Just $ Mixed [Amount (comm "EUR") 10 Nothing]}]
 a3 = Mixed $ (amounts a1) ++ (amounts a2)
@@ -894,6 +900,7 @@ rawLedgerWithAmounts as =
         [] 
         [nullentry{edescription=a,etransactions=[nullrawtxn{tamount=parse a}]} | a <- as]
         []
+        []
         ""
             where parse = fromparse . parseWithCtx transactionamount . (" "++)