[nongnu] elpa/haskell-tng-mode 7bc3218 010/385: extend types in parens

[ELPA Syncer]

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

    extend types in parens
---
 README.md                |  2 +-
 haskell-tng-font-lock.el | 56 +++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 47 insertions(+), 11 deletions(-)

diff --git a/README.md b/README.md
index 7a96e7c..36cfd4f 100644
--- a/README.md
+++ b/README.md
@@ -10,7 +10,7 @@ Meanwhile, the GNU Emacs ecosystem has evolved to provide 
many features that `ha
 
 ## Approach
 
-The goal of this friendly fork is to produce software that any Haskell 
developer can use, understand and build upon ([Emacs 
Lisp](https://www.gnu.org/software/emacs/manual/elisp.html) is fun to learn).
+The goal of this friendly rewrite is to produce software that any Haskell 
developer can use, understand and build upon ([Emacs 
Lisp](https://www.gnu.org/software/emacs/manual/elisp.html) is fun to learn).
 
 This can be achieved by preferring a simple and small codebase targeting 
[Haskell2010](https://www.haskell.org/onlinereport/haskell2010/), with 
automated tests for every feature.
 
diff --git a/haskell-tng-font-lock.el b/haskell-tng-font-lock.el
index bb8f897..ab95f9f 100644
--- a/haskell-tng-font-lock.el
+++ b/haskell-tng-font-lock.el
@@ -18,6 +18,8 @@
 ;;
 ;;; Code:
 
+(require 'subr-x)
+
 (defgroup haskell-tng:faces nil
   "Haskell font faces."
   :group 'haskell-tng)
@@ -159,32 +161,66 @@
 ;; TODO: consider previous/next symbol instead of whole line detection in
 ;; font-lock-extend-region-functions for super duper hyper perf.
 
+(eval-when-compile
+  (defvar font-lock-beg)
+  (defvar font-lock-end))
+
 (defun haskell-tng:multiline-faces ()
   "For use in `font-lock-extend-region-functions'.
 
 Detects multiline patterns, such as multiline `module', `import'
 and type signatures, setting `font-lock-beg' / `font-lock-end'
 appropriately, returning nil."
-  (defvar font-lock-beg)
-  (defvar font-log-end)
   (save-excursion
-    (goto-char font-lock-beg)
-
-    ;; TODO: detect :: and extend forwards as necessary
-    ;; TODO: detect -> and check if it's a type, then extend both ways
+    ;; TODO break this logic into multiple deffuns so we can use the replay
+    ;; logic as intended.
+    (goto-char font-lock-end)
+    (let ((detect-type (rx (| (: symbol-start "::" symbol-end)
+                              (: line-start (+ space) "->" symbol-end)))))
+      (when (re-search-backward detect-type font-lock-beg t)
+       ;; we're in the middle of a type signature. Close any dangling parens or
+       ;; scan until we see a line that doesn't start with ->
+        (if-let (close (haskell-tng:closing-paren))
+            (when (< font-lock-end close)
+              (haskell-tng:debug-extend close)
+              (setq font-lock-end close))
+          ;; TODO scan forward
+          nil)))
+
+    ;; TODO: detect -> and move to the start of the type (unless its a lambda)
     ;; TODO: detect module / import and check if its multiline
-    )
-  nil)
+    ;; TODO: detect unbalanced parens and scan back for import
+    ))
+
+(defun haskell-tng:debug-extend (to)
+  (message "extending `%s' to `%s'!"
+           (buffer-substring-no-properties font-lock-beg font-lock-end)
+           (buffer-substring-no-properties font-lock-end to)))
+
+;; TODO: this feels like something that would be in the stdlib...
+(defun haskell-tng:closing-paren ()
+  "If point is in an unbalanced parenthesis return the point that
+closes it, otherwise nil."
+  (let* ((scan (syntax-ppss))
+         (open (nth 1 scan)))
+    (when open
+      (save-excursion
+        (goto-char open)
+        (when (looking-at "(")
+          (ignore-errors
+            (forward-list)
+            (backward-char)
+            (point)))))))
 
 (defun haskell-tng:mark-block ()
   ;; TODO: this is kinda obscure, replace with mark-defun when it is defined
   "For use as `font-lock-mark-block-function'."
   (let ((toplevel (rx-to-string haskell-tng:toplevel)))
     (right-char)
-    (re-search-forward toplevel (point-max) 'max)
+    (re-search-forward toplevel (point-max) 'limit)
     (move-beginning-of-line nil)
     (set-mark (point))
-    (re-search-forward toplevel (point-min) 'min -1)))
+    (re-search-backward toplevel (point-min) 'limit)))
 
 (provide 'haskell-tng-font-lock)
 ;;; haskell-tng-font-lock.el ends here