a ledger remembers when it was read from disk

Ledger/IO.hs

@@ -14,6 +14,7 @@ import System.Directory (getHomeDirectory)
 import System.Environment (getEnv)
 import System.IO
 import System.FilePath ((</>))
+import System.Time (getClockTime)
 
 
 ledgerenvvar           = "LEDGER"
@@ -64,8 +65,9 @@ readLedger = readLedgerWithFilterSpec nullfilterspec
 readLedgerWithFilterSpec :: FilterSpec -> FilePath -> IO Ledger
 readLedgerWithFilterSpec fspec f = do
   s <- readFile f
+  t <- getClockTime
   rl <- rawLedgerFromString s
-  return $ filterAndCacheLedger fspec s rl
+  return $ filterAndCacheLedger fspec s rl{filepath=f, filereadtime=t}
 
 -- | Read a RawLedger from the given string, using the current time as
 -- reference time, or give a parse error.

Ledger/RawLedger.hs

@@ -9,6 +9,7 @@ module Ledger.RawLedger
 where
 import qualified Data.Map as Map
 import Data.Map ((!))
+import System.Time (ClockTime(TOD))
 import Ledger.Utils
 import Ledger.Types
 import Ledger.AccountName
@@ -37,6 +38,7 @@ rawLedgerEmpty = RawLedger { modifier_txns = []
                            , historical_prices = []
                            , final_comment_lines = []
                            , filepath = ""
+                           , filereadtime = TOD 0 0
                            }
 
 addLedgerTransaction :: LedgerTransaction -> RawLedger -> RawLedger
@@ -79,16 +81,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 fp) =
-    RawLedger ms ps (filter matchdesc ts) tls hs f fp
+filterRawLedgerTransactionsByDescription pats (RawLedger ms ps ts tls hs f fp ft) =
+    RawLedger ms ps (filter matchdesc ts) tls hs f fp ft
     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 fp) =
-    RawLedger ms ps (filter matchdate ts) tls hs f fp
+filterRawLedgerTransactionsByDate (DateSpan begin end) (RawLedger ms ps ts tls hs f fp ft) =
+    RawLedger ms ps (filter matchdate ts) tls hs f fp ft
     where
       matchdate t = maybe True (ltdate t>=) begin && maybe True (ltdate t<) end
 
@@ -96,29 +98,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 fp) =
-    RawLedger ms ps (filter ((==val).ltstatus) ts) tls hs f fp
+filterRawLedgerTransactionsByClearedStatus (Just val) (RawLedger ms ps ts tls hs f fp ft) =
+    RawLedger ms ps (filter ((==val).ltstatus) ts) tls hs f fp ft
 
 -- | 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 fp) =
-    RawLedger mts pts (map filtertxns ts) tls hs f fp
+filterRawLedgerPostingsByRealness True (RawLedger mts pts ts tls hs f fp ft) =
+    RawLedger mts pts (map filtertxns ts) tls hs f fp ft
     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 fp) =
-    RawLedger mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f fp
+filterRawLedgerPostingsByDepth depth (RawLedger mts pts ts tls hs f fp ft) =
+    RawLedger mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f fp ft
     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 fp) =
-    RawLedger ms ps (filter (any (matchpats apats . paccount) . ltpostings) ts) tls hs f fp
+filterRawLedgerTransactionsByAccount apats (RawLedger ms ps ts tls hs f fp ft) =
+    RawLedger ms ps (filter (any (matchpats apats . paccount) . ltpostings) ts) tls hs f fp ft
 
 -- | Convert this ledger's transactions' primary date to either their
 -- actual or effective date.
@@ -133,7 +135,7 @@ rawLedgerSelectingDate EffectiveDate rl =
 -- 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 fp) = RawLedger ms ps (map fixledgertransaction ts) tls hs f fp
+canonicaliseAmounts costbasis l@(RawLedger ms ps ts tls hs f fp ft) = RawLedger ms ps (map fixledgertransaction ts) tls hs f fp ft
     where
       fixledgertransaction (LedgerTransaction d ed s c de co ts pr) = LedgerTransaction d ed 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

@@ -26,6 +26,7 @@ module Ledger.Types
 where
 import Ledger.Utils
 import qualified Data.Map as Map
+import System.Time (ClockTime)
 
 
 type SmartDate = (String,String,String)
@@ -112,7 +113,8 @@ data RawLedger = RawLedger {
       open_timelog_entries :: [TimeLogEntry],
       historical_prices :: [HistoricalPrice],
       final_comment_lines :: String,
-      filepath :: FilePath
+      filepath :: FilePath,
+      filereadtime :: ClockTime
     } deriving (Eq)
 
 -- | A generic, pure specification of how to filter raw ledger transactions.

Tests.hs

@@ -203,6 +203,7 @@ import Locale (defaultTimeLocale)
 import Text.ParserCombinators.Parsec
 import Test.HUnit.Tools (runVerboseTests)
 import System.Exit (exitFailure, exitWith, ExitCode(ExitSuccess)) -- base 3 compatible
+import System.Time (ClockTime(TOD))
 
 import Commands.All
 import Ledger
@@ -1369,6 +1370,7 @@ rawledger7 = RawLedger
           []
           ""
           ""
+          (TOD 0 0)
 
 ledger7 = cacheLedger [] rawledger7 
 
@@ -1402,5 +1404,6 @@ rawLedgerWithAmounts as =
         []
         ""
         ""
+        (TOD 0 0)
     where parse = fromparse . parseWithCtx emptyCtx postingamount . (" "++)
 

Utils.hs

@@ -15,6 +15,7 @@ import System.IO
 import System.Exit
 import System.Cmd (system)
 import System.Info (os)
+import System.Time (getClockTime)
 
 
 -- | Parse the user's specified ledger file and run a hledger command on
@@ -30,7 +31,8 @@ withLedgerDo opts args cmdname cmd = do
   let creating = not fileexists && cmdname == "add"
   rawtext <-  if creating then return "" else strictReadFile f'
   t <- getCurrentLocalTime
-  let go = cmd opts args . filterAndCacheLedgerWithOpts opts args t rawtext . (\rl -> rl{filepath=f})
+  tc <- getClockTime
+  let go = cmd opts args . filterAndCacheLedgerWithOpts opts args t rawtext . (\rl -> rl{filepath=f,filereadtime=tc})
   case creating of
     True -> return rawLedgerEmpty >>= go
     False -> return f >>= runErrorT . parseLedgerFile t >>= either (hPutStrLn stderr) go

hledger.cabal

@@ -61,6 +61,7 @@ library
                  ,directory
                  ,filepath
                  ,haskell98
+                 ,old-time
                  ,parsec
                  ,time
                  ,utf8-string >= 0.3 && < 0.4
@@ -106,6 +107,7 @@ executable hledger
                  ,filepath
                  ,haskell98
                  ,mtl
+                 ,old-time
                  ,parsec
                  ,process
                  ,regexpr >= 0.5.1