From 1548e84aa98e57bc803015df10f8be74719624b1 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 8 Apr 2009 03:40:05 +0000 Subject: [PATCH] add file path field to RawLedger --- Ledger/RawLedger.hs | 27 ++++++++++++++------------- Ledger/Types.hs | 3 ++- Utils.hs | 2 +- 3 files changed, 17 insertions(+), 15 deletions(-) diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 2a9412dbb..97bba9a16 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -36,6 +36,7 @@ rawLedgerEmpty = RawLedger { modifier_txns = [] , open_timelog_entries = [] , historical_prices = [] , final_comment_lines = [] + , filepath = "" } addLedgerTransaction :: LedgerTransaction -> RawLedger -> RawLedger @@ -78,16 +79,16 @@ filterRawLedger span pats clearedonly realonly = -- | Keep only ledger transactions whose description matches the description patterns. filterRawLedgerTransactionsByDescription :: [String] -> RawLedger -> RawLedger -filterRawLedgerTransactionsByDescription pats (RawLedger ms ps ts tls hs f) = - RawLedger ms ps (filter matchdesc ts) tls hs f +filterRawLedgerTransactionsByDescription pats (RawLedger ms ps ts tls hs f fp) = + RawLedger ms ps (filter matchdesc ts) tls hs f fp where matchdesc = matchpats pats . ltdescription -- | Keep only ledger transactions which fall between begin and end dates. -- We include transactions on the begin date and exclude transactions on the end -- date, like ledger. An empty date string means no restriction. filterRawLedgerTransactionsByDate :: DateSpan -> RawLedger -> RawLedger -filterRawLedgerTransactionsByDate (DateSpan begin end) (RawLedger ms ps ts tls hs f) = - RawLedger ms ps (filter matchdate ts) tls hs f +filterRawLedgerTransactionsByDate (DateSpan begin end) (RawLedger ms ps ts tls hs f fp) = + RawLedger ms ps (filter matchdate ts) tls hs f fp where matchdate t = (maybe True (ltdate t>=) begin) && (maybe True (ltdate t<) end) @@ -95,29 +96,29 @@ filterRawLedgerTransactionsByDate (DateSpan begin end) (RawLedger ms ps ts tls h -- cleared/uncleared status, if there is one. filterRawLedgerTransactionsByClearedStatus :: Maybe Bool -> RawLedger -> RawLedger filterRawLedgerTransactionsByClearedStatus Nothing rl = rl -filterRawLedgerTransactionsByClearedStatus (Just val) (RawLedger ms ps ts tls hs f) = - RawLedger ms ps (filter ((==val).ltstatus) ts) tls hs f +filterRawLedgerTransactionsByClearedStatus (Just val) (RawLedger ms ps ts tls hs f fp) = + RawLedger ms ps (filter ((==val).ltstatus) ts) tls hs f fp -- | Strip out any virtual postings, if the flag is true, otherwise do -- no filtering. filterRawLedgerPostingsByRealness :: Bool -> RawLedger -> RawLedger filterRawLedgerPostingsByRealness False l = l -filterRawLedgerPostingsByRealness True (RawLedger mts pts ts tls hs f) = - RawLedger mts pts (map filtertxns ts) tls hs f +filterRawLedgerPostingsByRealness True (RawLedger mts pts ts tls hs f fp) = + RawLedger mts pts (map filtertxns ts) tls hs f fp where filtertxns t@LedgerTransaction{ltpostings=ps} = t{ltpostings=filter isReal ps} -- | Strip out any postings to accounts deeper than the specified depth -- (and any ledger transactions which have no postings as a result). filterRawLedgerPostingsByDepth :: Int -> RawLedger -> RawLedger -filterRawLedgerPostingsByDepth depth (RawLedger mts pts ts tls hs f) = - RawLedger mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f +filterRawLedgerPostingsByDepth depth (RawLedger mts pts ts tls hs f fp) = + RawLedger mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f fp where filtertxns t@LedgerTransaction{ltpostings=ps} = t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps} -- | Keep only ledger transactions which affect accounts matched by the account patterns. filterRawLedgerTransactionsByAccount :: [String] -> RawLedger -> RawLedger -filterRawLedgerTransactionsByAccount apats (RawLedger ms ps ts tls hs f) = - RawLedger ms ps (filter (any (matchpats apats . paccount) . ltpostings) ts) tls hs f +filterRawLedgerTransactionsByAccount apats (RawLedger ms ps ts tls hs f fp) = + RawLedger ms ps (filter (any (matchpats apats . paccount) . ltpostings) ts) tls hs f fp -- | Give all a ledger's amounts their canonical display settings. That -- is, in each commodity, amounts will use the display settings of the @@ -125,7 +126,7 @@ filterRawLedgerTransactionsByAccount apats (RawLedger ms ps ts tls hs f) = -- detected. 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) = RawLedger ms ps (map fixledgertransaction ts) tls hs f +canonicaliseAmounts costbasis l@(RawLedger ms ps ts tls hs f fp) = RawLedger ms ps (map fixledgertransaction ts) tls hs f fp where fixledgertransaction (LedgerTransaction d s c de co ts pr) = LedgerTransaction d s c de co (map fixrawposting ts) pr fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 6b60bb504..bea7695eb 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -102,7 +102,8 @@ data RawLedger = RawLedger { ledger_txns :: [LedgerTransaction], open_timelog_entries :: [TimeLogEntry], historical_prices :: [HistoricalPrice], - final_comment_lines :: String + final_comment_lines :: String, + filepath :: FilePath } deriving (Eq) data TimeLogEntry = TimeLogEntry { diff --git a/Utils.hs b/Utils.hs index d53a1863b..2c3d9cc61 100644 --- a/Utils.hs +++ b/Utils.hs @@ -25,7 +25,7 @@ withLedgerDo opts args cmd = do -- kludgily try not to fail if it's stdin. XXX rawtext <- readFile $ if f == "-" then "/dev/null" else f t <- getCurrentLocalTime - let runcmd = cmd opts args . filterAndCacheLedgerWithOpts opts args t rawtext + let runcmd = cmd opts args . filterAndCacheLedgerWithOpts opts args t rawtext . (\rl -> rl{filepath=f}) return f >>= runErrorT . parseLedgerFile t >>= either (hPutStrLn stderr) runcmd