[nongnu] elpa/haskell-tng-mode bd8f905 016/385: almost there, regions not being expanded

[ELPA Syncer]

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

    almost there, regions not being expanded
---
 haskell-tng-font-lock.el | 96 +++++++++++++++++++++++++++++-------------------
 1 file changed, 58 insertions(+), 38 deletions(-)

diff --git a/haskell-tng-font-lock.el b/haskell-tng-font-lock.el
index 8b48c34..ba22a19 100644
--- a/haskell-tng-font-lock.el
+++ b/haskell-tng-font-lock.el
@@ -80,7 +80,6 @@
          (+ (not (syntax comment-end)))
          (+ (syntax comment-end))))
   "Newline or line comment.")
-;; note that type matching must be bounded for inline occurences
 (defconst haskell-tng:type
   ;; TODO literal types and generic lists ... eek!
   (let ((typepart `(| (+ (any ?\( ?\)))
@@ -118,15 +117,10 @@
           (: symbol-start (char ?\\))))
       . 'haskell-tng:keyword)
 
-     ;; types (multi-line support would improve this)
-     ;; TODO bracketed types (when are these allowed)
-     (,(rx-to-string '(: (|
-                          (: line-start (+ space) "->")
-                          (: symbol-start "::" symbol-end))
-                         (+ space)
-                         (group (+? (not (syntax comment-start))))
-                         (| ?\; (syntax comment-start) line-end)))
-      (1 'haskell-tng:type keep))
+     ;; types
+     (,(rx-to-string '(: symbol-start "::" symbol-end)) .
+      (haskell-tng:explicit-type-paint
+       (backward-char 2) nil (0 'haskell-tng:type keep)))
      (,(rx-to-string `(: line-start "data" (+ space)
                          (group (| ,conid ,consym))))
       (1 'haskell-tng:type))
@@ -181,11 +175,24 @@
 (defvar haskell-tng:explicit-type-regex
   (rx-to-string `(: point "::" (* space) ,haskell-tng:type))
   "Cache of a regex internal to `haskell-tng:explicit-type'")
-(defun haskell-tng:explicit-type ()
+(defun haskell-tng:explicit-type (limit)
+  "Matches an explicit type at point, bounded by a closing paren."
+  (let ((end (min limit (or (haskell-tng:paren-close) limit))))
+    (re-search-forward haskell-tng:explicit-type-regex end t)))
+
+;; FIXME: this is for debugging only
+(defun haskell-tng:explicit-type-paint (limit)
   "Matches an explicit type at point, bounded by a closing paren."
-  (re-search-forward
-   haskell-tng:explicit-type-regex
-   (or (haskell-tng:paren-close) (point-max)) t))
+  (let ((end (min limit (or (haskell-tng:paren-close) limit))))
+    ;; FIXME: why do we sometimes get empty searches? Or without the backward 
2?
+    (message "explicit-type-paint in %s" (buffer-substring-no-properties 
(point) end))
+    (re-search-forward haskell-tng:explicit-type-regex end t)))
+
+;; FIXME FIXME FIXME: for interactive debugging
+(defun type ()
+  (interactive)
+  (let ((case-fold-search nil))
+    (haskell-tng:explicit-type (point-max))))
 
 (eval-when-compile
   ;; available inside font-lock-extend-region-functions procedures.
@@ -193,19 +200,24 @@
   (defvar font-lock-beg)
   (defvar font-lock-end))
 
-;; TODO optimise extend-parens-* to just module / import / types
+(defconst haskell-tng:non-import
+  ;; TODO: exclude more non-import/export characters. ideas: dots that aren't
+  ;; (..) or part of a symbolic import, symbolic operators that are not
+  ;; surrounded by parens.
+  (rx (| ?\" ?\\))
+  "Matches that should never exist in the parens of an import or export")
 (defun haskell-tng:extend-parens-open ()
   "For use in `font-lock-extend-region-functions'.
 Expand the region to include the opening parenthesis.
 The caller loops until everything is opened."
   (goto-char font-lock-beg)
   ;; TODO: exit early if in comment
-  ;; TODO: use a bounded search-backward to exclude non-package characters
   (when-let (open (nth 1 (syntax-ppss)))
     (goto-char open)
     (when (looking-at "(")
-      ;;(haskell-tng:debug-extend (point))
-      (setq font-lock-beg (point)))))
+      (unless (re-search-forward haskell-tng:non-import font-lock-beg t)
+        (haskell-tng:debug-extend open)
+        (setq font-lock-beg open)))))
 
 (defun haskell-tng:extend-parens-close ()
   "For use in `font-lock-extend-region-functions'.
@@ -213,10 +225,12 @@ Expand the region to include a closing parenthesis.
 The caller loops until everything is closed."
   (goto-char font-lock-end)
   ;; TODO: exit early if in comment
-  ;; TODO: use a bounded search-forward to exclude non-package characters
   (when-let (close (haskell-tng:paren-close))
-    ;;(haskell-tng:debug-extend (point))
-    (setq font-lock-end (+ 1 close))))
+    (let ((end (+ 1 close)))
+      (goto-char end)
+      (unless (re-search-backward haskell-tng:non-import font-lock-end t)
+        (haskell-tng:debug-extend end)
+        (setq font-lock-end end)))))
 
 (defun haskell-tng:paren-close ()
   "Return the position of the next `)', if it closes the current paren depth."
@@ -227,41 +241,47 @@ The caller loops until everything is closed."
       (when (looking-at ")")
         (point)))))
 
+(setq
+ haskell-tng:beg-type
+ ;; TODO: more restrictive search, do not scan past non-type constructs
+ (rx symbol-start "::" symbol-end))
 (defun haskell-tng:extend-type-open ()
   "For use in `font-lock-extend-region-functions'.
 Ensures that multiline type signatures are opened."
   (goto-char font-lock-beg)
   ;; TODO: exit early if in comment
-  (when (re-search-backward
-         ;; TODO: replace \ with a larger list of non-type chars
-         (rx symbol-start "::" symbol-end (*? (not (any ?\\))) point)
-         (point-min) t)
+  ;; TODO: maximum lookback for a type
+  (when (re-search-backward haskell-tng:beg-type (point-min) t)
     (let ((beg (match-beginning 0)))
       (when (< beg font-lock-beg)
         (goto-char beg)
+        (message "checking for types at %s" (buffer-substring-no-properties 
beg (+ beg 10)))
         ;; validate that it's actually a type
-        (haskell-tng:explicit-type) ;; is this needed if we trust the 
non-lambda backscan?
-        (when (< font-lock-beg (point))
+        (haskell-tng:explicit-type (point-max)) ;; is this needed if we trust 
the non-lambda backscan?
+        (message "found one %s from %s to %s in (%s, %s) "
+                 (match-string 0)
+                 (match-beginning 0) (match-end 0)
+                 font-lock-beg font-lock-end)
+        (when (<= font-lock-beg (match-end 0))
+          ;; FIXME FIXME FIXME this is never triggering, is the 
re-search-backward going too far back?
           (haskell-tng:debug-extend beg)
-          (setq font-lock-beg beg)))))
-  nil)
+          (setq font-lock-beg beg)
+          nil)))))
 
 (defun haskell-tng:extend-type-close ()
   "For use in `font-lock-extend-region-functions'.
 Ensures that multiline type signatures are closed."
   (goto-char font-lock-end)
   ;; TODO: exit early if in comment
-  (when (re-search-backward
-         ;; TODO: replace \ with a larger list of non-type chars
-         (rx symbol-start "::" symbol-end (*? (not (any ?\\))) point)
-         font-lock-beg t)
+  (when (re-search-backward haskell-tng:beg-type font-lock-beg t)
     (let ((beg (match-beginning 0)))
       (goto-char beg)
-      (haskell-tng:explicit-type)
-      (when (< font-lock-end (point))
-        (haskell-tng:debug-extend (point))
-        (setq font-lock-beg (point)))))
-  nil)
+      (haskell-tng:explicit-type (point-max))
+      (let ((end (match-end 0)))
+        (when (< font-lock-end end)
+          (haskell-tng:debug-extend end)
+          (setq font-lock-beg end)
+          nil)))))
 
 (defun haskell-tng:extend-module-open ()
   "For use in `font-lock-extend-region-functions'.