[nongnu] elpa/haskell-tng-mode 97ce717 058/385: improve the testing

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit 97ce717758484e6c1a0519b5702824c65420e344
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@gmail.com>

    improve the testing
---
 haskell-tng-smie.el                | 20 +++++++++++++-------
 test/faces/medley.hs               |  6 ++++++
 test/faces/medley.hs.faceup        |  6 ++++++
 test/faces/medley.hs.lexer         | 12 +++++++++---
 test/haskell-tng-font-lock-test.el |  1 +
 test/haskell-tng-smie-test.el      | 28 +++++++++++++++++++---------
 6 files changed, 54 insertions(+), 19 deletions(-)

diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index ee080a3..a0c9722 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -64,7 +64,6 @@
    (t
     (let ((done-multi (pop haskell-tng-smie:multi))
           (case-fold-search nil)
-          (syntax (char-syntax (char-after)))
           (offside (car haskell-tng-smie:wldos)))
       (cl-flet ((virtual-end () (= (point) (car offside)))
                 (virtual-semicolon () (= (current-column) (cdr offside))))
@@ -84,8 +83,12 @@
                               ";" haskell-tng-smie:multi)))
           (pop haskell-tng-smie:multi))
 
-         ;; parens
-         ((member syntax '(?\( ?\) ?\" ?$)) nil)
+         ;; syntax tables (supported by `smie-indent-forward-token')
+         ((looking-at (rx (| (syntax open-parenthesis)
+                             (syntax close-parenthesis)
+                             (syntax string-quote)
+                             (syntax string-delimiter))))
+          nil)
 
          ;; layout detection
          ((looking-at (rx word-start (| "where" "let" "do" "of") word-end))
@@ -102,10 +105,13 @@
            ;; known identifiers
            (looking-at haskell-tng:regexp:reserved)
            ;; symbols
-           (looking-at (rx (+ (| (syntax word) (syntax symbol)))))
-           ;; whatever the current syntax class is
-           (looking-at (rx-to-string `(+ (syntax ,syntax)))))
-          (haskell-tng-smie:last-match))))))))
+           (looking-at (rx (+ (| (syntax word) (syntax symbol))))))
+          (haskell-tng-smie:last-match))
+
+         ;; single char
+         (t
+          (forward-char)
+          (string (char-before)))))))))
 
 (defun haskell-tng:layout-of-next-token ()
   (save-excursion
diff --git a/test/faces/medley.hs b/test/faces/medley.hs
index f182758..b314e8b 100644
--- a/test/faces/medley.hs
+++ b/test/faces/medley.hs
@@ -125,3 +125,9 @@ type SomeApi =
 deriving instance FromJSONKey StateName
 deriving anyclass instance FromJSON Base
 deriving newtype instance FromJSON Treble
+
+foo = bar
+  where baz = _
+  -- checking that comments are ignored in layout
+  -- and that a starting syntax entry is ok
+        (+) = _
diff --git a/test/faces/medley.hs.faceup b/test/faces/medley.hs.faceup
index 2f33e9a..3192eaa 100644
--- a/test/faces/medley.hs.faceup
+++ b/test/faces/medley.hs.faceup
@@ -125,3 +125,9 @@
 «:haskell-tng:keyword:deriving» «:haskell-tng:keyword:instance» 
«:haskell-tng:constructor:FromJSONKey» «:haskell-tng:constructor:StateName»
 «: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:keyword:where» baz «:haskell-tng:keyword:=» 
«:haskell-tng:keyword:_»
+  «x:-- checking that comments are ignored in layout
+»  «x:-- and that a starting syntax entry is ok
+»        «:haskell-tng:keyword:(»+«:haskell-tng:keyword:)» 
«:haskell-tng:keyword:=» «:haskell-tng:keyword:_»
diff --git a/test/faces/medley.hs.lexer b/test/faces/medley.hs.lexer
index 89748ba..a948522 100644
--- a/test/faces/medley.hs.lexer
+++ b/test/faces/medley.hs.lexer
@@ -55,12 +55,12 @@ _{ optionsReportType :: ReportType
 _} deriving _( Eq , Show _)
 
 ; class _( Eq a _) => Ord a where
-{ _; < _) , _( <= _) , _( >= _) , _( > _) :: a -> a -> Bool
+{ _( < _) , _( <= _) , _( >= _) , _( > _) :: a -> a -> Bool
 ; max @Foo , min :: a -> a -> a
 
 } ; instance _( Eq a _) => Eq _( Tree a _) where
 { Leaf a == Leaf b = a == b
-; _; Branch l1 r1 _) == _( Branch l2 r2 _) = _( l1==l2 _) && _( r1==r2 _)
+; _( Branch l1 r1 _) == _( Branch l2 r2 _) = _( l1==l2 _) && _( r1==r2 _)
 ; _ == _ = False
 
 } ; data ReportType = Alloc
@@ -90,7 +90,7 @@ Wibble
 -> _( Wobble
 a b c _)
 
-; _; foo :: _( Wibble Wobble _) _) foo
+; _( foo :: _( Wibble Wobble _) _) foo
 
 ; newtype TestApp
 _( logger :: TestLogger _)
@@ -125,4 +125,10 @@ _"thing" :> Capture _"bar" Index :> QueryParam _"wibble" 
Text
 ; deriving instance FromJSONKey StateName
 ; deriving anyclass instance FromJSON Base
 ; deriving newtype instance FromJSON Treble
+
+; foo = bar
+where { baz = _
+
+
+; _( + _) = _
 }
diff --git a/test/haskell-tng-font-lock-test.el 
b/test/haskell-tng-font-lock-test.el
index fe5c739..15157ee 100644
--- a/test/haskell-tng-font-lock-test.el
+++ b/test/haskell-tng-font-lock-test.el
@@ -16,6 +16,7 @@
     (eval-when-compile (faceup-this-file-directory)))))
 (faceup-defexplainer have-expected-faces)
 
+;; to generate .faceup files, use faceup-view-buffer
 (ert-deftest haskell-tng-font-lock-file-tests ()
   (should (have-expected-faces "faces/medley.hs")))
 
diff --git a/test/haskell-tng-smie-test.el b/test/haskell-tng-smie-test.el
index 82755b1..83e18ab 100644
--- a/test/haskell-tng-smie-test.el
+++ b/test/haskell-tng-smie-test.el
@@ -15,6 +15,23 @@
        (file-name-directory load-file-name)
      default-directory)))
 
+;; copy/pasta of `smie-indent-forward-token' but rendering lexed tokens in a 
way
+;; more ammenable to regression testing (e.g. syntax table usage)
+(defun haskell-tng-smie:indent-forward-token ()
+  (let ((tok (funcall smie-forward-token-function)))
+    (cond
+     ((< 0 (length tok)) tok)
+     ((looking-at (rx (| (syntax open-parenthesis)
+                         (syntax close-parenthesis))))
+      (concat "_" (haskell-tng-smie:last-match)))
+     ((looking-at (rx (| (syntax string-quote)
+                         (syntax string-delimiter))))
+      (let ((start (point)))
+        (forward-sexp 1)
+        (concat "_" (buffer-substring-no-properties start (point)))))
+     ((eobp) nil)
+     (t (error "Bumped into unknown token")))))
+
 (defun haskell-tng-smie:forward-tokens (&optional display)
   "Forward lex the current buffer using SMIE lexer and return the list of 
lines,
 where each line is a list of tokens.
@@ -26,19 +43,12 @@ When called interactively, shows the tokens in a buffer."
     (goto-char (point-min))
     (while (not (eobp))
       (let* ((start (point))
-             (token (funcall smie-forward-token-function)))
-        (when (and (not token) (= (point) start))
-          (setq token (car (smie-indent-forward-token)))
-          (when (= start (point)) (forward-char 1))
-          (unless token
-            (setq token (buffer-substring-no-properties start (point))))
-          ;; differentiate that these tokens come from the syntax table
-          (setq token (concat "_" token)))
+             (token (haskell-tng-smie:indent-forward-token)))
         (let ((line-diff (- (line-number-at-pos (point))
                             (line-number-at-pos start))))
           (unless (<= line-diff 0)
             (setq lines (append (-repeat line-diff nil) lines))))
-        (unless (member token '(nil ""))
+        (unless (s-blank? token)
           (push token (car lines)))))
     (let ((ordered (reverse (--map (reverse it) lines))))
       (if display