Support GHC 9.12 MultilineStrings

NEWS

@@ -8,6 +8,8 @@ This file uses Org mode. Some useful (default) key-bindings:
 
 * Changes in 17.5
 
+- Support multiline string literals
+
 - See [[https://github.com/haskell/haskell-mode/compare/v17.4...v17.5][Git history]]
 
 * Changes in 17.4

haskell-lexeme.el

@@ -292,63 +292,99 @@ under edit.
 String literals end with double quote or unescaped newline or end
 of buffer.
 
+Note that this regexp does not cover multiline string literals
+\(GHC MultilineStrings extension); see
+`haskell-lexeme-looking-at-string-literal' for those.
+
 Regexp has subgroup expressions:
  (match-text 1) matches the opening double quote.
  (match-text 2) matches the inside of the string.
  (match-text 3) matches the closing double quote or an empty string
                 at the end of line or the end buffer.")
 
+(defun haskell-lexeme--scan-string-literal (quotes newline-terminates)
+  "Scan the string literal at point delimited by QUOTES double quotes.
+
+Point must be at a run of at least QUOTES double quotes.  The
+literal ends at the earliest unescaped run of at least QUOTES
+double quotes; a shorter unescaped run is content.  When
+NEWLINE-TERMINATES is non-nil an unescaped newline leaves the
+literal unterminated, and otherwise a newline is content.
+
+Always return non-nil, with match data:
+ (match-text 1) matches the opening delimiter.
+ (match-text 2) matches the inside of the string.
+ (match-text 3) matches the closing delimiter, or is nil when
+                the literal is unterminated.
+
+An unterminated literal ends before an unescaped newline when
+NEWLINE-TERMINATES is non-nil, and otherwise at the end of the
+buffer.  When it ends at the end of the buffer, the whole match
+and the inside are guaranteed to extend to the end of the
+buffer."
+  (save-excursion
+    (let* ((begin (point))
+           (content (+ begin quotes))
+           (closer-tail (make-string (1- quotes) ?\"))
+           (terminators (if newline-terminates "[\"\n\\]" "[\"\\]"))
+           finish)
+      (goto-char content)
+      (while (and (not finish)
+                  (re-search-forward terminators nil 'goto-eob))
+        (cond
+         ((equal (match-string 0) "\\")
+          (if (looking-at "[ \t\n\r\v\f]+\\\\?")
+              (goto-char (match-end 0))
+            (goto-char (1+ (point)))))
+
+         ((equal (match-string 0) "\"")
+          (let ((q (match-beginning 0)))
+            (if (looking-at closer-tail)
+                (progn
+                  (set-match-data
+                   (list begin (+ q quotes)
+                         begin content
+                         content q
+                         q (+ q quotes)))
+                  (setq finish t))
+              (skip-chars-forward "\""))))
+
+         ((equal (match-string 0) "\n")
+          (set-match-data
+           (list begin (match-beginning 0)
+                 begin content
+                 content (match-beginning 0)
+                 nil nil))
+          (setq finish t))))
+      (unless finish
+        ;; string closed by end of buffer
+        (set-match-data
+         (list begin (point)
+               begin content
+               content (point)
+               nil nil)))))
+  t)
+
 (defun haskell-lexeme-looking-at-string-literal ()
   "Non-nil when point is at a string literal lookalike.
 
 Note that this function matches more than Haskell Report
 specifies because we want to support also code under edit.
 
-String literals end with double quote or unescaped newline or end
-of buffer.
+Plain string literals end with double quote or unescaped
+newline or end of buffer.  Multiline string literals (GHC
+MultilineStrings extension, opened with three double quotes)
+end at the first unescaped triple double quote and may span
+several lines.
 
 After successful match:
- (match-text 1) matches the opening doublequote.
+ (match-text 1) matches the opening quote or triple quote.
  (match-text 2) matches the inside of the string.
- (match-text 3) matches the closing quote, or a closing
-                newline or is nil when at the end of the buffer."
-  (when (looking-at "\"")
-    (save-excursion
-      (let ((begin (point)))
-        (goto-char (match-end 0))
-        (let (finish)
-          (while (and (not finish)
-                      (re-search-forward "[\"\n\\]" nil 'goto-eob))
-            (cond
-             ((equal (match-string 0) "\\")
-              (if (looking-at "[ \t\n\r\v\f]+\\\\?")
-                  (goto-char (match-end 0))
-                (goto-char (1+ (point)))))
-
-             ((equal (match-string 0) "\"")
-              (set-match-data
-               (list begin (match-end 0)
-                     begin (1+ begin)
-                     (1+ begin) (match-beginning 0)
-                     (match-beginning 0) (match-end 0)))
-              (setq finish t))
-
-             ((equal (match-string 0) "\n")
-              (set-match-data
-               (list begin (match-beginning 0)
-                     begin (1+ begin)
-                     (1+ begin) (match-beginning 0)
-                     nil nil))
-              (setq finish t))))
-          (unless finish
-            ;; string closed by end of buffer
-            (set-match-data
-             (list begin (point)
-                   begin (1+ begin)
-                   (1+ begin) (point)
-                   nil nil))))))
-    ;; there was a match
-    t))
+ (match-text 3) matches the closing quote or triple quote, or
+                is nil when the literal is unterminated."
+  (cond
+   ((looking-at "\"\"\"") (haskell-lexeme--scan-string-literal 3 nil))
+   ((looking-at "\"") (haskell-lexeme--scan-string-literal 1 t))))
 
 (defun haskell-lexeme-looking-at-quasi-quote-literal ()
   "Non-nil when point is just in front of Template Haskell

haskell-mode.el

@@ -577,6 +577,10 @@ be set to the preferred literate style."
                 (save-match-data
                   (while (re-search-forward "\"" limit t)
                     (put-text-property (match-beginning 0) (match-end 0) 'syntax-table (string-to-syntax ".")))))
+              (when (= (- (match-end 1) (match-beginning 1)) 3)
+                (put-text-property (1+ (match-beginning 1)) (match-end 1) 'syntax-table (string-to-syntax "."))
+                (when (match-beginning 3)
+                  (put-text-property (match-beginning 3) (1- (match-end 3)) 'syntax-table (string-to-syntax "."))))
               ;; Place a generic string delimeter only when an open
               ;; quote is closed by end-of-line Emacs acts strangely
               ;; when a generic delimiter is not closed so in case

tests/haskell-font-lock-tests.el

@@ -695,6 +695,43 @@
       ("zonk" t font-lock-string-face)
       ("\\" t font-lock-warning-face))))
 
+(ert-deftest haskell-multiline-string-1 ()
+  "Terminated multiline string across lines is fontified as a string."
+  (check-properties
+   '"x = \"\"\"abc\ndef\"\"\" ; y = Cons"
+   '(("\"\"\"" "\"." font-lock-string-face)
+     ("abc\ndef" t font-lock-string-face)
+     ("\"\"\"" "\"." font-lock-string-face)
+     ("Cons" "w" haskell-constructor-face))))
+
+(ert-deftest haskell-multiline-string-2 ()
+  "Embedded double-quote runs stay string face with punctuation syntax."
+  (check-properties
+   '"\"\"\"He said \"\"hi\"\" ok\"\"\""
+   '(("\"\"\"" "\"." font-lock-string-face)
+     ("He said " t font-lock-string-face)
+     ("\"\"" "." font-lock-string-face)
+     ("hi" t font-lock-string-face)
+     ("\"\"" "." font-lock-string-face)
+     (" ok" t font-lock-string-face)
+     ("\"\"\"" "\"." font-lock-string-face))))
+
+(ert-deftest haskell-multiline-string-3 ()
+  "Unterminated multiline string warns on the opening quote only."
+  (check-properties
+   '"x = \"\"\"abc"
+   '(("\"" "\"" font-lock-warning-face)
+     ("\"\"" "." font-lock-string-face)
+     ("abc" t font-lock-string-face))))
+
+(ert-deftest haskell-multiline-string-4 ()
+  "Invalid escape inside a multiline string warns on the backslash."
+  (check-properties
+   '"x = \"\"\"ab\\qcd\"\"\""
+   '(("\\" t font-lock-warning-face)
+     ("qcd" t font-lock-string-face)
+     ("\"\"\"" "\"." font-lock-string-face))))
+
 (ert-deftest haskell-type-colors-01 ()
   (check-properties
    "x :: Int -> String"

tests/haskell-indentation-tests.el

@@ -774,19 +774,19 @@ tokOpenTag =
        ]
 "
               (4 7))
-(hindent-test "37 Indent continuation lines in multiline string literal" "
+(hindent-test "37 Indent continuation lines in multiline string literal (plain, not MultilineStrings)" "
 a = \"multiline\\
 "
               (2 0 4))
 
-(hindent-test "38 Indent in do block after multiline string literal" "
+(hindent-test "38 Indent in do block after multiline string literal (plain, not MultilineStrings)" "
 s = do
   a <- \"multiline\\
        \\ line 2\"
 "
               (4 0 2 4 7))
 
-(hindent-test "39 do not crash after two multiline literals in do block" "
+(hindent-test "39 do not crash after two multiline string literals (plain, not MultilineStrings) in do block" "
 servePost = do
   a <- fun \"line 1\\
            \\line 2\"
@@ -853,7 +853,7 @@ fact n = case n of
               (4 4)
               (5 0 2 4 6 9 22))
 
-(hindent-test "47a multiline strings" "
+(hindent-test "47a multiline strings (plain, not MultilineStrings)" "
 fact n = \"\\
          \\a\""
               (1 0)
@@ -862,7 +862,7 @@ fact n = \"\\
               (2 0 9)
               (3 0 2 9))
 
-(hindent-test "47b multiline strings" "
+(hindent-test "47b multiline strings (plain, not MultilineStrings)" "
 fact n = \"\\
       \\a\\
       \\x\""
@@ -1003,7 +1003,7 @@ data X = X |
               (2 2 9)
               (3 0 7 9))
 
-(hindent-test "61 unterminated/multiline strings whose line doesn't end in backslash" "
+(hindent-test "61 unterminated/multiline strings (plain, not MultilineStrings) whose line doesn't end in backslash" "
 func = \"unterminated
            where"
               (1 0)
@@ -1015,6 +1015,20 @@ import javascript unsafe
               (1 0)
               (2 0 2 7))
 
+(hindent-test "63 MultilineStrings literal" "
+foo = \"\"\"one
+two\"\"\"
+bar = 2"
+              (1 0)
+              (2 0 6)
+              (3 0 2 6))
+
+(hindent-test "63u unterminated MultilineStrings literal" "
+foo = \"\"\"one
+two"
+              (1 0)
+              (2 0 6))
+
 (ert-deftest haskell-indentation-ret-indents ()
   (with-temp-switch-to-buffer
    (haskell-mode)

tests/haskell-lexeme-tests.el

@@ -212,6 +212,88 @@ buffer. Returns list of tokens."
    '("foo" "=" "\"zonk"
      "Cons")))
 
+(ert-deftest haskell-lexeme-multiline-string-literal-1 ()
+  "One-line multiline string is a single token"
+  (check-lexemes
+   '("x = \"\"\"a\"\"\" ++ y")
+   '("x" "=" "\"\"\"a\"\"\"" "++" "y")))
+
+(ert-deftest haskell-lexeme-multiline-string-literal-2 ()
+  "Multiline string spanning lines is a single token"
+  (check-lexemes
+   '("a = \"\"\"one"
+     "two\"\"\" ; b")
+   '("a" "=" "\"\"\"one\ntwo\"\"\"" ";" "b")))
+
+(ert-deftest haskell-lexeme-multiline-string-literal-3 ()
+  "Embedded quote runs of one or two quotes are content"
+  (check-lexemes
+   '("\"\"\"He said \"\"hi\"\" ok\"\"\"")
+   '("\"\"\"He said \"\"hi\"\" ok\"\"\"")))
+
+(ert-deftest haskell-lexeme-multiline-string-literal-4 ()
+  "Escaped quote right before the closer is content"
+  (check-lexemes
+   '("\"\"\"a\\\"\"\"\"")
+   '("\"\"\"a\\\"\"\"\"")))
+
+(ert-deftest haskell-lexeme-multiline-string-literal-5 ()
+  "String gap spanning a newline is consumed inside the token"
+  (check-lexemes
+   '("\"\"\"a\\"
+     "  \\b\"\"\"")
+   '("\"\"\"a\\\n  \\b\"\"\"")))
+
+(ert-deftest haskell-lexeme-multiline-string-literal-6 ()
+  "Empty multiline string"
+  (check-lexemes
+   '("\"\"\"\"\"\"")
+   '("\"\"\"\"\"\"")))
+
+(ert-deftest haskell-lexeme-multiline-string-literal-7 ()
+  "Unterminated multiline string at end of buffer"
+  (check-lexemes
+   "\"\"\"\""
+   '("\"\"\"\"")))
+
+(ert-deftest haskell-lexeme-multiline-string-literal-8 ()
+  "Closes at the earliest triple quote, extra quote is a new token"
+  (check-lexemes
+   "\"\"\"a\"\"\"\""
+   '("\"\"\"a\"\"\"" "\"")))
+
+(ert-deftest haskell-lexeme-multiline-string-literal-9 ()
+  "Closes at the earliest triple quote, extra triple quote is a new token"
+  (check-lexemes
+   "\"\"\"x\"\"\"\"\"\""
+   '("\"\"\"x\"\"\"" "\"\"\"")))
+
+(ert-deftest haskell-lexeme-multiline-string-literal-10 ()
+  "Unterminated multiline string runs to the end of the buffer"
+  (check-lexemes
+   '("a = \"\"\"one"
+     "two"
+     "three")
+   '("a" "=" "\"\"\"one\ntwo\nthree\n")))
+
+(ert-deftest haskell-lexeme-multiline-string-literal-11 ()
+  "Bare opener at end of buffer is an unterminated multiline string"
+  (check-lexemes
+   "\"\"\""
+   '("\"\"\"")))
+
+(ert-deftest haskell-lexeme-multiline-string-literal-12 ()
+  "Five quotes are an unterminated multiline string with two-quote content"
+  (check-lexemes
+   "\"\"\"\"\""
+   '("\"\"\"\"\"")))
+
+(ert-deftest haskell-lexeme-multiline-string-literal-13 ()
+  "Backslash as the last character of the buffer stays inside the token"
+  (check-lexemes
+   "\"\"\"a\\"
+   '("\"\"\"a\\")))
+
 (ert-deftest haskell-lexeme-line-comment-1 ()
   (check-lexemes
    '("   -- x  "