[nongnu] elpa/haskell-tng-mode c40c6e6 125/385: fix explicit export fontification bug

[ELPA Syncer]

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

    fix explicit export fontification bug
---
 haskell-tng-font-lock.el  | 30 ++++++++++++++++--------------
 haskell-tng-util.el       |  8 ++++++++
 test/src/layout.hs.faceup |  2 +-
 3 files changed, 25 insertions(+), 15 deletions(-)

diff --git a/haskell-tng-font-lock.el b/haskell-tng-font-lock.el
index ddc785c..45856b1 100644
--- a/haskell-tng-font-lock.el
+++ b/haskell-tng-font-lock.el
@@ -78,6 +78,7 @@
         ;;(qual haskell-tng:rx:qual)
         (consym haskell-tng:rx:consym)
         (toplevel haskell-tng:rx:toplevel)
+        (qual haskell-tng:rx:qual)
         (bigspace `(| space ,haskell-tng:rx:newline)))
     `(;; reservedid / reservedop
       (,haskell-tng:regexp:reserved
@@ -119,7 +120,7 @@
               (group (? word-start "qualified" word-end)) (* space)
               ;; EXT:PackageImports
               ;; EXT:Safe, EXT:Trustworthy, EXT:Unsafe
-              (group symbol-start (* ,conid ".") ,conid symbol-end) (* 
,bigspace)
+              (group word-start (* ,qual) ,conid word-end) (* ,bigspace)
               (group (? word-start "hiding" word-end)) (* space)))
         (haskell-tng:font:multiline:anchor-rewind) nil
         (1 'haskell-tng:keyword)
@@ -141,21 +142,18 @@
        ;; EXT:ExplicitNamespaces
        )
 
-      ;; FIXME module defn with explicit exports has wrong face (Constructor)
-      ;; for final part of the module name when the closing paren is the first
-      ;; character on the line.
       (haskell-tng:font:module:keyword
        (,(rx-to-string `(: word-start "module" word-end (+ space)
-                           (group symbol-start (* ,conid ".") ,conid 
symbol-end)))
+                           (group word-start (* ,qual) ,conid word-end)))
         (haskell-tng:font:multiline:anchor-rewind)
         (haskell-tng:font:multiline:anchor-rewind)
         (1 'haskell-tng:module))
        (haskell-tng:font:explicit-constructors
-        (haskell-tng:font:multiline:anchor-rewind 1)
+        (haskell-tng:font:multiline:anchor-rewind 2)
         (haskell-tng:font:multiline:anchor-rewind)
         (0 'haskell-tng:constructor keep))
        (,(rx-to-string `(: word-start ,conid word-end))
-        (haskell-tng:font:multiline:anchor-rewind 1)
+        (haskell-tng:font:multiline:anchor-rewind 2)
         (haskell-tng:font:multiline:anchor-rewind)
         (0 'haskell-tng:type keep)))
 
@@ -168,7 +166,9 @@
        . 'haskell-tng:toplevel)
 
       ;; uses of F.Q.N.s
-      (,(rx-to-string `(: symbol-start (+ (: ,conid "."))))
+      ;; TODO should perhaps be in a different font than module/import use, 
e.g.
+      ;; lighter not bolder.
+      (,(rx-to-string `(: symbol-start (+ ,qual)))
        . 'haskell-tng:module)
 
       ;; constructors
@@ -249,6 +249,9 @@ searched. This function is ideal for inclusion in the mode's
 
 The LIMITERS are function names that are called if the TRIGGER
 succeeds and may further restrict the FIND search limit."
+  ;; TODO allow limiters to be the function calls, or regexps, avoiding trivial
+  ;; functions (and refactor existing trivial functions into regexps). Taking a
+  ;; function name is kinda weird.
   (declare (indent defun))
   (let* ((sname (concat "haskell-tng:font:" (symbol-name name)))
          (regexp-1 (intern (concat sname ":trigger")))
@@ -321,13 +324,12 @@ succeeds and may further restrict the FIND search limit."
 
 (haskell-tng:font:multiline module
                             (rx line-start "module" word-end)
-                            ;; TODO would be a good idea to capture the FQN 
name
-                            ;; so that anchors can use END in the PRE-FORM to
-                            ;; avoid overfitting (e.g. explicit constructors
-                            ;; everywhere).
-                            (rx line-start "module" word-end (group (+ 
anything))
+                            (rx line-start "module" word-end
+                                (+ space)
+                                (group word-start (+ (not (any space))) 
word-end)
+                                (group (+ anything))
                                 word-start "where" word-end)
-                            haskell-tng:indent-close) ;; FIXME is the 
indent-close the culprit?
+                            haskell-tng:next-where)
 
 (provide 'haskell-tng-font-lock)
 ;;; haskell-tng-font-lock.el ends here
diff --git a/haskell-tng-util.el b/haskell-tng-util.el
index 1a449b9..5f464db 100644
--- a/haskell-tng-util.el
+++ b/haskell-tng-util.el
@@ -34,11 +34,19 @@
         nil))))
 
 (defun haskell-tng:do-bind (&optional pos)
+  ;; trivial, should just be called as an inline regexp
   "The next `<-'"
   (save-excursion
     (goto-char (or pos (point)))
     (re-search-forward "<-" nil t)))
 
+(defun haskell-tng:next-where (&optional pos)
+  ;; trivial, should just be called as an inline regexp
+  "The next `where'"
+  (save-excursion
+    (goto-char (or pos (point)))
+    (re-search-forward (rx word-start "where" word-end) nil t)))
+
 (defun haskell-tng:indent-close-previous ()
   "Indentation closing the previous symbol."
   (save-excursion
diff --git a/test/src/layout.hs.faceup b/test/src/layout.hs.faceup
index 1f56b22..d383603 100644
--- a/test/src/layout.hs.faceup
+++ b/test/src/layout.hs.faceup
@@ -1,5 +1,5 @@
 «m:-- »«x:Figure 2.1 from the Haskell2010 report
-»«:haskell-tng:keyword:module» 
«:haskell-tng:module:AStack»«:haskell-tng:keyword:(»«:haskell-tng:constructor: 
Stack»«:haskell-tng:keyword:,»«:haskell-tng:constructor: 
push»«:haskell-tng:keyword:,»«:haskell-tng:constructor: 
pop»«:haskell-tng:keyword:,»«:haskell-tng:constructor: 
top»«:haskell-tng:keyword:,»«:haskell-tng:constructor: size 
»«:haskell-tng:keyword:)» «:haskell-tng:keyword:where»
+»«:haskell-tng:keyword:module» 
«:haskell-tng:module:AStack»«:haskell-tng:keyword:(» 
«:haskell-tng:type:Stack»«:haskell-tng:keyword:,» push«:haskell-tng:keyword:,» 
pop«:haskell-tng:keyword:,» top«:haskell-tng:keyword:,» size 
«:haskell-tng:keyword:)» «:haskell-tng:keyword:where»
 «:haskell-tng:keyword:data»«:haskell-tng:type: Stack a 
»«:haskell-tng:keyword:=» «:haskell-tng:constructor:Empty»
              «:haskell-tng:keyword:|» «:haskell-tng:constructor:MkStack» a 
«:haskell-tng:keyword:(»«:haskell-tng:constructor:Stack» 
a«:haskell-tng:keyword:)»