diff --git a/Ledger/IO.hs b/Ledger/IO.hs index 6e314ae09..fe82a7a9a 100644 --- a/Ledger/IO.hs +++ b/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" @@ -63,9 +64,10 @@ readLedger = readLedgerWithFilterSpec nullfilterspec -- | or give an error. readLedgerWithFilterSpec :: FilterSpec -> FilePath -> IO Ledger readLedgerWithFilterSpec fspec f = do - s <- readFile f + 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. diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index e458346e4..d90761693 100644 --- a/Ledger/RawLedger.hs +++ b/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 diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 08459d2a7..947dc0909 100644 --- a/Ledger/Types.hs +++ b/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. diff --git a/Tests.hs b/Tests.hs index f69f985d6..91d7af93f 100644 --- a/Tests.hs +++ b/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 . (" "++) diff --git a/Utils.hs b/Utils.hs index 2b8ea1d30..900127ef7 100644 --- a/Utils.hs +++ b/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 diff --git a/hledger.cabal b/hledger.cabal index f829e002b..b26eddcb9 100644 --- a/hledger.cabal +++ b/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