From ae73c525d85cf19b8c4259997411a1735c509755 Mon Sep 17 00:00:00 2001
From: Hans-Peter Deifel <hpd@hpdeifel.de>
Date: Sun, 25 Sep 2016 21:56:28 +0200
Subject: [PATCH] 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.
---
 hledger-lib/Hledger/Read/CsvReader.hs | 17 ++++++++++++-----
 1 file changed, 12 insertions(+), 5 deletions(-)

diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs
index 059e1780b..fe1165fdd 100644
--- a/hledger-lib/Hledger/Read/CsvReader.hs
+++ b/hledger-lib/Hledger/Read/CsvReader.hs
@@ -9,6 +9,8 @@ A reader for CSV data, using an extra rules file to help interpret the data.
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 module Hledger.Read.CsvReader (
   -- * Reader
@@ -108,7 +110,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
   rules_ <- liftIO $ runExceptT $ parseRulesFile rulesfile
   let rules = case rules_ of
               Right (t::CsvRules) -> t
-              Left err -> throwerr $ show err
+              Left err -> throwerr err
   dbg2IO "rules" rules
 
   -- apply skip directive
@@ -354,17 +356,19 @@ addConditionalBlock b r = r{rconditionalblocks=b:rconditionalblocks r}
 getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate
 getDirective directivename = lookup directivename . rdirectives
 
+instance ShowErrorComponent String where
+  showErrorComponent = id
 
 parseRulesFile :: FilePath -> ExceptT String IO CsvRules
 parseRulesFile f = do
   s <- liftIO $ (readFile' f >>= expandIncludes (takeDirectory f))
   let rules = parseCsvRules f s
   case rules of
-    Left e -> ExceptT $ return $ Left $ show e
+    Left e -> ExceptT $ return $ Left $ parseErrorPretty e
     Right r -> do
                r_ <- liftIO $ runExceptT $ validateRules r
                ExceptT $ case r_ of
-                 Left e -> return $ Left $ show $ toParseError e
+                 Left e -> return $ Left $ parseErrorPretty $ toParseError e
                  Right r -> return $ Right r
   where
     toParseError :: forall s. Ord s => s -> ParseError Char s
@@ -515,8 +519,8 @@ assignmentseparatorp = do
   lift $ pdbg 3 "trying assignmentseparatorp"
   choice [
     -- try (lift (many spacenonewline) >> oneOf ":="),
-    try (void $ lift (many spacenonewline) >> char ':'),
-    space
+    try (lift (many spacenonewline) >> char ':'),
+    spaceChar
     ]
   _ <- lift (many spacenonewline)
   return ()
@@ -807,6 +811,9 @@ test_parser =  [
   ,"convert rules parsing: trailing blank lines" ~: do
      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
   -- ,"convert rules parsing: no final newline" ~: do
   --    assertParse (parseWithState rules csvrulesfile "A\na")