branch: elpa/haskell-tng-mode commit 497214bf98b411ec6d6939e80fefd9b72f557883 Author: Tseen She <ts33n....@gmail.com> Commit: Tseen She <ts33n....@gmail.com>
syntax tests and bugfixes --- haskell-tng-compile.el | 4 ++ haskell-tng-contrib.el | 1 + haskell-tng-font-lock.el | 4 +- haskell-tng-rx.el | 2 +- haskell-tng-syntax.el | 23 +++++-- haskell-tng-util.el | 6 ++ test/haskell-tng-syntax-test.el | 58 ++++++++++++++++ test/src/grammar.hs.sexps | 2 +- test/src/layout.hs.syntax | 19 ++++++ test/src/medley.hs | 3 +- test/src/medley.hs.faceup | 5 +- test/src/medley.hs.insert.indent | 6 +- test/src/medley.hs.layout | 7 +- test/src/medley.hs.lexer | 7 +- test/src/medley.hs.syntax | 138 +++++++++++++++++++++++++++++++++++++++ 15 files changed, 265 insertions(+), 20 deletions(-) diff --git a/haskell-tng-compile.el b/haskell-tng-compile.el index bfc311c..aa3d769 100644 --- a/haskell-tng-compile.el +++ b/haskell-tng-compile.el @@ -50,6 +50,10 @@ will cause the subsequent call to prompt." (_ (read-shell-command "Compile command: " (or last (car haskell-tng-compile:history)) + ;; TODO haskell-tng-compile:command should always be + ;; first in the prompted history, even if another + ;; command was used elsewhere. Might require + ;; mutating / reordering the global history here. '(haskell-tng-compile:history . 1)))))) (setq haskell-tng-compile:command (unless (equal command haskell-tng-compile:alt) command)) diff --git a/haskell-tng-contrib.el b/haskell-tng-contrib.el index db43386..36a7bf3 100644 --- a/haskell-tng-contrib.el +++ b/haskell-tng-contrib.el @@ -28,6 +28,7 @@ (when-let (default-directory (locate-dominating-file default-directory "stack.yaml")) (call-process "stack2cabal"))) +(defalias 'stack2cabal 'haskell-tng-contrib:stack2cabal) (provide 'haskell-tng-contrib) ;;; haskell-tng-contrib.el ends here diff --git a/haskell-tng-font-lock.el b/haskell-tng-font-lock.el index 1732d3d..008e247 100644 --- a/haskell-tng-font-lock.el +++ b/haskell-tng-font-lock.el @@ -271,7 +271,8 @@ succeeds and may further restrict the FIND search limit." (rx symbol-start "::" symbol-end) (rx symbol-start "::" symbol-end (group (+ anything))) haskell-tng:paren-close - haskell-tng:indent-close-previous) + haskell-tng:indent-close-previous + haskell-tng:do-bind) (haskell-tng:font:multiline topdecl (rx line-start (| "data" "newtype" "class" "instance") word-end) @@ -294,6 +295,7 @@ succeeds and may further restrict the FIND search limit." (rx word-start "deriving" word-end) (rx word-start "deriving" word-end (+ space) (group (? (| "anyclass" "stock" "newtype") word-end)) + ;; TODO support a lone derivation without brackets (* space) ?\( (group (* anything)) ?\)) haskell-tng:indent-close) diff --git a/haskell-tng-rx.el b/haskell-tng-rx.el index d8cac08..aafface 100644 --- a/haskell-tng-rx.el +++ b/haskell-tng-rx.el @@ -51,7 +51,7 @@ give false positives." `(| '(| symbol-end word-start)) ) (| "[]" "()") ;; empty list / void - (: symbol-start (char ?\\)))) + (: symbol-start (char ?\\)))) ;; TODO only for lambdas, don't include ops like \\ (defconst haskell-tng:rx:toplevel ;; TODO multi-definitions, e.g. Servant's :<|> diff --git a/haskell-tng-syntax.el b/haskell-tng-syntax.el index 205d42a..d5b437e 100644 --- a/haskell-tng-syntax.el +++ b/haskell-tng-syntax.el @@ -36,7 +36,7 @@ (modify-syntax-entry it " " table)) ;; ascSymbol - (--each (string-to-list "!#$%&*+./<=>?@\\^|-~:") + (--each (string-to-list "!#$%&*+./<=>?\\^|-~:") (modify-syntax-entry it "_" table)) ;; TODO: debatable. User nav vs fonts and lexing. getting "word boundaries" @@ -49,7 +49,7 @@ ;; and would be reused by the SMIE lexer. ;; some special (treated like punctuation) - (--each (string-to-list ",;") + (--each (string-to-list ",;@") (modify-syntax-entry it "." table)) ;; apostrophe as a word, not delimiter @@ -77,8 +77,10 @@ (defun haskell-tng:syntax-propertize (start end) "For some context-sensitive syntax entries." - (haskell-tng:syntax:char-delims start end) - (haskell-tng:syntax:escapes start end)) + (let (case-fold-search) + (haskell-tng:syntax:char-delims start end) + (haskell-tng:syntax:fqn-punct start end) + (haskell-tng:syntax:escapes start end))) (defun haskell-tng:syntax:char-delims (start end) "Matching apostrophes are string delimiters (literal chars)." @@ -90,13 +92,22 @@ (put-text-property open (1+ open) 'syntax-table '(7 . ?\')) (put-text-property close (1+ close) 'syntax-table '(7 . ?\'))))) +(defun haskell-tng:syntax:fqn-punct (start end) + "dot/period is typically a symbol, unless it is used in a +module or qualifier, then it is punctuation." + (goto-char start) + (while (re-search-forward (rx word-end ".") end t) + (let ((dot (match-beginning 0))) + (put-text-property dot (1+ dot) 'syntax-table '(1))))) + +;; TODO somehow is not escaping two escaped quotes together, e.g. in "\"\"" (defun haskell-tng:syntax:escapes (start end) - "Backslash inside String is an escape character." + "Backslash inside String is an escape character \n." (goto-char start) (while (re-search-forward "\\\\" end t) (when (nth 3 (syntax-ppss)) (put-text-property (- (point) 1) (point) - 'syntax-table '(9 . ?\\))))) + 'syntax-table '(9))))) (provide 'haskell-tng-syntax) ;;; haskell-tng-syntax.el ends here diff --git a/haskell-tng-util.el b/haskell-tng-util.el index aca9515..1a449b9 100644 --- a/haskell-tng-util.el +++ b/haskell-tng-util.el @@ -33,6 +33,12 @@ (throw 'closed (point)))) nil)))) +(defun haskell-tng:do-bind (&optional pos) + "The next `<-'" + (save-excursion + (goto-char (or pos (point))) + (re-search-forward "<-" nil t))) + (defun haskell-tng:indent-close-previous () "Indentation closing the previous symbol." (save-excursion diff --git a/test/haskell-tng-syntax-test.el b/test/haskell-tng-syntax-test.el new file mode 100644 index 0000000..efb2e5a --- /dev/null +++ b/test/haskell-tng-syntax-test.el @@ -0,0 +1,58 @@ +;;; haskell-tng-syntax-test.el --- Tests for fontification -*- lexical-binding: t -*- + +;; Copyright (C) 2019 Tseen She +;; License: GPL 3 or any later version + +(require 'ert) +(require 'faceup) +(require 's) + +(require 'haskell-tng-mode) +(require 'haskell-tng-testutils + "test/haskell-tng-testutils.el") + +(defun have-expected-syntax (file) + (haskell-tng-testutils:assert-file-contents + file + #'haskell-tng-mode + #'buffer-to-syntax-string + "syntax")) + +(defun buffer-to-syntax-string () + (goto-char (point-max)) + (syntax-propertize (point)) + (let (codes) + (while (not (bobp)) + ;; https://www.gnu.org/software/emacs/manual/html_node/elisp/Syntax-Class-Table.html#Syntax-Class-Table + (when-let (class (syntax-class (syntax-after (point)))) + (when (looking-at (rx eol)) + (push "\n" codes)) + (push (pcase class + (0 " ") + (1 ".") + (2 "w") + (3 "_") + (4 "(") + (5 ")") + (6 "'") + (7 "\"") + (8 "$") + (9 "\\") + (10 "//") + (11 "<") + (12 ">") + (13 "@") + (14 "!") + (15 "|")) + codes)) + (forward-char -1)) + (s-join "" codes))) + +;; to generate .faceup files, use faceup-view-buffer +(ert-deftest haskell-tng-syntax-file-tests () + (should (have-expected-syntax (testdata "src/medley.hs"))) + + (should (have-expected-syntax (testdata "src/layout.hs"))) + ) + +;;; haskell-tng-syntax-test.el ends here diff --git a/test/src/grammar.hs.sexps b/test/src/grammar.hs.sexps index 18e71bd..b3cd0f7 100644 --- a/test/src/grammar.hs.sexps +++ b/test/src/grammar.hs.sexps @@ -1,5 +1,5 @@ -- | Tests for grammar rules i.e. sexps, not indentation -((module (Foo.(Bar)) (where) +((module ((Foo).(Bar)) (where) ((calc) (::) (Int) -> (Int) ((calc) (a) = (if (a) < ((10) diff --git a/test/src/layout.hs.syntax b/test/src/layout.hs.syntax new file mode 100644 index 0000000..a50da24 --- /dev/null +++ b/test/src/layout.hs.syntax @@ -0,0 +1,19 @@ +_ wwwwww w.w wwww www wwwwwwwwwww wwwwww> +wwwwww wwwwww( wwwww. wwww. www. www. wwww ) wwwww> +wwww wwwww w _ wwwww> + _ wwwwwww w (wwwww w)> +> +wwww __ w __ wwwww w __ wwwww w> +wwww w w _ wwwwwww w w> +> +wwww __ wwwww w __ www> +wwww w _ wwwwww (wwwwwwww w) wwwww> + wwwwwwww wwwww _ ()> + wwwwwwww (wwwwwww w w) _ w_ww wwwww ww _ wwwwwwww w> +> +www __ wwwww w __ (w. wwwww w)> +www (wwwwwww w w)> + _ (w. wwww w ww w __ w w wwwww w w _ w) __ (www wwwww) ww ww wwwww> +> +www __ wwwww w __ w> +www (wwwwwww w w) _ w __ (www wwwww) ww ww wwwww> diff --git a/test/src/medley.hs b/test/src/medley.hs index 317fc85..941d02e 100644 --- a/test/src/medley.hs +++ b/test/src/medley.hs @@ -128,7 +128,8 @@ deriving instance FromJSONKey StateName deriving anyclass instance FromJSON Base deriving newtype instance FromJSON Treble -foo = bar +foo = do + bar :: Wibble <- baz where baz = _ -- checking that comments are ignored in layout -- and that a starting syntax entry is ok diff --git a/test/src/medley.hs.faceup b/test/src/medley.hs.faceup index edaf7bf..75ad73b 100644 --- a/test/src/medley.hs.faceup +++ b/test/src/medley.hs.faceup @@ -58,7 +58,7 @@ «:haskell-tng:keyword:class»«:haskell-tng:type: »«:haskell-tng:keyword:(»«:haskell-tng:type:Eq a»«:haskell-tng:keyword:)»«:haskell-tng:type: »«:haskell-tng:keyword:=>»«:haskell-tng:type: Ord a »«:haskell-tng:keyword:where» «:haskell-tng:keyword:(»<«:haskell-tng:keyword:),» «:haskell-tng:keyword:(»<=«:haskell-tng:keyword:),» «:haskell-tng:keyword:(»>=«:haskell-tng:keyword:),» «:haskell-tng:keyword:(»>«:haskell-tng:keyword:)» «:haskell-tng:keyword:::»«:haskell-tng:type: a »«:haskell-tng:keyword:->»«:haskell-tng:type: a »«:haskell-tng:keyword:->»«:haskell-tng:type: Bool -» max «:haskell-tng:keyword:@»Foo«:haskell-tng:keyword:,» min «:haskell-tng:keyword:::»«:haskell-tng:type: a »«:haskell-tng:keyword:->»«:haskell-tng:type: a »«:haskell-tng:keyword:->»«:haskell-tng:type: a +» max @«:haskell-tng:constructor:Foo»«:haskell-tng:keyword:,» min «:haskell-tng:keyword:::»«:haskell-tng:type: a »«:haskell-tng:keyword:->»«:haskell-tng:type: a »«:haskell-tng:keyword:->»«:haskell-tng:type: a » «:haskell-tng:keyword:instance»«:haskell-tng:type: »«:haskell-tng:keyword:(»«:haskell-tng:type:Eq a»«:haskell-tng:keyword:)»«:haskell-tng:type: »«:haskell-tng:keyword:=>»«:haskell-tng:type: Eq »«:haskell-tng:keyword:(»«:haskell-tng:type:Tree a»«:haskell-tng:keyword:)»«:haskell-tng:type: »«:haskell-tng:keyword:where» «:haskell-tng:constructor:Leaf» a == «:haskell-tng:constructor:Leaf» b «:haskell-tng:keyword:=» a == b @@ -128,7 +128,8 @@ «:haskell-tng:keyword:deriving» anyclass «:haskell-tng:keyword:instance» «:haskell-tng:constructor:FromJSON» «:haskell-tng:constructor:Base» «:haskell-tng:keyword:deriving» «:haskell-tng:keyword:newtype» «:haskell-tng:keyword:instance» «:haskell-tng:constructor:FromJSON» «:haskell-tng:constructor:Treble» -«:haskell-tng:toplevel:foo» «:haskell-tng:keyword:=» bar +«:haskell-tng:toplevel:foo» «:haskell-tng:keyword:=» «:haskell-tng:keyword:do» + bar «:haskell-tng:keyword:::»«:haskell-tng:type: Wibble »«:haskell-tng:keyword:<-» baz «:haskell-tng:keyword:where» baz «:haskell-tng:keyword:=» «:haskell-tng:keyword:_» «m:-- »«x:checking that comments are ignored in layout » «m:-- »«x:and that a starting syntax entry is ok diff --git a/test/src/medley.hs.insert.indent b/test/src/medley.hs.insert.indent index 5c5e66b..a0571b7 100644 --- a/test/src/medley.hs.insert.indent +++ b/test/src/medley.hs.insert.indent @@ -258,8 +258,10 @@ deriving newtype instance FromJSON Treble 1 v v -foo = bar +foo = do 2 1 v + bar :: Wibble <- baz +2 1 v where baz = _ 3 2 1 v -- checking that comments are ignored in layout @@ -269,6 +271,6 @@ foo = bar (+) = _ 1 3 2 v -1 2 v +1 3 2 v test = 1 `shouldBe` 1 v \ No newline at end of file diff --git a/test/src/medley.hs.layout b/test/src/medley.hs.layout index 0160a9e..c186632 100644 --- a/test/src/medley.hs.layout +++ b/test/src/medley.hs.layout @@ -128,11 +128,12 @@ module Foo.Bar.Main ;deriving anyclass instance FromJSON Base ;deriving newtype instance FromJSON Treble -;foo = bar - where {baz = _ +;foo = do + {bar :: Wibble <- baz + ;where {baz = _ -- checking that comments are ignored in layout -- and that a starting syntax entry is ok ;(+) = _ -};test = 1 `shouldBe` 1 +}};test = 1 `shouldBe` 1 } \ No newline at end of file diff --git a/test/src/medley.hs.lexer b/test/src/medley.hs.lexer index 8c76816..ff9952a 100644 --- a/test/src/medley.hs.lexer +++ b/test/src/medley.hs.lexer @@ -128,11 +128,12 @@ CONSYM CONID « CONID » « CONID CONID » ; deriving VARID instance CONID CONID ; deriving newtype instance CONID CONID -; VARID = VARID -where { VARID = _ +; VARID = do +{ VARID :: CONID <- VARID +; where { VARID = _ ; « SYMID » = _ -} ; VARID = 1 SYMID 1 +} } ; VARID = 1 SYMID 1 } diff --git a/test/src/medley.hs.syntax b/test/src/medley.hs.syntax new file mode 100644 index 0000000..99385b6 --- /dev/null +++ b/test/src/medley.hs.syntax @@ -0,0 +1,138 @@ +__ wwwwwwww wwwwwwwwwwwwwwwww __)> +(__ wwwwwwww wwwwwwwwwwwwwwwwwww __)> +> +__ _ wwww wwww ww w wwwwww ww wwwwwww wwwwwwwwww www wwww wwwwww wwwww> +wwwwww www.www.wwww> + ( wwwwww(__). wwwwww(wwww. (___)). www> + __ _ wwwwwwwwww> + . wwwwwwwwwww. wwwwwwwwwwwwwwwww> + . wwwwww wwww.www> + ) wwwww> +> +wwwwww wwwwwww.wwwwwwwwwww (wwww. wwwwwwww. wwww. (___). (___))> +wwwwww wwww.wwwwwwww (wwwwwwwww)> +wwwwww wwww.wwwwwww ((___))> +wwwwww wwww.wwww (wwwwwwwwwww)> +wwwwww wwww.wwwwww ((__))> +wwwwww wwwwwwwww wwwwwww.wwwww> +wwwwww wwwwwwwww wwwwwww.wwwwwwwwwww ww wwww> +wwwwww wwwwwwwww wwwwwww.wwwwwwwww __ wwwwww (wwwwww)> + ww www> +wwwwww wwwwwwwww wwwwwwww.www wwwwww (ww. wwwwww. wwwwwwwww)> +wwwwww wwwwwwww.www (ww. wwwwww. wwwwwwwww)> +wwwwww wwwwwwww.www wwwwww (ww. wwwwww. wwwwwwwww)> +wwwwww wwwwwwwww wwwwwwww.www (ww. wwwwww. wwwwwwwww)> +wwwwww wwwwww.wwww (wwwwwwww (__). wwwwwwwwwww. wwwwwwwww.> + wwwww.> + wwwwww.> + wwwwww)> +wwwwww wwwwww.wwwwwwww (wwwwwwwwwwwwwwww. www(www. (__)))> +wwwwww wwwwww.ww (wwwwww (__). wwwwww. wwwwwwwwwwww.> + wwwwwww. wwwwwwwww. wwwwwwww. wwwwww.> + wwwwww. wwwwwwwww)> +wwwwww wwwwww.wwwwwww (wwwwwwwwwwwww (__). wwwwwwwww (__).> + wwwwwwwwwwwww. wwww. wwwwwwwwwwwwww)> +> +__ wwww wwwww wwww wwwwww ww wwwwwwwwwww> +wwwww _ ("w". "\w". "\w")> +> +wwwwwwwww _ wwww "w" w> +> +www _ "wwwwww (wwwwww)"> +> +wwwww www w w wwwww> + www __ www w __ w> +> +wwwwwwww (__ wwwwwwww __) www w (w w_ w) wwwww> + www (www w w) _ w> +> +wwwwwwww (__ wwwwwwwwwwww __) www w w __ www w (w w_ w) wwwww> + www (www w ww) _ www ww> +> +wwww wwwwwww _ wwwwwww> + ( wwwwwwwwwwwwwwwww __ wwwwwwwwww> + . wwwwwwwwwwwwwww __ wwwww wwwwwwww> + . wwwwwwwwwwwwwwwww __ wwwww wwwwwwww> + . wwwwwwwwwwwwwwwwwwwwww __ (wwwwww)> + ) wwwwwwww (ww. wwww)> +> +wwwww (ww w) __ www w wwwww> + (_). (__). (__). (_) __ w __ w __ wwww> + www .www. www __ w __ w __ w> +> +wwwwwwww (ww w) __ ww (wwww w) wwwww> + wwww w __ wwww w _ w __ w> + (wwwwww ww ww) __ (wwwwww ww ww) _ (ww__ww) __ (ww__ww)> + w __ w _ wwwww> +> +wwww wwwwwwwwww _ wwwww __ _ wwwwww wwwwwwwwwww. wwwwwww> + _ wwwwwww __ _ wwwwww wwwwwww. wwwwww> + _ wwww __ _ wwwwww wwww wwwww ww wwwwwww. wwwwwww> + _ wwwww __ _ wwwwww wwwww. wwwwww> + _ wwwww __ _ wwwwww wwwww wwwwwwwww. wwwwww> + wwwwwwww (ww. wwww)> +> +wwww wwwwww w w wwwww> + w www _ wwww> + w w _ wwww> +> +wwww wwwwwww _ wwwwwww> + wwwwwwww (ww) www (wwwwwwwwwww (wwwww www))> + wwwwwwww wwwww (wwww)> + wwwwwwww wwwwwwww (wwwwwwwww. wwwwwwwwww)> +> +wwwwwww wwwwww _ wwwwww> +> +www __> + wwwwww __ wwwwww> + __ wwwwww __ wwwwww> + __ wwwwww __ wwwwww> + __ wwwwww __ wwwwww> + __ (www __ wwwwww)> + __ (wwwwww __ wwwwww> + w w w)> +> +(www __ (wwwwww wwwwww)) www> +> +wwwwwww wwwwwww> + (wwwwww __ wwwwwwwwww)> + (wwwwww __ wwwwwwwwww)> + wwwwww> + w> + _ wwwwwww w> +> +wwwwwwwwwwwww __ wwww.wwwwww wwwwwww> +wwwwwwwwwwwww _ wwwwwww> + ___ (wwww.wwwww wwwww (wwww.wwww "wwwww" __ wwww.wwww "wwwwww")> + ___ wwww.wwwww wwwwwww (wwww.wwww "wwwww" __ wwww.wwww "wwwwww")> + ___ wwww.wwwww wwwww (wwww.wwww "wwwww" __ wwww.wwww "www w wwww"))> + ___ wwwwwwww> + (wwww.wwwwwwwwwww> + (wwww.wwwwwww "ww_wwww" __> + wwww.wwww "www"))> +> +wwww wwwwwwwwwwww> +> +wwww wwwwwww _> + "wwwww" __ wwwwwww "www" wwwww __ wwwwwwwwww "wwwwww" wwww> + __ wwwwwwwwww "wwwwww" wwwwwww> + __ wwwwww wwwwwwwwwwwww wwwwwwwww> + __ wwwwwwwwwww> + __ www w(wwww) (www wwwwwwwwww)> + ____ "wwwww" __ wwwwwww w(wwww) wwwwwww> + __ wwwwww wwwwwwwwwwwww wwwwwwwww> + __ wwwwwwwwwwwww> + __ wwww w(wwww) (www wwwwwwww)> +> +wwwwwwww wwwwwwww wwwwwwwwwww wwwwwwwww> +wwwwwwww wwwwwwww wwwwwwww wwwwwwww wwww> +wwwwwwww wwwwwww wwwwwwww wwwwwwww wwwwww> +> +www _ ww> + www __ wwwwww __ www> + wwwww www _ w> + __ wwwwwwww wwww wwwwwwww www wwwwwww ww wwwwww> + __ www wwww w wwwwwwww wwwwww wwwww ww ww> + (_) _ w> +> +wwww _ w $wwwwwwww$ w>