add file path field to RawLedger

This commit is contained in:
Simon Michael 2009-04-08 03:40:05 +00:00
parent b60f9187c0
commit 1548e84aa9
3 changed files with 17 additions and 15 deletions

View File

@ -36,6 +36,7 @@ rawLedgerEmpty = RawLedger { modifier_txns = []
, open_timelog_entries = [] , open_timelog_entries = []
, historical_prices = [] , historical_prices = []
, final_comment_lines = [] , final_comment_lines = []
, filepath = ""
} }
addLedgerTransaction :: LedgerTransaction -> RawLedger -> RawLedger addLedgerTransaction :: LedgerTransaction -> RawLedger -> RawLedger
@ -78,16 +79,16 @@ filterRawLedger span pats clearedonly realonly =
-- | Keep only ledger transactions whose description matches the description patterns. -- | Keep only ledger transactions whose description matches the description patterns.
filterRawLedgerTransactionsByDescription :: [String] -> RawLedger -> RawLedger filterRawLedgerTransactionsByDescription :: [String] -> RawLedger -> RawLedger
filterRawLedgerTransactionsByDescription pats (RawLedger ms ps ts tls hs f) = filterRawLedgerTransactionsByDescription pats (RawLedger ms ps ts tls hs f fp) =
RawLedger ms ps (filter matchdesc ts) tls hs f RawLedger ms ps (filter matchdesc ts) tls hs f fp
where matchdesc = matchpats pats . ltdescription where matchdesc = matchpats pats . ltdescription
-- | Keep only ledger transactions which fall between begin and end dates. -- | Keep only ledger transactions which fall between begin and end dates.
-- We include transactions on the begin date and exclude transactions on the end -- We include transactions on the begin date and exclude transactions on the end
-- date, like ledger. An empty date string means no restriction. -- date, like ledger. An empty date string means no restriction.
filterRawLedgerTransactionsByDate :: DateSpan -> RawLedger -> RawLedger filterRawLedgerTransactionsByDate :: DateSpan -> RawLedger -> RawLedger
filterRawLedgerTransactionsByDate (DateSpan begin end) (RawLedger ms ps 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 RawLedger ms ps (filter matchdate ts) tls hs f fp
where where
matchdate t = (maybe True (ltdate t>=) begin) && (maybe True (ltdate t<) end) 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. -- cleared/uncleared status, if there is one.
filterRawLedgerTransactionsByClearedStatus :: Maybe Bool -> RawLedger -> RawLedger filterRawLedgerTransactionsByClearedStatus :: Maybe Bool -> RawLedger -> RawLedger
filterRawLedgerTransactionsByClearedStatus Nothing rl = rl filterRawLedgerTransactionsByClearedStatus Nothing rl = rl
filterRawLedgerTransactionsByClearedStatus (Just val) (RawLedger ms ps 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 RawLedger ms ps (filter ((==val).ltstatus) ts) tls hs f fp
-- | Strip out any virtual postings, if the flag is true, otherwise do -- | Strip out any virtual postings, if the flag is true, otherwise do
-- no filtering. -- no filtering.
filterRawLedgerPostingsByRealness :: Bool -> RawLedger -> RawLedger filterRawLedgerPostingsByRealness :: Bool -> RawLedger -> RawLedger
filterRawLedgerPostingsByRealness False l = l filterRawLedgerPostingsByRealness False l = l
filterRawLedgerPostingsByRealness True (RawLedger mts pts ts tls hs f) = filterRawLedgerPostingsByRealness True (RawLedger mts pts ts tls hs f fp) =
RawLedger mts pts (map filtertxns ts) tls hs f RawLedger mts pts (map filtertxns ts) tls hs f fp
where filtertxns t@LedgerTransaction{ltpostings=ps} = t{ltpostings=filter isReal ps} where filtertxns t@LedgerTransaction{ltpostings=ps} = t{ltpostings=filter isReal ps}
-- | Strip out any postings to accounts deeper than the specified depth -- | Strip out any postings to accounts deeper than the specified depth
-- (and any ledger transactions which have no postings as a result). -- (and any ledger transactions which have no postings as a result).
filterRawLedgerPostingsByDepth :: Int -> RawLedger -> RawLedger filterRawLedgerPostingsByDepth :: Int -> RawLedger -> RawLedger
filterRawLedgerPostingsByDepth depth (RawLedger mts pts 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 RawLedger mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f fp
where filtertxns t@LedgerTransaction{ltpostings=ps} = where filtertxns t@LedgerTransaction{ltpostings=ps} =
t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps} t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps}
-- | Keep only ledger transactions which affect accounts matched by the account patterns. -- | Keep only ledger transactions which affect accounts matched by the account patterns.
filterRawLedgerTransactionsByAccount :: [String] -> RawLedger -> RawLedger filterRawLedgerTransactionsByAccount :: [String] -> RawLedger -> RawLedger
filterRawLedgerTransactionsByAccount apats (RawLedger ms ps 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 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 -- | Give all a ledger's amounts their canonical display settings. That
-- is, in each commodity, amounts will use the display settings of the -- 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 -- detected. Also, amounts are converted to cost basis if that flag is
-- active. -- active.
canonicaliseAmounts :: Bool -> RawLedger -> RawLedger 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 where
fixledgertransaction (LedgerTransaction d s c de co ts pr) = LedgerTransaction d s c de co (map fixrawposting ts) pr 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 fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t

View File

@ -102,7 +102,8 @@ data RawLedger = RawLedger {
ledger_txns :: [LedgerTransaction], ledger_txns :: [LedgerTransaction],
open_timelog_entries :: [TimeLogEntry], open_timelog_entries :: [TimeLogEntry],
historical_prices :: [HistoricalPrice], historical_prices :: [HistoricalPrice],
final_comment_lines :: String final_comment_lines :: String,
filepath :: FilePath
} deriving (Eq) } deriving (Eq)
data TimeLogEntry = TimeLogEntry { data TimeLogEntry = TimeLogEntry {

View File

@ -25,7 +25,7 @@ withLedgerDo opts args cmd = do
-- kludgily try not to fail if it's stdin. XXX -- kludgily try not to fail if it's stdin. XXX
rawtext <- readFile $ if f == "-" then "/dev/null" else f rawtext <- readFile $ if f == "-" then "/dev/null" else f
t <- getCurrentLocalTime 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 return f >>= runErrorT . parseLedgerFile t >>= either (hPutStrLn stderr) runcmd