diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 9d5c634dd..bcd904df3 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -658,6 +658,7 @@ Right samplejournal = journalBalanceTransactions $ nulljournal {jtxns = [ txnTieKnot $ Transaction { + tsourcepos=nullsourcepos, tdate=parsedate "2008/01/01", tdate2=Nothing, tstatus=False, @@ -673,6 +674,7 @@ Right samplejournal = journalBalanceTransactions $ } , txnTieKnot $ Transaction { + tsourcepos=nullsourcepos, tdate=parsedate "2008/06/01", tdate2=Nothing, tstatus=False, @@ -688,6 +690,7 @@ Right samplejournal = journalBalanceTransactions $ } , txnTieKnot $ Transaction { + tsourcepos=nullsourcepos, tdate=parsedate "2008/06/02", tdate2=Nothing, tstatus=False, @@ -703,6 +706,7 @@ Right samplejournal = journalBalanceTransactions $ } , txnTieKnot $ Transaction { + tsourcepos=nullsourcepos, tdate=parsedate "2008/06/03", tdate2=Nothing, tstatus=True, @@ -718,6 +722,7 @@ Right samplejournal = journalBalanceTransactions $ } , txnTieKnot $ Transaction { + tsourcepos=nullsourcepos, tdate=parsedate "2008/12/31", tdate2=Nothing, tstatus=False, diff --git a/hledger-lib/Hledger/Data/TimeLog.hs b/hledger-lib/Hledger/Data/TimeLog.hs index 1722b7c69..190954416 100644 --- a/hledger-lib/Hledger/Data/TimeLog.hs +++ b/hledger-lib/Hledger/Data/TimeLog.hs @@ -51,7 +51,7 @@ timeLogEntriesToTransactions now [i] | odate > idate = entryFromTimeLogInOut i o' : timeLogEntriesToTransactions now [i',o] | otherwise = [entryFromTimeLogInOut i o] where - o = TimeLogEntry Out end "" + o = TimeLogEntry (tlsourcepos i) Out end "" end = if itime > now then itime else now (itime,otime) = (tldatetime i,tldatetime o) (idate,odate) = (localDay itime,localDay otime) @@ -76,14 +76,15 @@ entryFromTimeLogInOut i o error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t where t = Transaction { - tdate = idate, - tdate2 = Nothing, - tstatus = True, - tcode = "", - tdescription = showtime itod ++ "-" ++ showtime otod, - tcomment = "", - ttags = [], - tpostings = ps, + tsourcepos = tlsourcepos i, + tdate = idate, + tdate2 = Nothing, + tstatus = True, + tcode = "", + tdescription = showtime itod ++ "-" ++ showtime otod, + tcomment = "", + ttags = [], + tpostings = ps, tpreceding_comment_lines="" } showtime = take 5 . show @@ -107,7 +108,7 @@ tests_Hledger_Data_TimeLog = TestList [ let now = utcToLocalTime tz now' nowstr = showtime now yesterday = prevday today - clockin = TimeLogEntry In + clockin = TimeLogEntry nullsourcepos In mktime d = LocalTime d . fromMaybe midnight . parseTime defaultTimeLocale "%H:%M:%S" showtime = formatTime defaultTimeLocale "%H:%M" assertEntriesGiveStrings name es ss = assertEqual name ss (map tdescription $ timeLogEntriesToTransactions now es) @@ -127,4 +128,4 @@ tests_Hledger_Data_TimeLog = TestList [ [clockin future ""] [printf "%s-%s" futurestr futurestr] - ] \ No newline at end of file + ] diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 360fb3c0f..60a7870ed 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -9,6 +9,7 @@ tags. module Hledger.Data.Transaction ( -- * Transaction + nullsourcepos, nulltransaction, txnTieKnot, -- settxn, @@ -39,6 +40,7 @@ import Data.Time.Calendar import Test.HUnit import Text.Printf import qualified Data.Map as Map +import Text.Parsec.Pos import Hledger.Utils import Hledger.Data.Types @@ -54,8 +56,12 @@ instance Show ModifierTransaction where instance Show PeriodicTransaction where show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t)) +nullsourcepos :: SourcePos +nullsourcepos = initialPos "" + nulltransaction :: Transaction nulltransaction = Transaction { + tsourcepos=nullsourcepos, tdate=nulldate, tdate2=Nothing, tstatus=False, @@ -376,7 +382,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ," assets:checking" ,"" ]) - (let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" [] + (let t = Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "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} ] "" @@ -390,7 +396,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ," assets:checking $-47.18" ,"" ]) - (let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" [] + (let t = Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "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} ] "" @@ -406,7 +412,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ,"" ]) (showTransaction - (txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" [] + (txnTieKnot $ Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "coopportunity" "" [] [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]} ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.19)]} ] "")) @@ -419,7 +425,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ,"" ]) (showTransaction - (txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" [] + (txnTieKnot $ Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "coopportunity" "" [] [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]} ] "")) @@ -431,7 +437,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ,"" ]) (showTransaction - (txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" [] + (txnTieKnot $ Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "coopportunity" "" [] [posting{paccount="expenses:food:groceries", pamount=missingmixedamt} ] "")) @@ -444,7 +450,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ,"" ]) (showTransaction - (txnTieKnot $ Transaction (parsedate "2010/01/01") Nothing False "" "x" "" [] + (txnTieKnot $ Transaction nullsourcepos (parsedate "2010/01/01") Nothing False "" "x" "" [] [posting{paccount="a", pamount=Mixed [num 1 `at` (usd 2 `withPrecision` 0)]} ,posting{paccount="b", pamount= missingmixedamt} ] "")) @@ -452,19 +458,19 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ,"balanceTransaction" ~: do assertBool "detect unbalanced entry, sign error" (isLeft $ balanceTransaction Nothing - (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" [] + (Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "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 (parsedate "2007/01/28") Nothing False "" "test" "" [] + (Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "test" "" [] [posting{paccount="a", pamount=missingmixedamt} ,posting{paccount="b", pamount=missingmixedamt} ] "")) - let e = balanceTransaction Nothing (Transaction (parsedate "2007/01/28") Nothing False "" "" "" [] + let e = balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "" "" [] [posting{paccount="a", pamount=Mixed [usd 1]} ,posting{paccount="b", pamount=missingmixedamt} ] "") @@ -475,7 +481,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ Right e' -> (pamount $ last $ tpostings e') Left _ -> error' "should not happen") - let e = balanceTransaction Nothing (Transaction (parsedate "2011/01/01") Nothing False "" "" "" [] + let e = balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2011/01/01") Nothing False "" "" "" [] [posting{paccount="a", pamount=Mixed [usd 1.35]} ,posting{paccount="b", pamount=Mixed [eur (-1)]} ] "") @@ -487,49 +493,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 (parsedate "2011/01/01") Nothing False "" "" "" [] + balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2011/01/01") Nothing False "" "" "" [] [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 (parsedate "2011/01/01") Nothing False "" "" "" [] + balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2011/01/01") Nothing False "" "" "" [] [posting{paccount="a", pamount=Mixed [usd 1 @@ eur 1]} ,posting{paccount="a", pamount=Mixed [usd (-2) @@ eur 1]} ] "")) ,"isTransactionBalanced" ~: do - let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] + let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "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 (parsedate "2009/01/01") Nothing False "" "a" "" [] + let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "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 (parsedate "2009/01/01") Nothing False "" "a" "" [] + let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "a" "" [] [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t} ] "" assertBool "detect unbalanced, one posting" (not $ isTransactionBalanced Nothing t) - let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] + let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "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 (parsedate "2009/01/01") Nothing False "" "a" "" [] + let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "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 (parsedate "2009/01/01") Nothing False "" "a" "" [] + let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "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 (parsedate "2009/01/01") Nothing False "" "a" "" [] + let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "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 d3f0f9cc7..6ef8e384f 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -25,6 +25,7 @@ import qualified Data.Map as M import Data.Time.Calendar import Data.Time.LocalTime import System.Time (ClockTime(..)) +import Text.Parsec.Pos type SmartDate = (String,String,String) @@ -103,6 +104,7 @@ instance Eq Posting where (==) (Posting a1 b1 c1 d1 e1 f1 g1 h1 i1 _) (Posting a2 b2 c2 d2 e2 f2 g2 h2 i2 _) = a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2 && g1==g2 && h1==h2 && i1==i2 data Transaction = Transaction { + tsourcepos :: SourcePos, tdate :: Day, tdate2 :: Maybe Day, tstatus :: Bool, -- XXX tcleared ? @@ -127,6 +129,7 @@ data PeriodicTransaction = PeriodicTransaction { data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Typeable,Data) data TimeLogEntry = TimeLogEntry { + tlsourcepos :: SourcePos, tlcode :: TimeLogCode, tldatetime :: LocalTime, tlcomment :: String diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index d11e8a044..e56de94fc 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -113,7 +113,9 @@ readJournalFromCsv mrulesfile csvfile csvdata = -- mfieldnames = lastMay headerlines -- convert to transactions and return as a journal - let txns = map (transactionFromCsvRecord rules) records + let txns = snd $ mapAccumL + (\pos r -> (pos, transactionFromCsvRecord (incSourceLine pos 1) rules r)) + (initialPos parsecfilename) records return $ Right nulljournal{jtxns=sortBy (comparing tdate) txns} parseCsv :: FilePath -> String -> IO (Either ParseError CSV) @@ -530,8 +532,8 @@ type CsvRecord = [String] -- Convert a CSV record to a transaction using the rules, or raise an -- error if the data can not be parsed. -transactionFromCsvRecord :: CsvRules -> CsvRecord -> Transaction -transactionFromCsvRecord rules record = t +transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction +transactionFromCsvRecord sourcepos rules record = t where mdirective = (`getDirective` rules) mfieldtemplate = getEffectiveAssignment rules record @@ -591,6 +593,7 @@ transactionFromCsvRecord rules record = t -- build the transaction t = nulltransaction{ + tsourcepos = sourcepos, tdate = date', tdate2 = mdate2', tstatus = status, diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 098fa0f5f..30f3dd007 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -324,6 +324,7 @@ periodictransaction = do transaction :: GenParser Char JournalContext Transaction transaction = do -- ptrace "transaction" + sourcepos <- getPosition date <- date "transaction" edate <- optionMaybe (secondarydate date) "secondary date" status <- status "cleared flag" @@ -332,7 +333,7 @@ transaction = do comment <- try followingcommentp <|> (newline >> return "") let tags = tagsInComment comment postings <- postings - return $ txnTieKnot $ Transaction date edate status code description comment tags postings "" + return $ txnTieKnot $ Transaction sourcepos date edate status code description comment tags postings "" descriptionp = many (noneOf ";\n") diff --git a/hledger-lib/Hledger/Read/TimelogReader.hs b/hledger-lib/Hledger/Read/TimelogReader.hs index 45e50f601..5dd223143 100644 --- a/hledger-lib/Hledger/Read/TimelogReader.hs +++ b/hledger-lib/Hledger/Read/TimelogReader.hs @@ -100,11 +100,12 @@ timelogFile = do items <- many timelogItem -- | Parse a timelog entry. timelogentry :: GenParser Char JournalContext TimeLogEntry timelogentry = do + sourcepos <- getPosition code <- oneOf "bhioO" many1 spacenonewline datetime <- datetimep comment <- optionMaybe (many1 spacenonewline >> liftM2 (++) getParentAccount restofline) - return $ TimeLogEntry (read [code]) datetime (maybe "" rstrip comment) + return $ TimeLogEntry sourcepos (read [code]) datetime (maybe "" rstrip comment) tests_Hledger_Read_TimelogReader = TestList [ ] diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 99a1137be..a20425129 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -321,6 +321,7 @@ Right samplejournal2 = journalBalanceTransactions $ nulljournal {jtxns = [ txnTieKnot $ Transaction { + tsourcepos=nullsourcepos, tdate=parsedate "2008/01/01", tdate2=Just $ parsedate "2009/01/01", tstatus=False, diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 6861f3f7c..68e938b99 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -342,6 +342,7 @@ journal7 :: Journal journal7 = nulljournal {jtxns = [ txnTieKnot Transaction { + tsourcepos=nullsourcepos, tdate=parsedate "2007/01/01", tdate2=Nothing, tstatus=False, @@ -357,6 +358,7 @@ journal7 = nulljournal {jtxns = } , txnTieKnot Transaction { + tsourcepos=nullsourcepos, tdate=parsedate "2007/02/01", tdate2=Nothing, tstatus=False, @@ -372,6 +374,7 @@ journal7 = nulljournal {jtxns = } , txnTieKnot Transaction { + tsourcepos=nullsourcepos, tdate=parsedate "2007/01/02", tdate2=Nothing, tstatus=False, @@ -387,6 +390,7 @@ journal7 = nulljournal {jtxns = } , txnTieKnot Transaction { + tsourcepos=nullsourcepos, tdate=parsedate "2007/01/03", tdate2=Nothing, tstatus=False, @@ -402,6 +406,7 @@ journal7 = nulljournal {jtxns = } , txnTieKnot Transaction { + tsourcepos=nullsourcepos, tdate=parsedate "2007/01/03", tdate2=Nothing, tstatus=False, @@ -417,6 +422,7 @@ journal7 = nulljournal {jtxns = } , txnTieKnot Transaction { + tsourcepos=nullsourcepos, tdate=parsedate "2007/01/03", tdate2=Nothing, tstatus=False,