add file path field to RawLedger
This commit is contained in:
parent
b60f9187c0
commit
1548e84aa9
@ -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
|
||||||
|
|||||||
@ -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 {
|
||||||
|
|||||||
2
Utils.hs
2
Utils.hs
@ -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
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user