[nongnu] elpa/haskell-tng-mode d33d146 060/385: [ci skip] start to refactor layout out of lexer

[ELPA Syncer]

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

    [ci skip] start to refactor layout out of lexer
---
 haskell-tng-layout.el           | 98 +++++++++++++++++++++++++++++++++++++++++
 haskell-tng-smie.el             | 25 +----------
 test/haskell-tng-layout-test.el | 19 ++++++++
 3 files changed, 118 insertions(+), 24 deletions(-)

diff --git a/haskell-tng-layout.el b/haskell-tng-layout.el
new file mode 100644
index 0000000..f3cf56e
--- /dev/null
+++ b/haskell-tng-layout.el
@@ -0,0 +1,98 @@
+;;; haskell-tng-layout.el --- Significant Whitespace of Haskell -*- 
lexical-binding: t -*-
+
+;; Copyright (C) 2019 Tseen She
+;; License: GPL 3 or any later version
+
+;;; Commentary:
+;;
+;;  Calculates "layout" according to Haskell2010 sections 2.7 and 10.3:
+;;
+;;  https://www.haskell.org/onlinereport/haskell2010/haskellch2.html
+;;  https://www.haskell.org/onlinereport/haskell2010/haskellch10.html
+;;
+;;  This algorithm must expose a stateless API so that stateless lexing is
+;;  possible (see SMIE). However, as the layout is queried for every token
+;;  during lexing, this must also be very efficient. Therefore, caching is used
+;;  internally.
+;;
+;;; Code:
+
+;; Notes on caching
+;;
+;; The easiest cache is to parse the entire buffer, invalidated on any change.
+;;
+;; A more efficient cache would store a record of the region that has been
+;; edited and reparse only the layouts that have changed. The invalidation may
+;; be a simple case of dismissing everything (including CLOSE parts) after any
+;; point that has been edited or trying to track insertions.
+;;
+;; Galaxy brain caching would use properties and put dirty markers on inserted
+;; or deleted regions. Also this could give lightning fast lookup at point on
+;; cache hits.
+
+(require 'haskell-tng-util)
+
+;; Easiest cache... full buffer parse with full invalidation on any insertion.
+(defvar-local haskell-tng-layout:cache nil)
+
+;; TODO invalidate the cache on change
+
+(defun haskell-tng-layout:virtuals-at-point (&optional pos)
+  "List of virtual `{' `}' and `;' at point, according to the
+Haskell2010 Layout rules.
+
+Designed to be called repeatedly, managing its own caching."
+  (unless haskell-tng-layout:cache
+    (haskell-tng-layout:rebuild-cache-full))
+
+  ;; FIXME lookup in cache
+  )
+
+(defun haskell-tng-layout:rebuild-cache-full ()
+  (let (case-fold-search
+        cache)
+    (save-excursion
+      (goto-char 0)
+      (while (not (eobp))
+        (when-let (wldo (haskell-tng-layout:next-wldo))
+          (push haskell-tng-layout:cache cache))))
+    (setq haskell-tng-layout:cache (reverse cache))))
+
+(defun haskell-tng-layout:next-wldo ()
+  (catch 'wldo
+    (while (not (eobp))
+      (forward-comment (point-max))
+      (cond
+       ((looking-at (rx word-start (| "where" "let" "do" "of") word-end))
+        (goto-char (match-end 0))
+        (forward-comment (point-max))
+        (when (not (looking-at "{"))
+          (throw 'wldo (haskell-tng-layout:wldo))))
+
+       (t (skip-syntax-forward "^-"))))))
+
+(defun haskell-tng-layout:wldo ()
+  "A list holding virtual `{', then `}', then virtual `;' in order.
+
+Assumes that point is at the beginning of the first token after a
+WLDO that is using the offside rule."
+  (save-excursion
+    (let* ((open (point))
+           seps
+           (level (current-column))
+           (limit (or (haskell-tng:paren-close) (point-max)))
+           (close (catch 'closed
+                    (while (not (eobp))
+                      (forward-line)
+                      (forward-comment (point-max))
+                      (when (= (current-column) level)
+                        (push (point) seps))
+                      (when (< limit (point))
+                        (throw 'closed limit))
+                      (when (< (current-column) level)
+                        (throw 'closed (point))))
+                    (point-max))))
+      `(,open . (,close . ,(reverse seps))))))
+
+(provide 'haskell-tng-layout)
+;;; haskell-tng-layout.el ends here
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 61b30b2..3bf4d76 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -29,9 +29,7 @@
 (require 'smie)
 (require 'haskell-tng-font-lock)
 
-;; FIXME: massive hack. Holds an ordered list of (position . level) that close
-;; an inferred layout block. Convert into a (cached) function call to calculate
-;; the relevant WLDOs for a given point.
+;; FIXME: this is all broken, use haskell-tng-layout
 (defvar-local haskell-tng-smie:wldos nil)
 
 ;; State: a list of tokens to return at the current point ending with `t' as an
@@ -113,27 +111,6 @@
           (forward-char)
           (string (char-before)))))))))
 
-(defun haskell-tng:layout-of-next-token ()
-  (save-excursion
-    (forward-comment (point-max))
-    (current-column)))
-
-(defun haskell-tng:layout-close-and-level (&optional pos)
-  "A cons cell of the closing point for the layout beginning at POS, and 
level."
-  (save-excursion
-    (goto-char (or pos (point)))
-    (let ((level (current-column))
-          (close (or (haskell-tng:paren-close) (point-max))))
-      (catch 'closed
-        (while (not (eobp))
-          (forward-line)
-          (forward-comment (point-max))
-          (when (< close (point))
-            (throw 'closed (cons close level)))
-          (when (< (current-column) level)
-            (throw 'closed (cons (point) level))))
-        (cons (point-max) level)))))
-
 (defun haskell-tng-smie:last-match ()
   (goto-char (match-end 0))
   (match-string-no-properties 0))
diff --git a/test/haskell-tng-layout-test.el b/test/haskell-tng-layout-test.el
new file mode 100644
index 0000000..f29fff6
--- /dev/null
+++ b/test/haskell-tng-layout-test.el
@@ -0,0 +1,19 @@
+;;; haskell-tng-layout-test.el --- Tests for significant whitespace -*- 
lexical-binding: t -*-
+
+;; Copyright (C) 2018-2019 Tseen She
+;; License: GPL 3 or any later version
+
+(require 'haskell-tng-mode)
+
+(require 'dash)
+(require 'ert)
+(require 's)
+
+;; FIXME a testing framework for layout
+
+;; (ert-deftest haskell-tng-layout-file-tests ()
+;;   (should (have-expected-forward-lex "src/medley.hs"))
+;;   (should (have-expected-forward-lex "src/layout.hs"))
+;;   )
+
+;;; haskell-tng-layout-test.el ends here