From 50200e38edac334b28f10728618b1ebe054e669d Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 21 Dec 2009 05:43:10 +0000 Subject: [PATCH] more cleanup, move journal text into Journal --- Commands/Add.hs | 4 ++-- Commands/Web.hs | 2 +- Ledger/IO.hs | 13 +------------ Ledger/Journal.hs | 30 +++++++++++++----------------- Ledger/Ledger.hs | 1 - Ledger/Types.hs | 4 ++-- Tests.hs | 2 ++ Utils.hs | 4 ++-- 8 files changed, 23 insertions(+), 37 deletions(-) diff --git a/Commands/Add.hs b/Commands/Add.hs index 09ad92e4b..e7d8cf260 100644 --- a/Commands/Add.hs +++ b/Commands/Add.hs @@ -145,9 +145,9 @@ appendToLedgerFile l s = else appendFile f $ sep++s where f = filepath $ journal l - -- we keep looking at the original raw text from when the ledger + -- XXX we are looking at the original raw text from when the ledger -- was first read, but that's good enough for now - t = journaltext l + t = jtext $ journal l sep | null $ strip t = "" | otherwise = replicate (2 - min 2 (length lastnls)) '\n' where lastnls = takeWhile (=='\n') $ reverse t diff --git a/Commands/Web.hs b/Commands/Web.hs index 97926d52a..be9759fb9 100644 --- a/Commands/Web.hs +++ b/Commands/Web.hs @@ -110,7 +110,7 @@ reloadIfChanged opts _ l = do else return l -- refilter :: [Opt] -> [String] -> Ledger -> LocalTime -> IO Ledger --- refilter opts args l t = return $ filterAndCacheLedgerWithOpts opts args t (journaltext l) (journal l) +-- refilter opts args l t = return $ filterAndCacheLedgerWithOpts opts args t (jtext $ journal l) (journal l) server :: [Opt] -> [String] -> Ledger -> IO () server opts args l = diff --git a/Ledger/IO.hs b/Ledger/IO.hs index d3167c416..277228a90 100644 --- a/Ledger/IO.hs +++ b/Ledger/IO.hs @@ -64,7 +64,7 @@ readLedger f = do t <- getClockTime s <- readFile f j <- journalFromString s - return $ cacheLedger' $ nullledger{journaltext=s,journal=j{filepath=f,filereadtime=t}} + return $ cacheLedger' $ nullledger{journal=j{filepath=f,filereadtime=t,jtext=s}} -- -- | Read a ledger from this file, filtering according to the filter spec., -- -- | or give an error. @@ -82,17 +82,6 @@ journalFromString s = do t <- getCurrentLocalTime liftM (either error id) $ runErrorT $ parseLedger t "(string)" s --- -- | Convert a Journal to a canonicalised, cached and filtered Ledger. --- filterAndCacheLedger :: FilterSpec -> String -> Journal -> Ledger --- filterAndCacheLedger _ -- filterspec --- rawtext --- j = --- (cacheLedger $ --- -- journalSelectingDate whichdate $ --- j --- -- filterJournalPostings filterspec $ filterJournalTransactions filterspec j --- ){journaltext=rawtext} - -- -- | Expand ~ in a file path (does not handle ~name). -- tildeExpand :: FilePath -> IO FilePath -- tildeExpand ('~':[]) = getHomeDirectory diff --git a/Ledger/Journal.hs b/Ledger/Journal.hs index 81f64bf9a..cc9129630 100644 --- a/Ledger/Journal.hs +++ b/Ledger/Journal.hs @@ -39,6 +39,7 @@ nulljournal = Journal { jmodifiertxns = [] , final_comment_lines = [] , filepath = "" , filereadtime = TOD 0 0 + , jtext = "" } addTransaction :: Transaction -> Journal -> Journal @@ -116,25 +117,22 @@ filterJournalPostings FilterSpec{datespan=datespan -- | Keep only ledger transactions whose description matches the description patterns. filterJournalTransactionsByDescription :: [String] -> Journal -> Journal -filterJournalTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) = - Journal ms ps (filter matchdesc ts) tls hs f fp ft +filterJournalTransactionsByDescription pats j@Journal{jtxns=ts} = j{jtxns=filter matchdesc ts} where matchdesc = matchpats pats . tdescription -- | 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. filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal -filterJournalTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) = - Journal ms ps (filter matchdate ts) tls hs f fp ft - where - matchdate t = maybe True (tdate t>=) begin && maybe True (tdate t<) end +filterJournalTransactionsByDate (DateSpan begin end) j@Journal{jtxns=ts} = j{jtxns=filter match ts} + where match t = maybe True (tdate t>=) begin && maybe True (tdate t<) end -- | Keep only ledger transactions which have the requested -- cleared/uncleared status, if there is one. filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal filterJournalTransactionsByClearedStatus Nothing j = j -filterJournalTransactionsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) = - Journal ms ps (filter ((==val).tstatus) ts) tls hs f fp ft +filterJournalTransactionsByClearedStatus (Just val) j@Journal{jtxns=ts} = j{jtxns=filter match ts} + where match = (==val).tstatus -- | Keep only postings which have the requested cleared/uncleared status, -- if there is one. @@ -147,15 +145,13 @@ filterJournalPostingsByClearedStatus (Just c) j@Journal{jtxns=ts} = j{jtxns=map -- no filtering. filterJournalPostingsByRealness :: Bool -> Journal -> Journal filterJournalPostingsByRealness False l = l -filterJournalPostingsByRealness True (Journal mts pts ts tls hs f fp ft) = - Journal mts pts (map filterpostings ts) tls hs f fp ft +filterJournalPostingsByRealness True j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps} -- | Strip out any postings with zero amount, unless the flag is true. filterJournalPostingsByEmpty :: Bool -> Journal -> Journal filterJournalPostingsByEmpty True l = l -filterJournalPostingsByEmpty False (Journal mts pts ts tls hs f fp ft) = - Journal mts pts (map filterpostings ts) tls hs f fp ft +filterJournalPostingsByEmpty False j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (not . isEmptyPosting) ps} -- | Keep only transactions which affect accounts deeper than the specified depth. @@ -168,15 +164,15 @@ filterJournalTransactionsByDepth (Just d) j@Journal{jtxns=ts} = -- (and any ledger transactions which have no postings as a result). filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal filterJournalPostingsByDepth Nothing j = j -filterJournalPostingsByDepth (Just d) (Journal mts pts ts tls hs f fp ft) = - Journal mts pts (filter (not . null . tpostings) $ map filtertxns ts) tls hs f fp ft +filterJournalPostingsByDepth (Just d) j@Journal{jtxns=ts} = + j{jtxns=filter (not . null . tpostings) $ map filtertxns ts} where filtertxns t@Transaction{tpostings=ps} = t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps} -- | Keep only transactions which affect accounts matched by the account patterns. filterJournalTransactionsByAccount :: [String] -> Journal -> Journal -filterJournalTransactionsByAccount apats (Journal ms ps ts tls hs f fp ft) = - Journal ms ps (filter (any (matchpats apats . paccount) . tpostings) ts) tls hs f fp ft +filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter match ts} + where match = any (matchpats apats . paccount) . tpostings -- | Keep only postings which affect accounts matched by the account patterns. -- This can leave transactions unbalanced. @@ -198,7 +194,7 @@ journalSelectingDate EffectiveDate j = -- Also, amounts are converted to cost basis if that flag is active. -- XXX refactor canonicaliseAmounts :: Bool -> Journal -> Journal -canonicaliseAmounts costbasis j@(Journal ms ps ts tls hs f fp ft) = Journal ms ps (map fixledgertransaction ts) tls hs f fp ft +canonicaliseAmounts costbasis j@Journal{jtxns=ts} = j{jtxns=map fixledgertransaction ts} where fixledgertransaction (Transaction d ed s c de co ts pr) = Transaction d ed s c de co (map fixrawposting ts) pr where diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index 7890df474..f5abd06ec 100644 --- a/Ledger/Ledger.hs +++ b/Ledger/Ledger.hs @@ -73,7 +73,6 @@ instance Show Ledger where nullledger :: Ledger nullledger = Ledger{ - journaltext = "", journal = nulljournal, accountnametree = nullaccountnametree, accountmap = fromList [] diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 7633f379a..8736940c2 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -121,7 +121,8 @@ data Journal = Journal { historical_prices :: [HistoricalPrice], final_comment_lines :: String, filepath :: FilePath, - filereadtime :: ClockTime + filereadtime :: ClockTime, + jtext :: String } deriving (Eq) data Account = Account { @@ -131,7 +132,6 @@ data Account = Account { } data Ledger = Ledger { - journaltext :: String, journal :: Journal, accountnametree :: Tree AccountName, accountmap :: Map.Map AccountName Account diff --git a/Tests.hs b/Tests.hs index 2b9aa1440..50b1beb9d 100644 --- a/Tests.hs +++ b/Tests.hs @@ -1240,6 +1240,7 @@ journal7 = Journal "" "" (TOD 0 0) + "" ledger7 = cacheLedger journal7 @@ -1274,5 +1275,6 @@ journalWithAmounts as = "" "" (TOD 0 0) + "" where parse = fromparse . parseWithCtx emptyCtx postingamount . (" "++) diff --git a/Utils.hs b/Utils.hs index 505092989..25cafe1e9 100644 --- a/Utils.hs +++ b/Utils.hs @@ -42,8 +42,8 @@ withLedgerDo opts args cmdname cmd = do where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1) mkLedger :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> Ledger -mkLedger opts f tc txt j = nullledger{journaltext=txt,journal=j'} - where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc} +mkLedger opts f tc txt j = nullledger{journal=j'} + where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc,jtext=txt} costbasis=CostBasis `elem` opts -- | Get a Ledger from the given string and options, or raise an error.