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>
