[nongnu] elpa/haskell-tng-mode a5f779d 047/385: initial SMIE tests

[ELPA Syncer]

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

    initial SMIE tests
---
 haskell-tng-font-lock.el      |   2 +-
 haskell-tng-mode.el           |   5 +-
 haskell-tng-smie.el           |  87 +++--
 test/faces/medley.hs.forward  | 736 ++++++++++++++++++++++++++++++++++++++++++
 test/haskell-tng-smie-test.el |  69 ++--
 5 files changed, 856 insertions(+), 43 deletions(-)

diff --git a/haskell-tng-font-lock.el b/haskell-tng-font-lock.el
index d3ca587..d4daea4 100644
--- a/haskell-tng-font-lock.el
+++ b/haskell-tng-font-lock.el
@@ -87,7 +87,7 @@
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Here is the `font-lock-keywords' table of matchers and highlighters.
-(setq
+(defvar
  haskell-tng:keywords
  ;; These regexps use the `rx' library so we can reuse common subpatterns. It
  ;; also increases the readability of the code and, in many cases, allows us to
diff --git a/haskell-tng-mode.el b/haskell-tng-mode.el
index 275eb1c..23a14b5 100644
--- a/haskell-tng-mode.el
+++ b/haskell-tng-mode.el
@@ -15,8 +15,10 @@
 ;;; Code:
 
 (require 'dabbrev)
+
 (require 'haskell-tng-syntax)
 (require 'haskell-tng-font-lock)
+(require 'haskell-tng-smie)
 
 ;;;###autoload
 (define-derived-mode haskell-tng-mode prog-mode "Hask"
@@ -52,7 +54,8 @@
 
    ;; whitespace is meaningful, no electric indentation
    electric-indent-inhibit t)
-  )
+
+  (haskell-tng-smie:setup))
 
 (defcustom haskell-tng-mode-hook nil
   "List of functions to run after `haskell-tng-mode' is enabled."
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 436b17a..c08b252 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -8,34 +8,77 @@
 ;;  SMIE lexer, precedence table (providing s-expression navigation), and
 ;;  indentation rules.
 ;;
+;;  Note that we don't need to support every aspect of the Haskell language in
+;;  these grammar rules: only the parts that are relevant for the features that
+;;  are provided.
+;;
+;;  If we had access to all the operators in scope, and their fixity, we could
+;;  create file-specific precendences. However, the complexity-to-benefit 
payoff
+;;  is minimal.
+;;
+;;  Users may consult the SMIE manual to customise their indentation rules:
 ;;  https://www.gnu.org/software/emacs/manual/html_mono/elisp.html#SMIE
 ;;
 ;;; Code:
 
 (require 'smie)
 
-  ;; (defvar sample-keywords-regexp
-  ;;      (regexp-opt '("+" "*" "," ";" ">" ">=" "<" "<=" ":=" "=")))
-  ;;    (defun sample-smie-forward-token ()
-  ;;      (forward-comment (point-max))
-  ;;      (cond
-  ;;       ((looking-at sample-keywords-regexp)
-  ;;        (goto-char (match-end 0))
-  ;;        (match-string-no-properties 0))
-  ;;       (t (buffer-substring-no-properties
-  ;;           (point)
-  ;;           (progn (skip-syntax-forward "w_")
-  ;;                  (point))))))
-  ;;    (defun sample-smie-backward-token ()
-  ;;      (forward-comment (- (point)))
-  ;;      (cond
-  ;;       ((looking-back sample-keywords-regexp (- (point) 2) t)
-  ;;        (goto-char (match-beginning 0))
-  ;;        (match-string-no-properties 0))
-  ;;       (t (buffer-substring-no-properties
-  ;;           (point)
-  ;;           (progn (skip-syntax-backward "w_")
-  ;;                  (point))))))
+(defvar haskell-tng-smie:keywords
+  (regexp-opt '("+" "*" "=")))
+
+;; TODO custom Haskell lexer
+;; TODO convert significant whitespace to semicolons
+;;
+;; Function to scan forward for the next token.
+;; - Called with no argument should return a token and move to its end.
+;; - If no token is found, return nil or the empty string.
+;; - It can return nil when bumping into a parenthesis, which lets SMIE
+;; - use syntax-tables to handle them in efficient C code.
+;;
+;; https://www.gnu.org/software/emacs/manual/html_mono/elisp.html#SMIE-Lexer
+(defun haskell-tng-smie:forward-token ()
+  (interactive) ;; for testing
+  (forward-comment (point-max))
+  (cond
+   ((looking-at haskell-tng-smie:keywords)
+    (goto-char (match-end 0))
+    (match-string-no-properties 0))
+   (t (buffer-substring-no-properties
+       (point)
+       (progn (skip-syntax-forward "w_")
+              (point))))))
+
+;; TODO a haskell grammar
+;; https://www.gnu.org/software/emacs/manual/html_mono/elisp.html#SMIE-Grammar
+(defvar haskell-tng-smie:grammar
+  (smie-prec2->grammar
+   (smie-bnf->prec2
+    '((id)
+      (inst ("if" exp "then" inst "else" inst)
+            (id "<-" exp)
+            (id "=" exp)
+            (exp))
+      (insts (insts ";" insts) (inst))
+      (exp (exp "+" exp)
+           (exp "*" exp)
+           ("(" exps ")")
+           ("{" exps "}"))
+      (exps (exps "," exps) (exp)))
+    '((assoc ";"))
+    '((assoc ","))
+    '((assoc "+") (assoc "*")))))
+
+;; TODO indentation rules
+;; 
https://www.gnu.org/software/emacs/manual/html_mono/elisp.html#SMIE-Indentation
+(defvar haskell-tng-smie:rules nil)
+
+(defun haskell-tng-smie:setup ()
+  (smie-setup
+   haskell-tng-smie:grammar
+   haskell-tng-smie:rules
+   :forward-token #'haskell-tng-smie:forward-token
+   ;; TODO :backward-token #'haskell-tng-smie:backward-token
+   ))
 
 (provide 'haskell-tng-smie)
 ;;; haskell-tng-smie.el ends here
diff --git a/test/faces/medley.hs.forward b/test/faces/medley.hs.forward
new file mode 100644
index 0000000..e784f41
--- /dev/null
+++ b/test/faces/medley.hs.forward
@@ -0,0 +1,736 @@
+module
+Foo.Bar.Main
+
+(
+Wibble
+(
+..
+)
+,
+Wobble
+(
+Wobb
+,
+
+(
+!!!
+)
+)
+,
+Woo
+
+,
+getFooByBar
+,
+getWibbleByWobble
+
+,
+module
+Bloo.Foo
+
+)
+where
+import
+Control.Applicative
+
+(
+many
+,
+optional
+,
+pure
+,
+
+(
+<*>
+)
+,
+
+(
+<|>
+)
+)
+import
+Data.Foldable
+
+(
+traverse_
+)
+import
+Data.Functor
+
+(
+(
+<$>
+)
+)
+import
+Data.List
+
+(
+intercalate
+)
+import
+Data.Monoid
+
+(
+(
+<>
+)
+)
+import
+qualified
+Options.Monad
+import
+qualified
+Options.Applicative
+as
+Opts
+import
+qualified
+Options.Divisible
+as
+Div
+import
+qualified
+ProfFile.App
+hiding
+
+(
+as
+,
+hiding
+,
+qualified
+)
+import
+ProfFile.App
+
+(
+as
+,
+hiding
+,
+qualified
+)
+import
+ProfFile.App
+hiding
+
+(
+as
+,
+hiding
+,
+qualified
+)
+import
+qualified
+ProfFile.App
+
+(
+as
+,
+hiding
+,
+qualified
+)
+import
+System.Exit
+
+(
+ExitCode
+
+(
+..
+)
+,
+exitFailure
+,
+qualified
+,
+Typey
+,
+wibble
+,
+Wibble
+)
+import
+System.FilePath
+
+(
+replaceExtension
+,
+Foo
+(
+Bar
+,
+
+(
+:<
+)
+)
+import
+System.IO
+
+(
+IOMode
+
+(
+..
+)
+,
+hClose
+,
+hGetContents
+,
+hPutStr
+,
+hPutStrLn
+,
+openFile
+,
+stderr
+,
+stdout
+,
+MoarTypey
+)
+import
+System.Process
+
+(
+CreateProcess
+
+(
+..
+)
+,
+StdStream
+
+(
+..
+)
+,
+createProcess
+,
+proc
+,
+waitForProcess
+)
+
+'
+c
+'
+
+'
+\
+n
+'
+
+'
+\
+'
+'
+foo
+=
+
+"
+wobble
+
+(
+wibble
+)
+"
+class
+Get
+a
+s
+where
+get
+::
+Set
+s
+->
+a
+instance
+Get
+a
+
+(
+a
+':
+s
+)
+where
+get
+
+(
+Ext
+a
+_
+)
+=
+a
+instance
+Get
+a
+s
+=
+>
+Get
+a
+
+(
+b
+':
+s
+)
+where
+get
+
+(
+Ext
+_
+xs
+)
+=
+get
+xs
+data
+Options
+=
+Options
+
+{
+optionsReportType
+::
+ReportType
+
+,
+optionsProfFile
+::
+Maybe
+FilePath
+
+,
+optionsOutputFile
+::
+Maybe
+FilePath
+
+,
+optionsFlamegraphFlags
+::
+
+[
+String
+]
+
+}
+deriving
+
+(
+Eq
+,
+Show
+)
+class
+
+(
+Eq
+a
+)
+=
+>
+Ord
+a
+where
+
+(
+<
+)
+,
+
+(
+<=
+)
+,
+
+(
+>=
+)
+,
+
+(
+>
+)
+::
+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
+)
+_
+=
+=
+_
+=
+False
+data
+ReportType
+=
+Alloc
+|
+Entries
+|
+Time
+|
+Ticks
+|
+Bytes
+deriving
+
+(
+Eq
+,
+Show
+)
+type
+family
+G
+a
+where
+G
+Int
+=
+Bool
+G
+a
+=
+Char
+data
+Flobble
+=
+Flobble
+deriving
+
+(
+Eq
+)
+via
+
+(
+NonNegative
+
+(
+Large
+Int
+)
+)
+deriving
+stock
+
+(
+Floo
+)
+deriving
+anyclass
+
+(
+WibblyWoo
+,
+OtherlyWoo
+)
+newtype
+Flobby
+=
+Flobby
+foo
+::
+Wibble
+->
+Wobble
+->
+Wobble
+->
+Wobble
+->
+
+(
+wob
+::
+Wobble
+)
+->
+
+(
+Wobble
+a
+b
+c
+)
+
+(
+foo
+::
+
+(
+Wibble
+Wobble
+)
+)
+foo
+newtype
+TestApp
+
+(
+logger
+::
+TestLogger
+)
+
+(
+scribe
+::
+TestScribe
+)
+config
+a
+=
+TestApp
+a
+optionsParser
+::
+Opts.Parser
+Options
+optionsParser
+=
+Options
+<$>
+
+(
+Opts.flag'
+Alloc
+
+(
+Opts.long
+
+"
+alloc
+"
+<>
+Opts.help
+
+"
+wibble
+"
+)
+<|>
+Opts.flag'
+Entries
+
+(
+Opts.long
+
+"
+entry
+"
+<>
+Opts.help
+
+"
+wobble
+"
+)
+<|>
+Opts.flag'
+Bytes
+
+(
+Opts.long
+
+"
+bytes
+"
+<>
+Opts.help
+
+"
+i'm
+a
+fish
+"
+)
+)
+<*>
+optional
+
+(
+Opts.strArgument
+
+(
+Opts.metavar
+
+"
+MY-FILE
+"
+<>
+Opts.help
+
+"
+meh
+"
+)
+)
+type
+PhantomThing
+type
+SomeApi
+=
+
+"
+thing
+"
+:>
+Capture
+
+"
+bar
+"
+Index
+:>
+QueryParam
+
+"
+wibble
+"
+Text
+:>
+QueryParam
+
+"
+wobble
+"
+Natural
+:>
+Header
+TracingHeader
+TracingId
+:>
+ThingHeader
+:>
+Get
+'
+[
+JSON
+]
+
+(
+The
+ReadResult
+)
+:<|>
+
+"
+thing
+"
+:>
+ReqBody
+'
+[
+JSON
+]
+Request
+:>
+Header
+TracingHeader
+TracingId
+:>
+SpecialHeader
+:>
+Post
+'
+[
+JSON
+]
+
+(
+The
+Response
+)
+deriving
+instance
+FromJSONKey
+StateName
+deriving
+anyclass
+instance
+FromJSON
+Base
+deriving
+newtype
+instance
+FromJSON
+Treble
+
diff --git a/test/haskell-tng-smie-test.el b/test/haskell-tng-smie-test.el
index 2905484..f5253f6 100644
--- a/test/haskell-tng-smie-test.el
+++ b/test/haskell-tng-smie-test.el
@@ -6,32 +6,63 @@
 (require 'haskell-tng-mode)
 
 (require 'ert)
-(require 'faceup)
+(require 's)
 
-(defun haskell-tng-smie:lex-forward-buffer ()
+(defmacro haskell-tng-smie:this-lisp-directory ()
+  (expand-file-name
+   (if load-file-name
+       (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 (switch-to-buffer (concat (buffer-file-name) 
".lexer.forward"))))
-    (switch-to-buffer buf)
+         (work (generate-new-buffer (buffer-name))))
     (goto-char (point-min))
+    (while (not (eobp))
+      (let* ((start (point))
+             (token (apply smie-forward-token-function ())))
+        (when (= (point) start)
+          (unless (or (s-present? token) (eobp))
+            (setq token (char-to-string (char-after (point)))))
+          (forward-char))
+        (with-current-buffer work
+          (insert token "\n"))))
+    (if (called-interactively-p 'interactive)
+      (switch-to-buffer work)
+      work)))
 
-    ;; FIXME progress through the buf writing the returned values to work
-    ;; maybe with a character to indicate invocations, maybe newlines.
-
-    ))
-
-(defun have-expected-forward-lexer (file)
-  (let* ((filename (expand-file-name
+(defun have-expected-forward-lex (file)
+  (let* ((backup-inhibited t)
+         (filename (expand-file-name
                     file
-                    (eval-when-compile (faceup-this-file-directory))))
-         (golden (concat filename ".lexer.forward")))
-
-    ;; FIXME run the lex-forward-buffer and compare the result with the version
-    ;; on disk, perhaps a trimmed diff.
-
-    ))
+                    (haskell-tng-smie:this-lisp-directory)))
+         (golden (concat filename ".forward"))
+         (expected (with-temp-buffer
+                     (insert-file-contents golden)
+                     (buffer-string)))
+         (lexed (with-temp-buffer
+                  ;; 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))))
 
 (ert-deftest haskell-tng-smie-file-tests ()
-  (should (have-expected-forward-lexer "faces/medley.hs")))
+  (should (have-expected-forward-lex "faces/medley.hs")))
 
 ;; ideas for an indentation tester
 ;; 
https://github.com/elixir-editors/emacs-elixir/blob/master/test/test-helper.el#L52-L63