From 2feace32dde7596f7480e26e9bc5cb7c8ba8a378 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 29 Oct 2015 20:12:46 -0700 Subject: [PATCH] lib: number transactions as they are read And allow looking up transactions by their read order (index), or the previous/next transactions in the sequence. --- hledger-lib/Hledger/Data/Journal.hs | 24 +++++++++++- hledger-lib/Hledger/Data/TimeLog.hs | 1 + hledger-lib/Hledger/Data/Transaction.hs | 39 ++++++++++---------- hledger-lib/Hledger/Data/Types.hs | 2 + hledger-lib/Hledger/Read/JournalReader.hs | 10 ++++- hledger-lib/Hledger/Reports/BalanceReport.hs | 1 + hledger/Hledger/Cli.hs | 6 +++ 7 files changed, 62 insertions(+), 21 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 0a24bdf5d..0a120c81c 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -35,6 +35,9 @@ module Hledger.Data.Journal ( journalDescriptions, journalFilePath, journalFilePaths, + journalTransactionAt, + journalNextTransaction, + journalPrevTransaction, journalPostings, -- * Standard account types journalBalanceSheetAccountQuery, @@ -134,7 +137,7 @@ nulljournal = Journal { jmodifiertxns = [] } nullctx :: JournalContext -nullctx = Ctx { ctxYear = Nothing, ctxDefaultCommodityAndStyle = Nothing, ctxAccount = [], ctxAliases = [] } +nullctx = Ctx{ctxYear=Nothing, ctxDefaultCommodityAndStyle=Nothing, ctxAccount=[], ctxAliases=[], ctxTransactionIndex=0} journalFilePath :: Journal -> FilePath journalFilePath = fst . mainfile @@ -160,6 +163,20 @@ addMarketPrice h j = j { jmarketprices = h : jmarketprices j } addTimeLogEntry :: TimeLogEntry -> Journal -> Journal addTimeLogEntry tle j = j { open_timelog_entries = tle : open_timelog_entries j } +-- | Get the transaction with this index (its 1-based position in the input stream), if any. +journalTransactionAt :: Journal -> Integer -> Maybe Transaction +journalTransactionAt Journal{jtxns=ts} i = + -- it's probably ts !! (i+1), but we won't assume + headMay [t | t <- ts, tindex t == i] + +-- | Get the transaction that appeared immediately after this one in the input stream, if any. +journalNextTransaction :: Journal -> Transaction -> Maybe Transaction +journalNextTransaction j t = journalTransactionAt j (tindex t + 1) + +-- | Get the transaction that appeared immediately before this one in the input stream, if any. +journalPrevTransaction :: Journal -> Transaction -> Maybe Transaction +journalPrevTransaction j t = journalTransactionAt j (tindex t - 1) + -- | Unique transaction descriptions used in this journal. journalDescriptions :: Journal -> [String] journalDescriptions = nub . sort . map tdescription . jtxns @@ -683,6 +700,7 @@ Right samplejournal = journalBalanceTransactions $ nulljournal {jtxns = [ txnTieKnot $ Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2008/01/01", tdate2=Nothing, @@ -699,6 +717,7 @@ Right samplejournal = journalBalanceTransactions $ } , txnTieKnot $ Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2008/06/01", tdate2=Nothing, @@ -715,6 +734,7 @@ Right samplejournal = journalBalanceTransactions $ } , txnTieKnot $ Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2008/06/02", tdate2=Nothing, @@ -731,6 +751,7 @@ Right samplejournal = journalBalanceTransactions $ } , txnTieKnot $ Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2008/06/03", tdate2=Nothing, @@ -747,6 +768,7 @@ Right samplejournal = journalBalanceTransactions $ } , txnTieKnot $ Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2008/12/31", tdate2=Nothing, diff --git a/hledger-lib/Hledger/Data/TimeLog.hs b/hledger-lib/Hledger/Data/TimeLog.hs index 1e41c16c0..75cd95dce 100644 --- a/hledger-lib/Hledger/Data/TimeLog.hs +++ b/hledger-lib/Hledger/Data/TimeLog.hs @@ -79,6 +79,7 @@ entryFromTimeLogInOut i o error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t where t = Transaction { + tindex = 0, tsourcepos = tlsourcepos i, tdate = idate, tdate2 = Nothing, diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index b3de52312..63f84a4f6 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -61,6 +61,7 @@ nullsourcepos = GenericSourcePos "" 1 1 nulltransaction :: Transaction nulltransaction = Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=nulldate, tdate2=Nothing, @@ -419,7 +420,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ," assets:checking" ,"" ]) - (let t = Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" [] + (let t = Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" [] [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18], ptransaction=Just t} ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.18)], ptransaction=Just t} ] "" @@ -433,7 +434,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ," assets:checking $-47.18" ,"" ]) - (let t = Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" [] + (let t = Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" [] [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18], ptransaction=Just t} ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.18)], ptransaction=Just t} ] "" @@ -449,7 +450,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ,"" ]) (showTransaction - (txnTieKnot $ Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" [] + (txnTieKnot $ Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" [] [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]} ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.19)]} ] "")) @@ -462,7 +463,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ,"" ]) (showTransaction - (txnTieKnot $ Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" [] + (txnTieKnot $ Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" [] [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]} ] "")) @@ -474,7 +475,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ,"" ]) (showTransaction - (txnTieKnot $ Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" [] + (txnTieKnot $ Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" [] [posting{paccount="expenses:food:groceries", pamount=missingmixedamt} ] "")) @@ -487,7 +488,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ,"" ]) (showTransaction - (txnTieKnot $ Transaction nullsourcepos (parsedate "2010/01/01") Nothing Uncleared "" "x" "" [] + (txnTieKnot $ Transaction 0 nullsourcepos (parsedate "2010/01/01") Nothing Uncleared "" "x" "" [] [posting{paccount="a", pamount=Mixed [num 1 `at` (usd 2 `withPrecision` 0)]} ,posting{paccount="b", pamount= missingmixedamt} ] "")) @@ -495,19 +496,19 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ,"balanceTransaction" ~: do assertBool "detect unbalanced entry, sign error" (isLeft $ balanceTransaction Nothing - (Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "test" "" [] + (Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "test" "" [] [posting{paccount="a", pamount=Mixed [usd 1]} ,posting{paccount="b", pamount=Mixed [usd 1]} ] "")) assertBool "detect unbalanced entry, multiple missing amounts" (isLeft $ balanceTransaction Nothing - (Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "test" "" [] + (Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "test" "" [] [posting{paccount="a", pamount=missingmixedamt} ,posting{paccount="b", pamount=missingmixedamt} ] "")) - let e = balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "" "" [] + let e = balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "" "" [] [posting{paccount="a", pamount=Mixed [usd 1]} ,posting{paccount="b", pamount=missingmixedamt} ] "") @@ -518,7 +519,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ Right e' -> (pamount $ last $ tpostings e') Left _ -> error' "should not happen") - let e = balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2011/01/01") Nothing Uncleared "" "" "" [] + let e = balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "2011/01/01") Nothing Uncleared "" "" "" [] [posting{paccount="a", pamount=Mixed [usd 1.35]} ,posting{paccount="b", pamount=Mixed [eur (-1)]} ] "") @@ -530,49 +531,49 @@ tests_Hledger_Data_Transaction = TestList $ concat [ Left _ -> error' "should not happen") assertBool "balanceTransaction balances based on cost if there are unit prices" (isRight $ - balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2011/01/01") Nothing Uncleared "" "" "" [] + balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "2011/01/01") Nothing Uncleared "" "" "" [] [posting{paccount="a", pamount=Mixed [usd 1 `at` eur 2]} ,posting{paccount="a", pamount=Mixed [usd (-2) `at` eur 1]} ] "")) assertBool "balanceTransaction balances based on cost if there are total prices" (isRight $ - balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2011/01/01") Nothing Uncleared "" "" "" [] + balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "2011/01/01") Nothing Uncleared "" "" "" [] [posting{paccount="a", pamount=Mixed [usd 1 @@ eur 1]} ,posting{paccount="a", pamount=Mixed [usd (-2) @@ eur 1]} ] "")) ,"isTransactionBalanced" ~: do - let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] + let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t} ,posting{paccount="c", pamount=Mixed [usd (-1.00)], ptransaction=Just t} ] "" assertBool "detect balanced" (isTransactionBalanced Nothing t) - let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] + let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t} ,posting{paccount="c", pamount=Mixed [usd (-1.01)], ptransaction=Just t} ] "" assertBool "detect unbalanced" (not $ isTransactionBalanced Nothing t) - let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] + let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t} ] "" assertBool "detect unbalanced, one posting" (not $ isTransactionBalanced Nothing t) - let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] + let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] [posting{paccount="b", pamount=Mixed [usd 0], ptransaction=Just t} ] "" assertBool "one zero posting is considered balanced for now" (isTransactionBalanced Nothing t) - let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] + let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t} ,posting{paccount="c", pamount=Mixed [usd (-1.00)], ptransaction=Just t} ,posting{paccount="d", pamount=Mixed [usd 100], ptype=VirtualPosting, ptransaction=Just t} ] "" assertBool "virtual postings don't need to balance" (isTransactionBalanced Nothing t) - let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] + let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t} ,posting{paccount="c", pamount=Mixed [usd (-1.00)], ptransaction=Just t} ,posting{paccount="d", pamount=Mixed [usd 100], ptype=BalancedVirtualPosting, ptransaction=Just t} ] "" assertBool "balanced virtual postings need to balance among themselves" (not $ isTransactionBalanced Nothing t) - let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] + let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" [] [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t} ,posting{paccount="c", pamount=Mixed [usd (-1.00)], ptransaction=Just t} ,posting{paccount="d", pamount=Mixed [usd 100], ptype=BalancedVirtualPosting, ptransaction=Just t} diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 0da51a82c..1a058cda5 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -170,6 +170,7 @@ data GenericSourcePos = GenericSourcePos FilePath Int Int instance NFData GenericSourcePos data Transaction = Transaction { + tindex :: Integer, -- ^ this transaction's 1-based position in the input stream, or 0 when not available tsourcepos :: GenericSourcePos, tdate :: Day, tdate2 :: Maybe Day, @@ -233,6 +234,7 @@ data JournalContext = Ctx { -- specified with "account" directive(s). Concatenated, these -- are the account prefix prepended to parsed account names. , ctxAliases :: ![AccountAlias] -- ^ the current list of account name aliases in effect + , ctxTransactionIndex :: !Integer -- ^ the number of transactions read so far } deriving (Read, Show, Eq, Data, Typeable, Generic) instance NFData JournalContext diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 581ac2d7e..f6190be06 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -212,6 +212,12 @@ getAccountAliases = liftM ctxAliases getState clearAccountAliases :: Stream [Char] m Char => ParsecT [Char] JournalContext m () clearAccountAliases = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]}) +getIndex :: Stream [Char] m Char => ParsecT s JournalContext m Integer +getIndex = liftM ctxTransactionIndex getState + +setIndex :: Stream [Char] m Char => Integer -> ParsecT [Char] JournalContext m () +setIndex i = modifyState (\ctx -> ctx{ctxTransactionIndex=i}) + -- parsers -- | Top-level journal parser. Returns a single composite, I/O performing, @@ -437,7 +443,9 @@ transactionp = do comment <- try followingcommentp <|> (newline >> return "") let tags = tagsInComment comment postings <- postingsp - return $ txnTieKnot $ Transaction sourcepos date edate status code description comment tags postings "" + index <- getIndex + setIndex (index+1) + return $ txnTieKnot $ Transaction index sourcepos date edate status code description comment tags postings "" descriptionp = many (noneOf ";\n") diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 126f22973..79661717e 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -368,6 +368,7 @@ Right samplejournal2 = journalBalanceTransactions $ nulljournal {jtxns = [ txnTieKnot $ Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2008/01/01", tdate2=Just $ parsedate "2009/01/01", diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 3abaeee06..c8714ea0e 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -343,6 +343,7 @@ journal7 :: Journal journal7 = nulljournal {jtxns = [ txnTieKnot Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2007/01/01", tdate2=Nothing, @@ -359,6 +360,7 @@ journal7 = nulljournal {jtxns = } , txnTieKnot Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2007/02/01", tdate2=Nothing, @@ -375,6 +377,7 @@ journal7 = nulljournal {jtxns = } , txnTieKnot Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2007/01/02", tdate2=Nothing, @@ -391,6 +394,7 @@ journal7 = nulljournal {jtxns = } , txnTieKnot Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2007/01/03", tdate2=Nothing, @@ -407,6 +411,7 @@ journal7 = nulljournal {jtxns = } , txnTieKnot Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2007/01/03", tdate2=Nothing, @@ -423,6 +428,7 @@ journal7 = nulljournal {jtxns = } , txnTieKnot Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2007/01/03", tdate2=Nothing,