diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index 09b444e4c..ef370008a 100644 --- a/Ledger/Parse.hs +++ b/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" diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 930383cc6..9da8610c8 100644 --- a/Ledger/RawLedger.hs +++ b/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) = - RawLedger ms ps (filter matchdesc es) tls f +filterRawLedgerEntriesByDescription pats (RawLedger ms ps es tls hs 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) = - RawLedger ms ps (filter matchdate es) tls f +filterRawLedgerEntriesByDate (DateSpan begin end) (RawLedger ms ps es tls hs 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) = - RawLedger ms ps (filter estatus es) tls f +filterRawLedgerEntriesByClearedStatus True (RawLedger ms ps es tls hs 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) = - RawLedger ms ps (map filtertxns es) tls f +filterRawLedgerTransactionsByRealness True (RawLedger ms ps es tls hs 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) = - RawLedger ms ps (filter (any (matchpats apats . taccount) . etransactions) es) tls f +filterRawLedgerEntriesByAccount apats (RawLedger ms ps es tls hs 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 diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 845c47f8e..f0a326070 100644 --- a/Ledger/Types.hs +++ b/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) diff --git a/Tests.hs b/Tests.hs index d67b5bb42..0deb86c4d 100644 --- a/Tests.hs +++ b/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 . (" "++)