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