Move on-type formatting logic into doclib layer

doclib/doc.rkt

@@ -341,6 +341,37 @@
   ;; even though the LSP range end itself is exclusive.
   (values start-line (max start-line (min requested-end-line last-line))))
 
+(define (doc-sexp-language? doc)
+  (eq? 'sexp (Language-Info-body-mode (doc-language-info doc))))
+
+(define (doc-on-type-formatting-range doc pos ch)
+  (define ch-pos (max 0 (sub1 (doc-pos->abs-pos doc pos))))
+  (define current-line (Pos-line pos))
+  (define current-line-start-pos (doc-line-start-abs-pos doc current-line))
+  (define current-line-end-pos (doc-line-end-abs-pos doc current-line))
+
+  (define (current-line-range)
+    (Range (doc-abs-pos->pos doc current-line-start-pos)
+           (doc-abs-pos->pos doc current-line-end-pos)))
+
+  (define (containing-form-range)
+    (define raw-pos (max 0 (sub1 ch-pos)))
+    (define token (doc-token-at doc raw-pos))
+    (define query-pos
+      (if (and token (eq? 'close-paren (LexerEntry-type token)))
+          (add1 raw-pos)
+          raw-pos))
+    (define maybe-paren-pos (doc-find-containing-paren doc query-pos))
+    (define start-pos (if maybe-paren-pos maybe-paren-pos 0))
+    (Range (doc-abs-pos->pos doc start-pos)
+           (doc-abs-pos->pos doc current-line-end-pos)))
+
+  (match ch
+    ["\n" (current-line-range)]
+    [")" (containing-form-range)]
+    ["]" (containing-form-range)]
+    [_ (current-line-range)]))
+
 ;; Shared path for all formatting requests
 (define/contract (doc-format-edits doc fmt-range
                                    #:formatting-options _opts
@@ -361,6 +392,19 @@
                  #:interactive? on-type?)]
     [else '()]))
 
+(define/contract (doc-on-type-format-edits doc pos ch
+                                           #:formatting-options opts)
+  (->* (Doc? Pos? string? #:formatting-options FormattingOptions?)
+       ()
+       (or/c (listof TextEdit?) #f))
+  (cond
+    [(doc-sexp-language? doc)
+     (doc-format-edits doc
+                       (doc-on-type-formatting-range doc pos ch)
+                       #:on-type? #t
+                       #:formatting-options opts)]
+    [else '()]))
+
 ;; get the tokens whose range are contained in interval [pos-start, pos-end)
 ;; the tokens whose range intersects the given range is included.
 ;; the previous token of the first token in the result is defined as a zero length fake token which
@@ -771,6 +815,7 @@
          doc-find-containing-paren
          doc-get-definition-by-id
          doc-format-edits
+         doc-on-type-format-edits
          doc-range-tokens
          doc-token-at
          doc-token-prefix-at

lsp/text-document.rkt

@@ -252,36 +252,6 @@
     [_
      (error-response id ErrorCode-InvalidParams "textDocument/rangeFormatting failed")]))
 
-(define (on-type-formatting-range doc pos ch)
-  (define ch-pos (max 0 (sub1 (doc-pos->abs-pos doc pos))))
-  (define current-line (Pos-line pos))
-  (define current-line-start-pos (doc-line-start-abs-pos doc current-line))
-  (define current-line-end-pos (doc-line-end-abs-pos doc current-line))
-
-  (define (current-line-range)
-    (Range (doc-abs-pos->pos doc current-line-start-pos)
-           (doc-abs-pos->pos doc current-line-end-pos)))
-
-  ;; TODO: Gate this sexp-structure lookup to sexp languages, or keep
-  ;; non-sexp documents on current-line formatting only.
-  (define (containing-form-range)
-    (define raw-pos (max 0 (sub1 ch-pos)))
-    (define token (doc-token-at doc raw-pos))
-    (define query-pos
-      (if (and token (eq? 'close-paren (LexerEntry-type token)))
-          (add1 raw-pos)
-          raw-pos))
-    (define maybe-paren-pos (doc-find-containing-paren doc query-pos))
-    (define start-pos (if (false? maybe-paren-pos) 0 maybe-paren-pos))
-    (Range (doc-abs-pos->pos doc start-pos)
-           (doc-abs-pos->pos doc current-line-end-pos)))
-
-  (match ch
-    ["\n" (current-line-range)]
-    [")" (containing-form-range)]
-    ["]" (containing-form-range)]
-    [_ (current-line-range)]))
-
 ;; On-type formatting request
 (define (on-type-formatting! id params)
   (match params
@@ -296,12 +266,10 @@
 
      (with-read-doc safe-doc
        (λ (doc)
-         (define range (on-type-formatting-range doc pos ch))
          (success/enc
            id
-           (doc-format-edits doc range
-                             #:on-type? #t
-                             #:formatting-options opts))))]
+           (doc-on-type-format-edits doc pos ch
+                                     #:formatting-options opts))))]
     [_
      (error-response id ErrorCode-InvalidParams "textDocument/onTypeFormatting failed")]))
 

scribblings/racket-langserver.scrbl

@@ -701,8 +701,25 @@ Exceptions are noted in individual entries.
   Returns a list of @racket[TextEdit] values to apply. For documents without
   a recognized s-expression language, returns an empty list.
 
-  When @tt{on-type?} is @racket[#t], blank lines are indented too. This mode is
-  intended for on-type formatting triggered by pressing Enter.
+  When @tt{on-type?} is @racket[#t], blank lines are indented too. For LSP
+  on-type formatting requests, prefer @racket[doc-on-type-format-edits].
+
+  Formatting is performed on an internal copy of the document; the doc is not
+  mutated by this call. Pass the result to @racket[doc-apply-edits!] to apply
+  the edits.
+}
+
+@defproc[(doc-on-type-format-edits [doc Doc?]
+                                   [pos Pos?]
+                                   [ch string?]
+                                   [#:formatting-options opts FormattingOptions?])
+         (or/c (listof TextEdit?) #f)]{
+  Computes formatting edits for an on-type formatting trigger. The @tt{pos}
+  argument is the cursor position after @tt{ch} has been inserted.
+
+  For recognized s-expression languages, close delimiters format the containing
+  form, and other triggers format the current line. For non-s-expression or
+  unrecognized languages, returns an empty list.
 
   Formatting is performed on an internal copy of the document; the doc is not
   mutated by this call. Pass the result to @racket[doc-apply-edits!] to apply

tests/lib/doc-test.rkt

@@ -375,6 +375,46 @@
                         #:formatting-options opts)
       '()))
 
+  (test-case
+    "On-type formatting delegates language policy to doclib"
+    (define opts
+      (FormattingOptions #:tab-size 2
+                         #:insert-spaces #t
+                         #:trim-trailing-whitespace #t
+                         #:insert-final-newline #f
+                         #:trim-final-newlines #f
+                         #:key #f))
+
+    (define sexp-doc
+      (make-doc "file:///test.rkt"
+                "#lang racket/base\n(define x\n1)"))
+    (check-equal?
+      (doc-on-type-format-edits sexp-doc
+                                (Pos 2 2)
+                                ")"
+                                #:formatting-options opts)
+      (list (TextEdit (Range (Pos 2 0) (Pos 2 2)) "  1)")))
+
+    (define rhombus-doc
+      (make-doc "file:///test.rhm"
+                "#lang rhombus\n  fun f():\n    1)\n"))
+    (check-equal?
+      (doc-on-type-format-edits rhombus-doc
+                                (Pos 2 6)
+                                ")"
+                                #:formatting-options opts)
+      '())
+
+    (define unknown-doc
+      (make-doc "file:///unknown.rkt"
+                "#lang not-a-real-language\n(define x\n1)"))
+    (check-equal?
+      (doc-on-type-format-edits unknown-doc
+                                (Pos 2 2)
+                                ")"
+                                #:formatting-options opts)
+      '()))
+
   (define (find-diagnostic-by-message diags expected-message)
     (for/first ([diag (in-list diags)]
                 #:when (string=? (Diagnostic-message diag) expected-message))