Comment-highlight tests and fixing wrong doc-string highlight left from Haskell

purescript-font-lock.el

@@ -177,7 +177,7 @@ Returns keywords suitable for `font-lock-keywords'."
          ;; record fields or other identifiers.
          (toplevel-keywords
           (rx line-start (zero-or-more whitespace)
-              (group (or "type" "module" "import" "data" "class" "newtype"
+              (group (or "type" "import" "data" "class" "newtype"
                          "instance" "derive")
                      word-end)))
          ;; Reserved identifiers
@@ -186,7 +186,7 @@ Returns keywords suitable for `font-lock-keywords'."
           ;; spec syntax, but they are not reserved.
           ;; `_' can go in here since it has temporary word syntax.
           (regexp-opt
-           '("ado" "case" "do" "else" "if" "in" "infix"
+           '("ado" "case" "do" "else" "if" "in" "infix" "module"
              "infixl" "infixr" "let" "of" "then" "where" "_") 'words))
 
          ;; Top-level declarations
@@ -262,17 +262,6 @@ Returns keywords suitable for `font-lock-keywords'."
             (,sym 0 (if (eq (char-after (match-beginning 0)) ?:)
                         purescript-constructor-face
                       purescript-operator-face))))
-    (unless (boundp 'font-lock-syntactic-keywords)
-      (cl-case literate
-        (bird
-         (setq keywords
-               `(("^[^>\n].*$" 0 purescript-comment-face t)
-                 ,@keywords
-                 ("^>" 0 purescript-default-face t))))
-        ((latex tex)
-         (setq keywords
-               `((purescript-fl-latex-comments 0 'font-lock-comment-face t)
-                 ,@keywords)))))
     keywords))
 
 ;; The next three aren't used in Emacs 21.
@@ -363,9 +352,6 @@ that should be commented under LaTeX-style literate scripts."
   :type 'boolean
   :group 'purescript)
 
-(defvar purescript-font-lock-seen-docstring nil)
-(make-variable-buffer-local 'purescript-font-lock-seen-docstring)
-
 (defvar purescript-literate)
 
 (defun purescript-syntactic-face-function (state)
@@ -383,31 +369,16 @@ that should be commented under LaTeX-style literate scripts."
    ;; b) {-^ ... -}
    ;; c) -- | ...
    ;; d) -- ^ ...
-   ;; e) -- ...
-   ;; Where `e' is the tricky one: it is only a docstring comment if it
-   ;; follows immediately another docstring comment.  Even an empty line
-   ;; breaks such a sequence of docstring comments.  It is not clear if `e'
-   ;; can follow any other case, so I interpreted it as following only cases
-   ;; c,d,e (not a or b).  In any case, this `e' is expensive since it
-   ;; requires extra work for each and every non-docstring comment, so I only
-   ;; go through the more expensive check if we've already seen a docstring
-   ;; comment in the buffer.
+
+   ;; Worth pointing out purescript opted out of ability to continue
+   ;; docs-comment by omitting an empty line like in Haskell, see:
+   ;; https://github.com/purescript/documentation/blob/master/language/Syntax.md
+   ;; IOW, given a `-- | foo' line followed by `-- bar' line, the latter is a
+   ;; plain comment.
    ((and purescript-font-lock-docstrings
          (save-excursion
            (goto-char (nth 8 state))
-           (or (looking-at "\\(-- \\|{-\\)[ \\t]*[|^]")
-               (and purescript-font-lock-seen-docstring
-                    (looking-at "-- ")
-                    (let ((doc nil)
-                          pos)
-                      (while (and (not doc)
-                                  (setq pos (line-beginning-position))
-                                  (forward-comment -1)
-                                  (eq (line-beginning-position 2) pos)
-                                  (looking-at "--\\( [|^]\\)?"))
-                        (setq doc (match-beginning 1)))
-                      doc)))))
-    (set (make-local-variable 'purescript-font-lock-seen-docstring) t)
+           (looking-at "\\(-- \\|{-\\)[ \\t]*[|^]")))
     'font-lock-doc-face)
    (t 'font-lock-comment-face)))
 

purescript-mode.el

@@ -322,16 +322,7 @@ see documentation for that variable for more details."
   (set (make-local-variable 'comment-end-skip) "[ \t]*\\(-}\\|\\s>\\)")
   (set (make-local-variable 'parse-sexp-ignore-comments) nil)
   (set (make-local-variable 'indent-line-function) 'purescript-mode-suggest-indent-choice)
-  ;; Set things up for font-lock.
-  (set (make-local-variable 'font-lock-defaults)
-       '(purescript-font-lock-choose-keywords
-         nil nil ((?\' . "w") (?_  . "w")) nil
-         (font-lock-syntactic-keywords
-          . purescript-font-lock-choose-syntactic-keywords)
-         (font-lock-syntactic-face-function
-          . purescript-syntactic-face-function)
-         ;; Get help from font-lock-syntactic-keywords.
-         (parse-sexp-lookup-properties . t)))
+  (purescript-font-lock-defaults-create) ; set things up for font-lock.
   ;; PureScript's layout rules mean that TABs have to be handled with extra care.
   ;; The safer option is to avoid TABs.  The second best is to make sure
   ;; TABs stops are 8 chars apart, as mandated by the PureScript Report.  --Stef

tests/purescript-font-lock-tests.el

@@ -80,11 +80,14 @@ hello
    "foo = \"\"\"
 # a string with hashtag
   # another # one
+-- not a comment --
+-- | not a comment
+{- not a comment -}
 \"\"\"
 "
    '((1 3 font-lock-function-name-face)
      (5 5 font-lock-variable-name-face)
-     (7 55 font-lock-string-face))))
+     (7 114 font-lock-string-face))))
 
 (ert-deftest multiline-string-with-embedded-strings ()
   :expected-result :failed
@@ -96,3 +99,151 @@ this = \"still a string\"
    '((1 3 font-lock-function-name-face)
      (5 5 font-lock-variable-name-face)
      (7 37 font-lock-string-face))))
+
+(ert-deftest docs-bar-comment-different-spacings ()
+  (purescript-test-ranges
+   "-- | Docs comment 1 space
+--    | Docs comment many spaces
+"
+   '((1 57 font-lock-doc-face))))
+
+(ert-deftest docs-bar-comment-continuation ()
+  "Acc. to
+https://github.com/purescript/documentation/blob/master/language/Syntax.md
+PureScript explicitly doesn't support Haskell-style docs continuation
+where vertical bar is omitted"
+  (purescript-test-ranges
+   "-- | Docs start
+-- continue
+"
+   '((1 16 font-lock-doc-face)
+     (17 19 font-lock-comment-delimiter-face)
+     (20 28 font-lock-comment-face))))
+
+(ert-deftest docs-cap-comment-different-spacings ()
+  (purescript-test-ranges
+   "-- ^ Docs comment space
+--    ^ Docs comment many spaces
+"
+   '((1 57 font-lock-doc-face))))
+
+(ert-deftest multiline-comment ()
+  (purescript-test-ranges
+   "{-
+multiline comment
+-- | not a doc
+--| not a doc
+still comment
+-}
+noncomment
+{--}
+noncomment
+"
+   '((1 64 font-lock-comment-face)
+     (65 66 font-lock-comment-delimiter-face)
+     (67 78 nil)
+     (79 80 font-lock-comment-face)
+     (81 82 font-lock-comment-delimiter-face)
+     (83 93 nil))))
+
+(ert-deftest multiline-comment-w-delimiter-inside ()
+  :expected-result :failed
+  (purescript-test-ranges
+   "{- {-{- -} noncomment"
+   '((1 6 font-lock-comment-face)
+     (7 10 font-lock-comment-delimiter-face)
+     (11 21 nil))))
+
+(ert-deftest type-with-typenames-and--> ()
+  (purescript-test-ranges
+   "type Component props = Effect (props -> JSX)"
+   '((1 4 font-lock-keyword-face)
+     (5 5 nil)
+     (6 14 font-lock-type-face)
+     (15 21 nil)
+     (22 22 font-lock-variable-name-face)
+     (23 23 nil)
+     (24 29 font-lock-type-face)
+     (30 37 nil)
+     (38 39 font-lock-variable-name-face)
+     (40 40 nil)
+     (41 43 font-lock-type-face)
+     (44 45 nil))))
+
+(ert-deftest module-in-different-locations ()
+  (purescript-test-ranges
+   "module React.Basic.Hooks ( Component, module React.Basic
+                         , module Data.Tuple.Nested ) where
+"
+   '((1 6 font-lock-keyword-face)
+     (7 7 nil)
+     (8 24 font-lock-type-face)
+     (25 27 nil)
+     (28 36 font-lock-type-face)
+     (37 38 nil)
+     (39 44 font-lock-keyword-face)
+     (45 45 nil)
+     (46 56 font-lock-type-face)
+     (57 84 nil)
+     (85 90 font-lock-keyword-face)
+     (91 91 nil)
+     (92 108 font-lock-type-face)
+     (109 111 nil)
+     (112 116 font-lock-keyword-face)
+     (117 117 nil))))
+
+(ert-deftest func-decl-w-do-and-qualified-do ()
+  (purescript-test-ranges
+   "mkMyComponent :: Component {}
+mkMyComponent = do
+  modalComp :: (NodeRef -> JSX) <- mkModal
+  component \"mkMyComponent\" \\_ -> React.do
+    dialogRef :: NodeRef <- newNodeRef
+  pure $ R.label_ []
+"
+   '((1 13 font-lock-function-name-face)
+     (14 14 nil)
+     (15 16 font-lock-variable-name-face)
+     (17 17 nil)
+     (18 26 font-lock-type-face)
+     (27 30 nil)
+     (31 43 font-lock-function-name-face)
+     (44 44 nil)
+     (45 45 font-lock-variable-name-face)
+     (46 46 nil)
+     (47 48 font-lock-keyword-face)
+     (49 61 nil)
+     (62 63 font-lock-variable-name-face)
+     (64 65 nil)
+     (66 72 font-lock-type-face)
+     (73 73 nil)
+     (74 75 font-lock-variable-name-face)
+     (76 76 nil)
+     (77 79 font-lock-type-face)
+     (80 81 nil)
+     (82 83 font-lock-variable-name-face)
+     (84 104 nil)
+     (105 119 font-lock-string-face)
+     (120 120 nil)
+     (121 121 font-lock-variable-name-face)
+     (122 122 font-lock-keyword-face)
+     (123 123 nil)
+     (124 125 font-lock-variable-name-face)
+     (126 126 nil)
+     (127 131 font-lock-type-face)
+     (132 132 font-lock-variable-name-face)
+     (133 134 font-lock-keyword-face)
+     (135 149 nil)
+     (150 151 font-lock-variable-name-face)
+     (152 152 nil)
+     (153 159 font-lock-type-face)
+     (160 160 nil)
+     (161 162 font-lock-variable-name-face)
+     (163 181 nil)
+     (182 182 font-lock-variable-name-face)
+     (183 183 nil)
+     (184 184 font-lock-type-face)
+     (185 185 font-lock-variable-name-face)
+     (186 192 nil)
+     (193 194 font-lock-type-face)
+     (195 195 nil))))