Fix Haskell bugs: numbers, nested comments, dangling span...

... case-sensitive xref.

Also:
- Escape all HTML special characters in
  HaskellXref.
- Use Common.xref in HaskellSymbolTokenizer.

Author: idodeclare

src/org/opensolaris/opengrok/analysis/haskell/Haskell.lexh

@@ -0,0 +1,98 @@
+/*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License (the "License").  
+ * You may not use this file except in compliance with the License.
+ *
+ * See LICENSE.txt included in this distribution for the specific
+ * language governing permissions and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at LICENSE.txt.
+ * If applicable, add the following below this CDDL HEADER, with the
+ * fields enclosed by brackets "[]" replaced with your own identifying
+ * information: Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ */
+
+/*
+ * Copyright (c) 2015, 2016, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2017, Chris Fraire <[email protected]>.
+ *
+ * Copyright (c) Simon Peyton Jones. 
+ * Copyright (c) Simon Marlow.
+ * The authors and publisher intend this Report to belong to the entire Haskell
+ * community, and grant permission to copy and distribute it for any purpose,
+ * provided that it is reproduced in its entirety, including this Notice.
+ * Modified versions of this Report may also be copied and distributed for any
+ * purpose, provided that the modified version is clearly presented as such,
+ * and that it does not claim to be a definition of the language Haskell 2010.
+ */
+
+Identifier = ({varid} | {conid})
+/*
+ * varid	→	(small {small | large | digit | ' })⟨reservedid⟩
+ * ; N.b. "except {reservedid} is excluded from OpenGrok's varid definition
+ */
+varid = {small} ({small} | {large} | {digit} | [\'])*
+/*
+ * conid	→	large {small | large | digit | ' }
+ */
+conid = {large} ({small} | {large} | {digit} | [\'])*
+/*
+ * small	→	ascSmall | uniSmall | _
+ * ascSmall	→	a | b | … | z
+ * uniSmall	→	any Unicode lowercase letter
+ */
+small = [a-z\p{Ll}_]
+/*
+ * large	→	ascLarge | uniLarge
+ * ascLarge	→	A | B | … | Z
+ * uniLarge	→	any uppercase or titlecase Unicode letter
+ */
+large = [A-Z\p{Lu}\p{Lt}]
+/*
+ * digit	→	ascDigit | uniDigit
+ * ascDigit	→	0 | 1 | … | 9
+ * uniDigit	→	any Unicode decimal digit
+ * octit	→	0 | 1 | … | 7
+ * hexit	→	digit | A | … | F | a | … | f
+ */
+digit = [0-9\p{Nd}]
+octit = [0-7]
+hexit = [0-9\p{Nd}A-Fa-f]
+
+Number = ({integer} | {float})
+/*
+ * decimal	→	digit{digit}
+ * octal	→	octit{octit}
+ * hexadecimal	→	hexit{hexit}
+ */
+decimal         = {digit}+
+octal           = {octit}+
+hexadecimal     = {hexit}+
+/*
+ *
+ * integer	→	decimal
+ *		|	0o octal | 0O octal
+ *		|	0x hexadecimal | 0X hexadecimal
+ */
+integer = ({decimal} | [0][oO]{octal} | [0][xX]{hexadecimal})
+/*
+ * float	→	decimal . decimal [exponent]
+ *		|	decimal exponent
+ */
+float = ({decimal} [\.] {decimal} {exponent}? |
+    {decimal} {exponent})
+/*
+ * exponent	→	(e | E) [+ | -] decimal
+ */
+exponent = [eE] [\+\-]? {decimal}
+
+/*
+ * "For example, '-->' or '|--' do not begin a comment, because both of these
+ * are legal lexemes;"
+ */
+NotComments = ("-->" | "|--")

src/org/opensolaris/opengrok/analysis/haskell/HaskellSymbolTokenizer.lex

@@ -27,12 +27,13 @@
  */
 
 package org.opensolaris.opengrok.analysis.haskell;
+
+import java.io.IOException;
 import org.opensolaris.opengrok.analysis.JFlexTokenizer;
 
 /**
  * @author Harry Pan
  */
-
 %%
 %public
 %class HaskellSymbolTokenizer
@@ -44,12 +45,19 @@ super(in);
 %int
 %include CommonTokenizer.lexh
 %char
+%{
+    private int nestedComment;
 
-Identifier = [a-zA-Z_] [a-zA-Z0-9_']*
-Number = (0[xX][0-9a-fA-F]+|0[oO][0-7]+|[0-9]+\.[0-9]+|[0-9][0-9_]*)([eE][+-]?[0-9]+)?
+    public void reset() throws IOException {
+        super.reset();
+        nestedComment = 0;
+    }
+%}
 
 %state STRING CHAR COMMENT BCOMMENT
 
+%include Common.lexh
+%include Haskell.lexh
 %%
 
 <YYINITIAL> {
@@ -64,26 +72,40 @@ Number = (0[xX][0-9a-fA-F]+|0[oO][0-7]+|[0-9]+\.[0-9]+|[0-9][0-9_]*)([eE][+-]?[0
     \"   { yybegin(STRING);   }
     \'   { yybegin(CHAR);     }
     "--" { yybegin(COMMENT);  }
-    "{-" { yybegin(BCOMMENT); }
+
+    {NotComments}    {}
 }
 
 <STRING> {
+    \\[\"\\]    {}
     \"   { yybegin(YYINITIAL); }
-    \\\" {}     // escaped double quote - don't do anything
 }
 
 <CHAR> {    // we don't need to consider the case where prime is part of an identifier since it is handled above
+    \\[\'\\]    {}
     \'   { yybegin(YYINITIAL); }
-    \\\' {}     // escaped single quote - don't do anything
 }
 
 <COMMENT> {
-    \n { yybegin(YYINITIAL); }
+    {EOL}    { yybegin(YYINITIAL); }
+}
+
+<YYINITIAL, BCOMMENT> {
+    "{-"    {
+        if (nestedComment++ == 0) {
+            yybegin(BCOMMENT);
+        }
+    }
 }
 
 <BCOMMENT> {
-    "-}" { yybegin(YYINITIAL); }
+    "-}"    {
+        if (--nestedComment == 0) {
+            yybegin(YYINITIAL);
+        }
+    }
 }
 
 // fallback
+{WhiteSpace} |
 [^] {}

src/org/opensolaris/opengrok/analysis/haskell/HaskellXref.lex

@@ -27,73 +27,124 @@
  */
 
 package org.opensolaris.opengrok.analysis.haskell;
-import org.opensolaris.opengrok.analysis.JFlexXref;
+
+import org.opensolaris.opengrok.analysis.JFlexXrefSimple;
+import org.opensolaris.opengrok.web.HtmlConsts;
 import org.opensolaris.opengrok.web.Util;
 
 /**
  * @author Harry Pan
  */
-
 %%
 %public
 %class HaskellXref
-%extends JFlexXref
+%extends JFlexXrefSimple
 %unicode
-%ignorecase
 %int
 %include CommonXref.lexh
 %{
+    private int nestedComment;
+
+    @Override
+    public void reset() {
+        super.reset();
+        nestedComment = 0;
+    }
+
   // TODO move this into an include file when bug #16053 is fixed
   @Override
   protected int getLineNumber() { return yyline; }
   @Override
   protected void setLineNumber(int x) { yyline = x; }
 %}
 
-Identifier = [a-zA-Z_] [a-zA-Z0-9_']*
-Number = (0[xX][0-9a-fA-F]+|0[oO][0-7]+|[0-9]+\.[0-9]+|[0-9][0-9_]*)([eE][+-]?[0-9]+)?
-
 %state STRING CHAR COMMENT BCOMMENT
 
 %include Common.lexh
 %include CommonURI.lexh
 %include CommonPath.lexh
+%include Haskell.lexh
 %%
 <YYINITIAL> {
     {Identifier} {
         String id = yytext();
         writeSymbol(id, Consts.kwd, yyline);
     }
-    {Number}     { out.write("<span class=\"n\">"); out.write(yytext()); out.write("</span>"); }
-    \"           { yybegin(STRING); out.write("<span class=\"s\">\"");                         }
-    \'           { yybegin(CHAR); out.write("<span class=\"s\">\'");                           }
-    "--"         { yybegin(COMMENT); out.write("<span class=\"c\">--");                        }
-    "{-"         { yybegin(BCOMMENT); out.write("<span class=\"c\">{-");                       }
+    {Number}     {
+        disjointSpan(HtmlConsts.NUMBER_CLASS);
+        out.write(yytext());
+        disjointSpan(null);
+    }
+    \"           {
+        pushSpan(STRING, HtmlConsts.STRING_CLASS);
+        out.write(htmlize(yytext()));
+    }
+    \'           {
+        pushSpan(CHAR, HtmlConsts.STRING_CLASS);
+        out.write(htmlize(yytext()));
+    }
+    "--"         {
+        pushSpan(COMMENT, HtmlConsts.COMMENT_CLASS);
+        out.write(yytext());
+    }
+
+    {NotComments}    { out.write(yytext()); }
 }
 
 <STRING> {
-    \"                 { yybegin(YYINITIAL); out.write("\"</span>");               }
-    \\\\               { out.write("\\\\");                                        }
-    \\\"               { out.write("\\\"");                                        }
-    {WhspChar}*{EOL} { yybegin(YYINITIAL); out.write("</span>"); startNewLine(); }
+    \\[\"\\]    { out.write(htmlize(yytext())); }
+    \"          {
+        out.write(htmlize(yytext()));
+        yypop();
+    }
+    /*
+     * "A string may include a 'gap'-—two backslants enclosing white
+     * characters—-which is ignored. This allows one to write long strings on
+     * more than one line by writing a backslant at the end of one line and at
+     * the start of the next." N.b. OpenGrok does not explicltly recognize the
+     * "gap" but since a STRING must end in a non-escaped quotation mark, just
+     * allow STRINGs to be multi-line regardless of syntax.
+     */
 }
 
 <CHAR> {    // we don't need to consider the case where prime is part of an identifier since it is handled above
-    ( .\' | \\.\' )    { yybegin(YYINITIAL); out.write(yytext()); out.write("</span>"); }
-    {WhspChar}*{EOL} { yybegin(YYINITIAL); out.write("</span>"); startNewLine();      }
+    \\[\'\\]    { out.write(htmlize(yytext())); }
+    \'          {
+        out.write(htmlize(yytext()));
+        yypop();
+    }
+    /*
+     * N.b. though only a single char is valid Haskell syntax, OpenGrok just
+     * waits to end CHAR at a non-escaped apostrophe regardless of count.
+     */
 }
 
 <COMMENT> {
-    {WhspChar}*{EOL} { yybegin(YYINITIAL); out.write("</span>"); startNewLine(); }
+    {WhspChar}*{EOL}    {
+        yypop();
+        startNewLine();
+    }
+}
+
+<YYINITIAL, BCOMMENT> {
+    "{-"    {
+        if (nestedComment++ == 0) {
+            pushSpan(BCOMMENT, HtmlConsts.COMMENT_CLASS);
+        }
+        out.write(yytext());
+    }
 }
 
 <BCOMMENT> {
-    "-}" { yybegin(YYINITIAL); out.write("-}</span>"); }
+    "-}"    {
+        out.write(yytext());
+        if (--nestedComment == 0) {
+            yypop();
+        }
+    }
 }
 
-"&"                { out.write( "&amp;");           }
-"<"                { out.write( "&lt;");            }
-">"                { out.write( "&gt;");            }
+[&<>\'\"]    { out.write(htmlize(yytext())); }
 {WhspChar}*{EOL} { startNewLine();                }
 {WhiteSpace}       { out.write(yytext());           }
 [!-~]              { out.write(yycharat(0)); }

test/org/opensolaris/opengrok/analysis/haskell/HaskellXrefTest.java

@@ -59,7 +59,7 @@ public void basicTest() throws IOException {
             "<a class=\"l\" name=\"1\" href=\"#1\">1</a>" +
             "<a href=\"/source/s?defs=putStrLn\" class=\"intelliWindow-symbol\"" +
             " data-definition-place=\"undefined-in-file\">putStrLn</a>" +
-            " <span class=\"s\">\"Hello, world!\"</span>\n",
+            " <span class=\"s\">&quot;Hello, world!&quot;</span>\n",
                 w.toString());
     }