data: add source location to transactions

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,

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,
+            tsourcepos   = tlsourcepos i,
-            tdate2 = Nothing,
+            tdate        = idate,
-            tstatus       = True,
+            tdate2       = Nothing,
-            tcode         = "",
+            tstatus      = True,
-            tdescription  = showtime itod ++ "-" ++ showtime otod,
+            tcode        = "",
-            tcomment      = "",
+            tdescription = showtime itod ++ "-" ++ showtime otod,
-            ttags     = [],
+            tcomment     = "",
-            tpostings = ps,
+            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]
 
- ]
+ ]

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}

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

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 :: SourcePos -> CsvRules -> CsvRecord -> Transaction
-transactionFromCsvRecord rules record = t
+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,

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

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 [
  ]

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,

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,