add file path field to RawLedger

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

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 {

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