Skip to content

Support pattern as keyword #1413

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Aug 27, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
33 changes: 18 additions & 15 deletions haskell-font-lock.el
Original file line number Diff line number Diff line change
Expand Up @@ -86,6 +86,19 @@ be disabled at that position."
:type '(alist string string)
:group 'haskell-appearance)

(defcustom haskell-font-lock-keywords
;; `as', `hiding', and `qualified' are part of the import
;; spec syntax, but they are not reserved.
;; `_' can go in here since it has temporary word syntax.
'("case" "class" "data" "default" "deriving" "do"
"else" "if" "import" "in" "infix" "infixl"
"infixr" "instance" "let" "module" "mdo" "newtype" "of"
"rec" "pattern" "proc" "then" "type" "where" "_")
"Identifiers treated as reserved keywords in Haskell."
:group 'haskell-appearance
:type '(repeat string))


(defun haskell-font-lock-dot-is-not-composition (start)
"Return non-nil if the \".\" at START is not a composition operator.
This is the case if the \".\" is part of a \"forall <tvar> . <type>\"."
Expand Down Expand Up @@ -229,16 +242,6 @@ Regexp match data 0 points to the chars."
;; no face. So force evaluation by using `keep'.
keep)))))

(defconst haskell-font-lock--reverved-ids
;; `as', `hiding', and `qualified' are part of the import
;; spec syntax, but they are not reserved.
;; `_' can go in here since it has temporary word syntax.
'("case" "class" "data" "default" "deriving" "do"
"else" "if" "import" "in" "infix" "infixl"
"infixr" "instance" "let" "module" "mdo" "newtype" "of"
"rec" "proc" "then" "type" "where" "_")
"Identifiers treated as reserved keywords in Haskell.")

(defun haskell-font-lock--forward-type (&optional ignore)
"Find where does this type declaration end.

Expand Down Expand Up @@ -283,7 +286,7 @@ like ::, class, instance, data, newtype, type."
(setq last-token-was-newline nil))
((and (or (member (match-string-no-properties 0)
'("<-" "=" "←"))
(member (match-string-no-properties 0) haskell-font-lock--reverved-ids))
(member (match-string-no-properties 0) haskell-font-lock-keywords))
(not (member (match-string-no-properties 0) ignore)))
(setq cont nil)
(setq last-token-was-newline nil))
Expand Down Expand Up @@ -318,7 +321,7 @@ like ::, class, instance, data, newtype, type."
"Private function used to select either type or constructor face
on an uppercase identifier."
(cl-case (haskell-lexeme-classify-by-first-char (char-after (match-beginning 1)))
(varid (when (member (match-string 0) haskell-font-lock--reverved-ids)
(varid (when (member (match-string 0) haskell-font-lock-keywords)
;; Note: keywords parse as keywords only when not qualified.
;; GHC parses Control.let as a single but illegal lexeme.
(when (member (match-string 0) '("class" "instance" "type" "data" "newtype"))
Expand Down Expand Up @@ -440,11 +443,11 @@ on an uppercase identifier."

;; Toplevel Declarations.
;; Place them *before* generic id-and-op highlighting.
(,topdecl-var (1 (unless (member (match-string 1) haskell-font-lock--reverved-ids)
(,topdecl-var (1 (unless (member (match-string 1) haskell-font-lock-keywords)
'haskell-definition-face)))
(,topdecl-var2 (2 (unless (member (match-string 2) haskell-font-lock--reverved-ids)
(,topdecl-var2 (2 (unless (member (match-string 2) haskell-font-lock-keywords)
'haskell-definition-face)))
(,topdecl-bangpat (1 (unless (member (match-string 1) haskell-font-lock--reverved-ids)
(,topdecl-bangpat (1 (unless (member (match-string 1) haskell-font-lock-keywords)
'haskell-definition-face)))
(,topdecl-sym (2 (unless (member (match-string 2) '("\\" "=" "->" "→" "<-" "←" "::" "∷" "," ";" "`"))
'haskell-definition-face)))
Expand Down
29 changes: 11 additions & 18 deletions tests/haskell-font-lock-tests.el
Original file line number Diff line number Diff line change
Expand Up @@ -975,9 +975,8 @@
("Cons2" t haskell-constructor-face)
("Cons3" t haskell-constructor-face))))

(ert-deftest haskell-pattern ()
(ert-deftest haskell-pattern-1 ()
"Fontify the \"pattern\" keyword in contexts related to pattern synonyms."
:expected-result :failed
(check-properties
'("pattern A = B"
"pattern A <- B"
Expand Down Expand Up @@ -1006,27 +1005,21 @@
("pattern" t haskell-keyword-face)
("pattern" t haskell-keyword-face))))

(ert-deftest haskell-no-pattern-1 ()
"Don't fontify \"pattern\" in contexts unrelated to pattern synonyms."
;; This already works properly
;;:expected-result :failed
(ert-deftest haskell-pattern-2 ()
(check-properties
'("pattern :: Int"
"pattern = 3")
'(("pattern" t haskell-definition-face)
("pattern" t haskell-definition-face))))
'(("pattern" t haskell-keyword-face)
("pattern" t haskell-keyword-face))))

(ert-deftest haskell-no-pattern-2 ()
"Don't fontify \"pattern\" in contexts unrelated to pattern synonyms."
;; This already works properly
;;:expected-result :failed
(ert-deftest haskell-pattern-3 ()
(check-properties
'("foo :: (a -> pattern) -> a -> pattern"
"foo pattern x = pattern x"
"bar = pattern where pattern = 5")
'(("pattern" t nil)
("pattern" t nil)
("pattern" t nil)
("pattern" t nil)
("pattern" t nil)
("pattern" t nil))))
'(("pattern" t haskell-keyword-face)
("pattern" t haskell-keyword-face)
("pattern" t haskell-keyword-face)
("pattern" t haskell-keyword-face)
("pattern" t haskell-keyword-face)
("pattern" t haskell-keyword-face))))