slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: number transactions as they are read

Browse Source 
And allow looking up transactions by their read order (index),
or the previous/next transactions in the sequence.
This commit is contained in:
Simon Michael 2015-10-29 20:12:46 -07:00
parent 4d97db02cb
commit 2feace32dd
7 changed files with 62 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
hledger-lib/Hledger/Data/Journal.hs
View File

@ -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,

1
hledger-lib/Hledger/Data/TimeLog.hs
View File

@ -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,

39
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -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}

2
hledger-lib/Hledger/Data/Types.hs
View File

@ -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

10
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -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")

1
hledger-lib/Hledger/Reports/BalanceReport.hs
View File

@ -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",

6
hledger/Hledger/Cli.hs
View File

@ -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,