Fix csv rules parsing (#407)
* csv rules: Show prettier parsing errors
This goes from
hledger: user error ("ParseError {errorPos = SourcePos {sourceName = \"foo.csv.rules\",
sourceLine = Pos 20, sourceColumn = Pos 1} :| [], errorUnexpected =
fromList [Tokens (' ' :| \"\")], errorExpected = fromList [Label ('b' :| \"lank or comment
line\"),EndOfInput], errorCustom = fromList []}")
to
hledger: user error (foo.csv.rules:20:1:
unexpected space
expecting blank or comment line or end of input
)
* csv rules: Fix parsing of empty field values
A single line containing `account1 ` (note the space at the end) should
parse as assignment of the empty string to account1. At least it did
until commit 4141067.
The problem is that megaparsec's `space` parses multiple space
characters as opposed to parsec. So in the example above it would
incorrectly consume the newline.
This commit also adds a new test case for this bug.
This commit is contained in:
parent
3efa123812
commit
ae73c525d8
@ -9,6 +9,8 @@ A reader for CSV data, using an extra rules file to help interpret the data.
|
|||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
{-# LANGUAGE TypeSynonymInstances #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
|
||||||
module Hledger.Read.CsvReader (
|
module Hledger.Read.CsvReader (
|
||||||
-- * Reader
|
-- * Reader
|
||||||
@ -108,7 +110,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
|
|||||||
rules_ <- liftIO $ runExceptT $ parseRulesFile rulesfile
|
rules_ <- liftIO $ runExceptT $ parseRulesFile rulesfile
|
||||||
let rules = case rules_ of
|
let rules = case rules_ of
|
||||||
Right (t::CsvRules) -> t
|
Right (t::CsvRules) -> t
|
||||||
Left err -> throwerr $ show err
|
Left err -> throwerr err
|
||||||
dbg2IO "rules" rules
|
dbg2IO "rules" rules
|
||||||
|
|
||||||
-- apply skip directive
|
-- apply skip directive
|
||||||
@ -354,17 +356,19 @@ addConditionalBlock b r = r{rconditionalblocks=b:rconditionalblocks r}
|
|||||||
getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate
|
getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate
|
||||||
getDirective directivename = lookup directivename . rdirectives
|
getDirective directivename = lookup directivename . rdirectives
|
||||||
|
|
||||||
|
instance ShowErrorComponent String where
|
||||||
|
showErrorComponent = id
|
||||||
|
|
||||||
parseRulesFile :: FilePath -> ExceptT String IO CsvRules
|
parseRulesFile :: FilePath -> ExceptT String IO CsvRules
|
||||||
parseRulesFile f = do
|
parseRulesFile f = do
|
||||||
s <- liftIO $ (readFile' f >>= expandIncludes (takeDirectory f))
|
s <- liftIO $ (readFile' f >>= expandIncludes (takeDirectory f))
|
||||||
let rules = parseCsvRules f s
|
let rules = parseCsvRules f s
|
||||||
case rules of
|
case rules of
|
||||||
Left e -> ExceptT $ return $ Left $ show e
|
Left e -> ExceptT $ return $ Left $ parseErrorPretty e
|
||||||
Right r -> do
|
Right r -> do
|
||||||
r_ <- liftIO $ runExceptT $ validateRules r
|
r_ <- liftIO $ runExceptT $ validateRules r
|
||||||
ExceptT $ case r_ of
|
ExceptT $ case r_ of
|
||||||
Left e -> return $ Left $ show $ toParseError e
|
Left e -> return $ Left $ parseErrorPretty $ toParseError e
|
||||||
Right r -> return $ Right r
|
Right r -> return $ Right r
|
||||||
where
|
where
|
||||||
toParseError :: forall s. Ord s => s -> ParseError Char s
|
toParseError :: forall s. Ord s => s -> ParseError Char s
|
||||||
@ -515,8 +519,8 @@ assignmentseparatorp = do
|
|||||||
lift $ pdbg 3 "trying assignmentseparatorp"
|
lift $ pdbg 3 "trying assignmentseparatorp"
|
||||||
choice [
|
choice [
|
||||||
-- try (lift (many spacenonewline) >> oneOf ":="),
|
-- try (lift (many spacenonewline) >> oneOf ":="),
|
||||||
try (void $ lift (many spacenonewline) >> char ':'),
|
try (lift (many spacenonewline) >> char ':'),
|
||||||
space
|
spaceChar
|
||||||
]
|
]
|
||||||
_ <- lift (many spacenonewline)
|
_ <- lift (many spacenonewline)
|
||||||
return ()
|
return ()
|
||||||
@ -807,6 +811,9 @@ test_parser = [
|
|||||||
,"convert rules parsing: trailing blank lines" ~: do
|
,"convert rules parsing: trailing blank lines" ~: do
|
||||||
assertParse (parseWithState' rules rulesp "skip\n\n \n")
|
assertParse (parseWithState' rules rulesp "skip\n\n \n")
|
||||||
|
|
||||||
|
,"convert rules parsing: empty field value" ~: do
|
||||||
|
assertParse (parseWithState' rules rulesp "account1 \nif foo\n account2 foo\n")
|
||||||
|
|
||||||
-- not supported
|
-- not supported
|
||||||
-- ,"convert rules parsing: no final newline" ~: do
|
-- ,"convert rules parsing: no final newline" ~: do
|
||||||
-- assertParse (parseWithState rules csvrulesfile "A\na")
|
-- assertParse (parseWithState rules csvrulesfile "A\na")
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user