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

data: add source location to transactions

Browse Source
This commit is contained in:
Julien Moutinho 2014-08-01 02:32:42 +02:00
parent 9b83a411b9
commit a6190420b2
9 changed files with 62 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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

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

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

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

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

9
hledger-lib/Hledger/Read/CsvReader.hs
View File

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

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

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

3
hledger-lib/Hledger/Read/TimelogReader.hs
View File

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

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

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

6
hledger/Hledger/Cli.hs
View File

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