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