[nongnu] elpa/haskell-tng-mode 4d6bbfc 050/385: feedback from Stefan, improving lexing

[ELPA Syncer]

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

    feedback from Stefan, improving lexing
---
 haskell-tng-mode.el           | 11 ++++---
 haskell-tng-smie.el           |  4 +--
 haskell-tng-syntax.el         |  6 ++++
 test/faces/medley.hs.lexer    | 75 ++++++++++---------------------------------
 test/haskell-tng-smie-test.el | 67 +++++++++++++++++++++-----------------
 5 files changed, 67 insertions(+), 96 deletions(-)

diff --git a/haskell-tng-mode.el b/haskell-tng-mode.el
index 23a14b5..3dab3ad 100644
--- a/haskell-tng-mode.el
+++ b/haskell-tng-mode.el
@@ -20,6 +20,10 @@
 (require 'haskell-tng-font-lock)
 (require 'haskell-tng-smie)
 
+(defgroup haskell-tng ()
+  "Haskell support: The Next Generation."
+  :group 'languages)
+
 ;;;###autoload
 (define-derived-mode haskell-tng-mode prog-mode "Hask"
   "Major mode for editing Haskell programs."
@@ -35,6 +39,7 @@
   ;;
   ;; TODO mark-defun / font-lock-mark-block-function
 
+  ;; TODO use setq-local (write a macro to allow multiple parameters)
   (setq
    ;; TAB is evil
    indent-tabs-mode nil
@@ -57,11 +62,7 @@
 
   (haskell-tng-smie:setup))
 
-(defcustom haskell-tng-mode-hook nil
-  "List of functions to run after `haskell-tng-mode' is enabled."
-  :group 'haskell-tng
-  :type 'hook)
-
+;; TODO: autoload this when I'm ready to use tng instead of regular
 (progn
   (add-to-list 'auto-mode-alist '("\\.hs\\'" . haskell-tng-mode))
   (modify-coding-system-alist 'file "\\.hs\\'" 'utf-8))
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 4e170df..95db8f8 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -46,9 +46,7 @@
        ;; TODO detect newlines with significant whitespace
 
        ;; parens
-       ((or (= syntax ?\() (= syntax ?\))) nil)
-
-       ;; TODO match paired delimiters
+       ((member syntax '(?\( ?\) ?\" ?$)) nil)
 
        ;; regexps
        ((or
diff --git a/haskell-tng-syntax.el b/haskell-tng-syntax.el
index 48b073f..bc8f685 100644
--- a/haskell-tng-syntax.el
+++ b/haskell-tng-syntax.el
@@ -38,6 +38,7 @@
     (--each (string-to-list "!#$%&*+./<=>?@\\^|-~:")
       (modify-syntax-entry it "_" table))
 
+    ;; FIXME: should be iff _ is alone or first char
     ;; small (underscore is a lowercase letter)
     (modify-syntax-entry ?_ "w" table)
 
@@ -73,6 +74,9 @@
   (haskell-tng:syntax:char-delims start end)
   (haskell-tng:syntax:escapes start end))
 
+;; TODO doesn't handle the following correctly
+;;
+;;   foo' 'a' 2
 (defun haskell-tng:syntax:char-delims (start end)
   "Matching apostrophes are string delimiters (literal chars)."
   (goto-char start)
@@ -90,5 +94,7 @@
       (put-text-property (- (point) 1) (point)
                          'syntax-table '(9 . ?\\)))))
 
+;; EXT:ExplicitForAll should turn dots into punctuation
+
 (provide 'haskell-tng-syntax)
 ;;; haskell-tng-syntax.el ends here
diff --git a/test/faces/medley.hs.lexer b/test/faces/medley.hs.lexer
index 598e8a4..7d06f84 100644
--- a/test/faces/medley.hs.lexer
+++ b/test/faces/medley.hs.lexer
@@ -193,25 +193,12 @@ proc
 ,
 waitForProcess
 SYNTAX_)
-SYNTAX_'
-c
-SYNTAX_'
-SYNTAX_'
-SYNTAX_\
-n
-SYNTAX_'
-SYNTAX_'
-SYNTAX_\
-'
-SYNTAX_'
+SYNTAX_'c'
+SYNTAX_'\n'
+SYNTAX_'\''
 foo
 =
-"
-wobble
-SYNTAX_(
-wibble
-SYNTAX_)
-"
+SYNTAX_"wobble (wibble)"
 class
 Get
 a
@@ -502,44 +489,30 @@ Opts.flag'
 Alloc
 SYNTAX_(
 Opts.long
-"
-alloc
-"
+SYNTAX_"alloc"
 <>
 Opts.help
-"
-wibble
-"
+SYNTAX_"wibble"
 SYNTAX_)
 <|>
 Opts.flag'
 Entries
 SYNTAX_(
 Opts.long
-"
-entry
-"
+SYNTAX_"entry"
 <>
 Opts.help
-"
-wobble
-"
+SYNTAX_"wobble"
 SYNTAX_)
 <|>
 Opts.flag'
 Bytes
 SYNTAX_(
 Opts.long
-"
-bytes
-"
+SYNTAX_"bytes"
 <>
 Opts.help
-"
-i'm
-a
-fish
-"
+SYNTAX_"i'm a fish"
 SYNTAX_)
 SYNTAX_)
 <*>
@@ -548,14 +521,10 @@ SYNTAX_(
 Opts.strArgument
 SYNTAX_(
 Opts.metavar
-"
-MY-FILE
-"
+SYNTAX_"MY-FILE"
 <>
 Opts.help
-"
-meh
-"
+SYNTAX_"meh"
 SYNTAX_)
 SYNTAX_)
 type
@@ -563,26 +532,18 @@ PhantomThing
 type
 SomeApi
 =
-"
-thing
-"
+SYNTAX_"thing"
 :>
 Capture
-"
-bar
-"
+SYNTAX_"bar"
 Index
 :>
 QueryParam
-"
-wibble
-"
+SYNTAX_"wibble"
 Text
 :>
 QueryParam
-"
-wobble
-"
+SYNTAX_"wobble"
 Natural
 :>
 Header
@@ -601,9 +562,7 @@ The
 ReadResult
 SYNTAX_)
 :<|>
-"
-thing
-"
+SYNTAX_"thing"
 :>
 ReqBody
 '
diff --git a/test/haskell-tng-smie-test.el b/test/haskell-tng-smie-test.el
index 649333c..5a5e851 100644
--- a/test/haskell-tng-smie-test.el
+++ b/test/haskell-tng-smie-test.el
@@ -14,27 +14,37 @@
        (file-name-directory load-file-name)
      default-directory)))
 
-(defvar smie-forward-token-function)
-;; TODO make this behave consistently interactive / non-interactive
-;; (maybe wrap it)
-(defun haskell-tng-smie:forward-token-to-buffer ()
-  "Forward lex the current buffer using SMIE lexer and dump to a buffer."
-  (interactive)
-  (let* ((buf (current-buffer))
-         (work (generate-new-buffer (buffer-name))))
+(defun haskell-tng-smie:forward-tokens (&optional display)
+  "Forward lex the current buffer using SMIE lexer and return the list of 
tokens.
+
+When called interactively, shows the tokens in a buffer."
+  (interactive '(t))
+  (defvar smie-forward-token-function)
+  (let* ((tokens '()))
     (goto-char (point-min))
     (while (not (eobp))
       (let* ((start (point))
-             (token (apply smie-forward-token-function ())))
-        (when (and (= (point) start) (not token))
-          (setq token (concat "SYNTAX_" (char-to-string (char-after (point)))))
-          (forward-char))
-        (when (s-present? token)
-          (with-current-buffer work
-            (insert token "\n")))))
-    (if (called-interactively-p 'interactive)
-      (switch-to-buffer work)
-      work)))
+             (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 "SYNTAX_" token)))
+        (unless (member token '(nil ""))
+          (push token tokens))))
+    (if display
+        (haskell-tng-smie:display-tokens tokens)
+      (nreverse tokens))))
+
+(defun haskell-tng-smie:tokens-to-string (tokens)
+  (concat (mapconcat #'identity tokens "\n") "\n"))
+
+(defun haskell-tng-smie:display-tokens (tokens)
+  (with-current-buffer (get-buffer-create "*Haskell-TNG-SMIE-test*")
+    (insert (haskell-tng-smie:tokens-to-string tokens))
+    (pop-to-buffer (current-buffer))))
 
 (defun have-expected-forward-lex (file)
   (let* ((backup-inhibited t)
@@ -46,20 +56,17 @@
                      (insert-file-contents golden)
                      (buffer-string)))
          (lexed (with-temp-buffer
+                  (insert-file-contents filename)
                   ;; TODO load this buffer correctly, to id the mode
                   (haskell-tng-mode)
-                  (insert-file-contents filename)
-                  (haskell-tng-smie:forward-token-to-buffer)))
-         (got (with-current-buffer lexed (buffer-string))))
-    (unwind-protect
-        (or (s-equals? got expected)
-            ;; TODO make this a parameter
-            ;; writes out the new version on failure
-            (progn
-              (with-current-buffer lexed
-                (write-file golden))
-              nil))
-      (kill-buffer lexed))))
+                  (haskell-tng-smie:forward-tokens)))
+         (got (haskell-tng-smie:tokens-to-string lexed)))
+    (or (equal got expected)
+        ;; TODO make this a parameter
+        ;; writes out the new version on failure
+        (progn
+          (write-region got nil golden)
+          nil))))
 
 ;; TODO the backwards test should simply assert consistency