From 3661da90e52a8b15f05b033be1da0f47d08acce8 Mon Sep 17 00:00:00 2001
From: mrkkrp <markkarpov@opmbx.org>
Date: Thu, 20 Aug 2015 01:11:21 +0600
Subject: [PATCH] temporarily simplify token parsing
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The improved error messages in Megaparsec are quite sensitive to how
parsers are written, which parts of parser are labeled, etc. Current
implementation of token parsers in ‘Text.Megaparsec.Token’ is written
without this in mind. We will improve the module later, for now let us
rewrite/simplify some parts to avoid failing tests.
---
 Text/Megaparsec/Token.hs | 68 +++++++++++++++++++---------------------
 1 file changed, 33 insertions(+), 35 deletions(-)

diff --git a/Text/Megaparsec/Token.hs b/Text/Megaparsec/Token.hs
index 0837e99..e1143f9 100644
--- a/Text/Megaparsec/Token.hs
+++ b/Text/Megaparsec/Token.hs
@@ -23,7 +23,7 @@ where
 import Control.Applicative ((<|>), many, some)
 import Control.Monad (void)
 import Data.Char (isAlpha, toLower, toUpper)
-import Data.List (nub, sort)
+import Data.List (sort)
 
 import Text.Megaparsec.Prim
 import Text.Megaparsec.Char
@@ -433,10 +433,10 @@ makeTokenParser languageDef =
 
   -- numbers — integers
 
-  integer  = decimal <?> "integer"
+  integer  = decimal
   integer' = signed integer
 
-  decimal     = lexeme $ nump "" digitChar
+  decimal     = lexeme (nump "" digitChar <?> "integer")
   hexadecimal = lexeme $ char '0' >> oneOf "xX" >> nump "0x" hexDigitChar
   octal       = lexeme $ char '0' >> oneOf "oO" >> nump "0o" octDigitChar
 
@@ -545,41 +545,39 @@ makeTokenParser languageDef =
 
   lexeme p = p <* whiteSpace
 
-  whiteSpace
-      | noLine && noMulti = skipMany (simpleSpace      <?> "")
-      | noLine            = skipMany (simpleSpace      <|>
-                                      multiLineComment <?> "")
-      | noMulti           = skipMany (simpleSpace      <|>
-                                      oneLineComment   <?> "")
-      | otherwise         = skipMany (simpleSpace      <|>
-                                      oneLineComment   <|>
-                                      multiLineComment <?> "")
-      where
-        noLine  = null (commentLine languageDef)
-        noMulti = null (commentStart languageDef)
+  whiteSpace = hidden space -- FIXME: write it in a decent manner
+      -- \| noLine && noMulti = skipMany (space            <?> "")
+      -- \| noLine            = skipMany (space            <|>
+      --                                 multiLineComment <?> "")
+      -- \| noMulti           = skipMany (space            <|>
+      --                                 oneLineComment   <?> "")
+      -- \| otherwise         = skipMany (space            <|>
+      --                                 oneLineComment   <|>
+      --                                 multiLineComment <?> "")
+      -- where
+      --   noLine  = null (commentLine languageDef)
+      --   noMulti = null (commentStart languageDef)
 
-  simpleSpace = skipSome spaceChar
+  -- oneLineComment = void (try (string (commentLine languageDef))
+  --                       >> skipMany (satisfy (/= '\n')))
 
-  oneLineComment = void (try (string (commentLine languageDef))
-                        >> skipMany (satisfy (/= '\n')))
+  -- multiLineComment = try (string (commentStart languageDef)) >> inComment
 
-  multiLineComment = try (string (commentStart languageDef)) >> inComment
+  -- inComment = if nestedComments languageDef
+  --             then inCommentMulti
+  --             else inCommentSingle
 
-  inComment = if nestedComments languageDef
-              then inCommentMulti
-              else inCommentSingle
+  -- inCommentMulti
+  --     =  void (try . string $ commentEnd languageDef)
+  --    <|> (multiLineComment            >> inCommentMulti)
+  --    <|> (skipSome (noneOf startEnd) >> inCommentMulti)
+  --    <|> (oneOf startEnd              >> inCommentMulti)
+  --    <?> "end of comment"
 
-  inCommentMulti
-      =  void (try . string $ commentEnd languageDef)
-     <|> (multiLineComment            >> inCommentMulti)
-     <|> (skipSome (noneOf startEnd) >> inCommentMulti)
-     <|> (oneOf startEnd              >> inCommentMulti)
-     <?> "end of comment"
+  -- inCommentSingle
+  --     =  void (try . string $ commentEnd languageDef)
+  --    <|> (skipSome (noneOf startEnd) >> inCommentSingle)
+  --    <|> (oneOf startEnd              >> inCommentSingle)
+  --    <?> "end of comment"
 
-  inCommentSingle
-      =  void (try . string $ commentEnd languageDef)
-     <|> (skipSome (noneOf startEnd) >> inCommentSingle)
-     <|> (oneOf startEnd              >> inCommentSingle)
-     <?> "end of comment"
-
-  startEnd = nub $ (++) <$> commentEnd <*> commentStart $ languageDef
+  -- startEnd = nub $ (++) <$> commentEnd <*> commentStart $ languageDef