fix:csv: fix tag: queries on CSV data (#2114)

This commit is contained in:
Simon Michael 2023-11-20 21:55:11 -10:00
parent 4febb74d1e
commit 2b18715885
3 changed files with 32 additions and 3 deletions

View File

@ -98,6 +98,7 @@ module Hledger.Read.Common (
emptyorcommentlinep, emptyorcommentlinep,
followingcommentp, followingcommentp,
transactioncommentp, transactioncommentp,
commenttagsp,
postingcommentp, postingcommentp,
-- ** bracketed dates -- ** bracketed dates

View File

@ -75,9 +75,10 @@ import Text.Printf (printf)
import Hledger.Data import Hledger.Data
import Hledger.Utils import Hledger.Utils
import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, journalFinalise, accountnamep ) import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, journalFinalise, accountnamep, commenttagsp )
import Hledger.Read.CsvUtils import Hledger.Read.CsvUtils
import System.Directory (doesFileExist, getHomeDirectory) import System.Directory (doesFileExist, getHomeDirectory)
import Data.Either (fromRight)
--- ** doctest setup --- ** doctest setup
-- $setup -- $setup
@ -1067,6 +1068,7 @@ transactionFromCsvRecord timesarezoned mtzin tzout sourcepos rules record = t
code = maybe "" singleline' $ fieldval "code" code = maybe "" singleline' $ fieldval "code"
description = maybe "" singleline' $ fieldval "description" description = maybe "" singleline' $ fieldval "description"
comment = maybe "" unescapeNewlines $ fieldval "comment" comment = maybe "" unescapeNewlines $ fieldval "comment"
ttags = fromRight [] $ rtp commenttagsp comment
precomment = maybe "" unescapeNewlines $ fieldval "precomment" precomment = maybe "" unescapeNewlines $ fieldval "precomment"
singleline' = T.unwords . filter (not . T.null) . map T.strip . T.lines singleline' = T.unwords . filter (not . T.null) . map T.strip . T.lines
@ -1079,6 +1081,7 @@ transactionFromCsvRecord timesarezoned mtzin tzout sourcepos rules record = t
p1IsVirtual = (accountNamePostingType <$> fieldval "account1") == Just VirtualPosting p1IsVirtual = (accountNamePostingType <$> fieldval "account1") == Just VirtualPosting
ps = [p | n <- [1..maxpostings] ps = [p | n <- [1..maxpostings]
,let cmt = maybe "" unescapeNewlines $ fieldval ("comment"<> T.pack (show n)) ,let cmt = maybe "" unescapeNewlines $ fieldval ("comment"<> T.pack (show n))
,let ptags = fromRight [] $ rtp commenttagsp cmt
,let currency = fromMaybe "" (fieldval ("currency"<> T.pack (show n)) <|> fieldval "currency") ,let currency = fromMaybe "" (fieldval ("currency"<> T.pack (show n)) <|> fieldval "currency")
,let mamount = getAmount rules record currency p1IsVirtual n ,let mamount = getAmount rules record currency p1IsVirtual n
,let mbalance = getBalance rules record currency n ,let mbalance = getBalance rules record currency n
@ -1091,6 +1094,7 @@ transactionFromCsvRecord timesarezoned mtzin tzout sourcepos rules record = t
,ptransaction = Just t ,ptransaction = Just t
,pbalanceassertion = mkBalanceAssertion rules record <$> mbalance ,pbalanceassertion = mkBalanceAssertion rules record <$> mbalance
,pcomment = cmt ,pcomment = cmt
,ptags = ptags
,ptype = accountNamePostingType acct ,ptype = accountNamePostingType acct
} }
] ]
@ -1106,6 +1110,7 @@ transactionFromCsvRecord timesarezoned mtzin tzout sourcepos rules record = t
,tcode = code ,tcode = code
,tdescription = description ,tdescription = description
,tcomment = comment ,tcomment = comment
,ttags = ttags
,tprecedingcomment = precomment ,tprecedingcomment = precomment
,tpostings = ps ,tpostings = ps
} }

View File

@ -561,7 +561,7 @@ $ ./csvtest.sh
>=0 >=0
# ** 27. match a specific field # ** 27. query by description
< <
2020-01-01, 1 2020-01-01, 1
2020-01-01, 2 2020-01-01, 2
@ -1094,7 +1094,30 @@ $ ./csvtest.sh
>2 /unexpected space/ >2 /unexpected space/
>=1 >=1
## . # ** 56. match transaction by posting tag (#2114)
<
2020-01-01, 1
RULES
fields date, desc
if %desc 1
comment ttag:tval
comment1 ptag:pval
account1 a
$ ./csvtest.sh tag:ptag
2020-01-01 ; ttag:tval
a ; ptag:pval
>=
# ** 57. match transaction by transaction tag (#2114)
$ ./csvtest.sh tag:ttag
2020-01-01 ; ttag:tval
a ; ptag:pval
>=
# ** .
#< #<
#$ ./csvtest.sh #$ ./csvtest.sh
#>=0 #>=0