Merge pull request #160 from anka-213/prettier-syntax-errors

Improve syntax error messages

2 files changed, 24 insertions, 4 deletions

diff --git a/src/compiler/GF/Grammar/Lexer.x b/src/compiler/GF/Grammar/Lexer.x
index 365388726..b3d271ddd 100644
--- a/src/compiler/GF/Grammar/Lexer.x
+++ b/src/compiler/GF/Grammar/Lexer.x
@@ -4,7 +4,7 @@
 module GF.Grammar.Lexer
          ( Token(..), Posn(..)
          , P, runP, runPartial, token, lexer, getPosn, failLoc
-         , isReservedWord
+         , isReservedWord, invMap
          ) where
 
 import Control.Applicative
@@ -134,7 +134,7 @@ data Token
  | T_Double  Double          -- double precision float literals
  | T_Ident   Ident
  | T_EOF
--- deriving Show -- debug
+  deriving (Eq, Ord, Show) -- debug
 
 res = eitherResIdent
 eitherResIdent :: (Ident -> Token) -> Ident -> Token
@@ -224,6 +224,13 @@ resWords = Map.fromList
  ]
  where b s t = (identS s, t)
 
+invMap :: Map.Map Token String
+invMap = res
+  where
+    lst = Map.toList resWords
+    flp = map (\(k,v) -> (v,showIdent k)) lst
+    res = Map.fromList flp
+
 unescapeInitTail :: String -> String
 unescapeInitTail = unesc . tail where
   unesc s = case s of
diff --git a/src/compiler/GF/Grammar/Parser.y b/src/compiler/GF/Grammar/Parser.y
index 85b081cd7..6aedcd399 100644
--- a/src/compiler/GF/Grammar/Parser.y
+++ b/src/compiler/GF/Grammar/Parser.y
@@ -37,6 +37,9 @@ import PGF(mkCId)
 %name pBNFCRules ListCFRule
 %name pEBNFRules ListEBNFRule
 
+%errorhandlertype explist
+%error { happyError }
+
 -- no lexer declaration
 %monad { P } { >>= } { return }
 %lexer { lexer } { T_EOF }
@@ -702,8 +705,18 @@ Posn
 
 {
 
-happyError :: P a
-happyError = fail "syntax error"
+happyError :: (Token, [String]) -> P a
+happyError (t,strs) = fail $ 
+  "Syntax error:\n     Unexpected " ++ showToken t ++ ".\n     Expected one of:\n" 
+    ++ unlines (map (("     - "++).cleanupToken) strs)
+  
+  where
+    cleanupToken "Ident" = "an identifier"
+    cleanupToken x = x
+    showToken (T_Ident i) = "identifier '" ++ showIdent i ++ "'"
+    showToken t = case Map.lookup t invMap of 
+      Nothing -> show t
+      Just s -> "token '" ++ s ++"'"
 
 mkListId,mkConsId,mkBaseId  :: Ident -> Ident
 mkListId = prefixIdent "List"