Skip to content

Commit

Permalink
Merge pull request #40 from Hi-Angel/more-tests2
Browse files Browse the repository at this point in the history
Comment-highlight tests and fixing wrong doc-string highlight left from Haskell
  • Loading branch information
Hi-Angel authored Feb 24, 2025
2 parents e870a83 + 81d0cbc commit 7c62b2f
Show file tree
Hide file tree
Showing 3 changed files with 162 additions and 49 deletions.
47 changes: 9 additions & 38 deletions purescript-font-lock.el
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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)
Expand All @@ -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)))

Expand Down
11 changes: 1 addition & 10 deletions purescript-mode.el
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
153 changes: 152 additions & 1 deletion tests/purescript-font-lock-tests.el
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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))))

0 comments on commit 7c62b2f

Please sign in to comment.