branch: elpa/haskell-tng-mode
commit a5f779dc32fc7757f39c0af7af3735d552fc52a4
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@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
