Respect formatting options

doc.rkt

@@ -14,6 +14,7 @@
          racket/set
          racket/list
          racket/string
+         racket/bool
          data/interval-map
          syntax-color/module-lexer
          syntax-color/racket-lexer
@@ -208,7 +209,9 @@
 ;; formatting ;;
 
 ;; Shared path for all formatting requests
-(define (format! this-doc st-ln st-ch ed-ln ed-ch #:on-type? [on-type? #f])
+(define (format! this-doc st-ln st-ch ed-ln ed-ch
+                 #:on-type? [on-type? #f]
+                 #:formatting-options opts)
   (define doc-text (Doc-text this-doc))
   (define doc-trace (Doc-trace this-doc))
 
@@ -218,13 +221,18 @@
   (define end-pos (max start-pos (sub1 (doc-pos this-doc ed-ln ed-ch))))
   (define start-line (send doc-text at-line start-pos))
   (define end-line (send doc-text at-line end-pos))
-  (define mut-doc-text
-    (if (is-a? doc-text lsp-editor%)
-        (let ([r-text (new lsp-editor%)])
-          (send r-text insert (send doc-text get-text) 0)
-          r-text)
-        (send doc-text copy)))
+
+  (define mut-doc-text (send doc-text copy))
+  ;; replace \t with spaces at line `(sub1 start-line)`
+  ;; as we cannot make `compute-racket-amount-to-indent`
+  ;; to respect the given tab size
+  (replace-tab! mut-doc-text
+                (max 0 (sub1 start-line))
+                (FormattingOptions-tabSize opts))
+
+  (define indenter-wp (indenter-wrapper indenter mut-doc-text on-type?))
   (define skip-this-line? #f)
+
   (if (eq? indenter 'missing) (json-null)
       (let loop ([line start-line])
         (define line-start (send mut-doc-text line-start-pos line))
@@ -242,60 +250,70 @@
                      ;; position. If we were to instead call `indent-line!` first and then
                      ;; `remove-trailing-space!` second, the remove step could result in
                      ;; losing user entered code.
-                     (list (remove-trailing-space! mut-doc-text skip-this-line? line)
-                           (indent-line! mut-doc-text indenter line #:on-type? on-type?)))
+                     (list (if (false? (FormattingOptions-trimTrailingWhitespace opts))
+                               #f
+                               (remove-trailing-space! mut-doc-text skip-this-line? line))
+                           (indent-line! mut-doc-text indenter-wp line)))
                     (loop (add1 line)))))))
 
+(define (replace-tab! doc-text line tabsize)
+  (define old-line (send doc-text get-line line))
+  (define spaces (make-string tabsize #\space))
+  (define new-line-str (string-replace old-line "\t" spaces))
+  (send doc-text replace-in-line
+        new-line-str
+        line 0 (string-length old-line)))
+
+(define (indenter-wrapper indenter doc-text on-type?)
+  (λ (line)
+    (cond [(and (not on-type?)
+                (= (send doc-text line-start-pos line)
+                   (send doc-text line-end-pos line)))
+           #f]
+          [else
+           (define line-start (send doc-text line-start-pos line))
+           (if indenter
+               (or (indenter doc-text line-start)
+                   (send doc-text compute-racket-amount-to-indent line-start))
+               (send doc-text compute-racket-amount-to-indent line-start))])))
+
 ;; Returns a TextEdit, or #f if the line is a part of multiple-line string
 (define (remove-trailing-space! doc-text in-string? line)
-  (define line-start (send doc-text line-start-pos line))
-  (define line-end (send doc-text line-end-pos line))
-  (define line-text (send doc-text get-text line-start line-end))
+  (define line-text (send doc-text get-line line))
   (cond
     [(not in-string?)
      (define from (string-length (string-trim line-text #px"\\s+" #:left? #f)))
      (define to (string-length line-text))
-     (send doc-text delete (+ line-start from) (+ line-start to))
+     (send doc-text replace-in-line "" line from to)
      (TextEdit #:range (Range #:start (Pos #:line line #:char from)
                               #:end   (Pos #:line line #:char to))
                #:newText "")]
     [else #f]))
 
+(define (extract-indent-string content)
+  (define len
+    (or (for/first ([(c i) (in-indexed content)]
+                    #:when (not (char-whitespace? c)))
+          i)
+        (string-length content)))
+  (substring content 0 len))
+
 ;; Returns a TextEdit, or #f if the line is already correct.
-(define (indent-line! doc-text indenter line #:on-type? [on-type? #f])
-  (define line-start (send doc-text line-start-pos line))
-  (define line-end (send doc-text line-end-pos line))
-  (define line-text (send doc-text get-text line-start line-end))
-  (define line-length (string-length line-text))
-  (define current-spaces
-    (let loop ([i 0])
-      (cond [(= i line-length) i]
-            [(char=? (string-ref line-text i) #\space) (loop (add1 i))]
-            [else i])))
-  (define desired-spaces
-    (if indenter
-        (or (indenter doc-text line-start)
-            (send doc-text compute-racket-amount-to-indent line-start))
-        (send doc-text compute-racket-amount-to-indent line-start)))
-  (cond
-    [(not (number? desired-spaces)) #f]
-    [(= current-spaces desired-spaces) #f]
-    [(and (not on-type?) (= line-length 0)) #f]
-    [(< current-spaces desired-spaces)
-     ;; Insert spaces
-     (define insert-count (- desired-spaces current-spaces))
-     (define new-text (make-string insert-count #\space))
-     (define pos (Pos #:line line #:char 0))
-     (send doc-text insert new-text line-start)
-     (TextEdit #:range (Range #:start pos #:end pos)
-               #:newText new-text)]
-    [else
-     ;; Delete spaces
-     (define span (- current-spaces desired-spaces))
-     (send doc-text delete line-start (+ line-start span))
-     (TextEdit #:range (Range #:start (Pos #:line line #:char 0)
-                              #:end   (Pos #:line line #:char span))
-               #:newText "")]))
+(define (indent-line! doc-text indenter line)
+  (define content (send doc-text get-line line))
+  (define old-indent-string (extract-indent-string content))
+  (define expect-indent (indenter line))
+  (define really-indent (string-length old-indent-string))
+  (define has-tab? (string-contains? old-indent-string "\t"))
+
+  (cond [(false? expect-indent) #f]
+        [(and (= expect-indent really-indent) (not has-tab?)) #f]
+        [else
+         (define new-text (make-string expect-indent #\space))
+         (send doc-text replace-in-line new-text line 0 really-indent)
+         (TextEdit #:range (Range #:start (Pos #:line line #:char 0)
+                                  #:end (Pos #:line line #:char really-indent))
+                   #:newText new-text)]))
 
 (provide Doc-trace
          new-doc

editor.rkt

@@ -15,9 +15,6 @@
       (send new-core insert (send core get-text) 0)
       (set! core new-core))
 
-    (define/private (set-core! new-core)
-      (set! core new-core))
-
     ;; insert str at start
     (define/public (insert str start)
       (with-handlers ([exn?
@@ -36,6 +33,11 @@
                          (send core insert str start end))])
         (send core insert str start end)))
 
+    (define/public (replace-in-line str line ch-st ch-ed)
+      (send this replace str
+            (send this line/char->pos line ch-st)
+            (send this line/char->pos line ch-ed)))
+
     (define/public (delete start end)
       (send core delete start end))
 
@@ -75,8 +77,15 @@
       (send core position-paragraph pos))
 
     (define/public (copy)
+      ;; We only need to copy text to the new editor.
+      ;; All of the public methods of lsp-editor% except
+      ;; the indent method are simply insert/delete/change/query
+      ;; text strings.
+      ;; It does not require additional states.
+      ;; The private states that core contains are always the default.
+      ;; So we just ignore them.
       (define new-editor (new lsp-editor%))
-      (send new-editor set-core! (send core copy-self))
+      (send new-editor insert (send this get-text) 0)
       new-editor)
 
     (define/public (get-char pos)

struct.rkt

@@ -2,7 +2,10 @@
 
 ;; internal structs ;;
 
-(require racket/contract)
+(require racket/contract
+         racket/match
+         (for-syntax racket/base
+                     syntax/parse))
 
 (provide
  (contract-out
@@ -13,6 +16,31 @@
 
 (struct Decl (filename id left right) #:transparent)
 
+;; optional arguments
+
+(define undef-object (gensym 'undef))
+
+(define (undef? x)
+  (eq? x undef-object))
+
+(define (undef/c pred?)
+  (λ (x)
+    (or/c (undef? x) (pred? x))))
+
+(provide undef?
+         undef/c
+         undef-object)
+
+;; request error
+
+(define request-err-object (gensym 'request-error))
+
+(define (request-err? x)
+  (eq? x request-err-object))
+
+(provide request-err-object
+         request-err?)
+
 ;; uinteger ;;
 
 (define uinteger-upper-limit (sub1 (expt 2 31)))
@@ -62,3 +90,61 @@
 (provide *Range
          make-Range
          Range->hash)
+
+(struct FormattingOptions
+  (tabSize
+   insertSpaces
+   trimTrailingWhitespace
+   insertFinalNewline
+   trimFinalNewlines
+   key))
+
+(define/contract (make-FormattingOptions #:tabSize tabSize
+                                         #:insertSpaces insertSpaces
+                                         #:trimTrailingWhitespace [trimTrailingWhitespace undef-object]
+                                         #:insertFinalNewline [insertFinalNewline undef-object]
+                                         #:trimFinalNewlines [trimFinalNewlines undef-object]
+                                         #:key [key undef-object])
+  (-> #:tabSize uinteger?
+      #:insertSpaces boolean?
+      #:trimTrailingWhitespace (undef/c boolean?)
+      #:insertFinalNewline (undef/c boolean?)
+      #:trimFinalNewlines (undef/c boolean?)
+      #:key (undef/c hash?)
+      FormattingOptions?)
+
+  (FormattingOptions tabSize
+                     insertSpaces
+                     trimTrailingWhitespace
+                     insertFinalNewline
+                     trimFinalNewlines
+                     key))
+
+(define (jsexpr->FormattingOptions jsexpr)
+  (with-handlers ([exn:fail? (λ (_) request-err-object)])
+    (make-FormattingOptions #:tabSize (hash-ref jsexpr 'tabSize)
+                            #:insertSpaces (hash-ref jsexpr 'insertSpaces)
+                            #:trimTrailingWhitespace (hash-ref jsexpr 'trimTrailingWhitespace undef-object)
+                            #:insertFinalNewline (hash-ref jsexpr 'insertFinalNewline undef-object)
+                            #:trimFinalNewlines (hash-ref jsexpr 'trimFinalNewlines undef-object)
+                            #:key (hash-ref jsexpr 'key undef-object))))
+
+;; usage:
+;; (jsexpr? jsexpr) ;; #t
+;; (match jsexpr
+;;   [(as-FormattingOptions opts)
+;;    (FormattingOptions? opts) ;; #t
+;;    ])
+;; It's a convenient macro to verify jsexpr and convert it
+;; to struct.
+(define-match-expander as-FormattingOptions
+  (lambda (stx)
+    (syntax-parse stx
+      [(_ name)
+       #'(and (? hash?)
+              (app jsexpr->FormattingOptions (and name (not (? request-err?)))))])))
+
+(provide FormattingOptions
+         FormattingOptions-tabSize
+         FormattingOptions-trimTrailingWhitespace
+         as-FormattingOptions)

tests/textDocument/formatting.rkt

@@ -44,7 +44,9 @@ END
                                         'position
                                         (hasheq 'line 3
                                                 'character 0)
-                                        'ch "\n"))]
+                                        'ch "\n"
+                                        'options (hasheq 'tabSize 4
+                                                         'insertSpaces #t)))]
              [res (make-expected-response req
                                  (list
                                   (hasheq 'range

text-document.rkt

@@ -452,39 +452,39 @@
 ;; Full document formatting request
 (define (formatting! id params)
   (match params
-    ;; We're ignoring 'options for now
-    [(hash-table ['textDocument (DocIdentifier #:uri uri)])
+    [(hash-table ['textDocument (DocIdentifier #:uri uri)]
+                 ['options (as-FormattingOptions opts)])
 
      (define this-doc (hash-ref open-docs (string->symbol uri)))
 
      (define-values (st-ln st-ch) (doc-line/ch this-doc 0))
      (define-values (ed-ln ed-ch) (doc-line/ch this-doc (doc-endpos this-doc)))
-     (success-response id (format! this-doc st-ln st-ch ed-ln ed-ch))]
+     (success-response id (format! this-doc st-ln st-ch ed-ln ed-ch #:formatting-options opts))]
     [_
      (error-response id INVALID-PARAMS "textDocument/formatting failed")]))
 
 ;; Range Formatting request
 (define (range-formatting! id params)
   (match params
-    ;; XXX We're ignoring 'options' for now
     [(hash-table ['textDocument (DocIdentifier #:uri uri)]
                  ['range (Range  #:start (Pos #:line st-ln #:char st-ch)
-                                 #:end (Pos #:line ed-ln #:char ed-ch))])
+                                 #:end (Pos #:line ed-ln #:char ed-ch))]
+                 ['options (as-FormattingOptions opts)])
      (define this-doc (hash-ref open-docs (string->symbol uri)))
-     (success-response id (format! this-doc st-ln st-ch ed-ln ed-ch))]
+     (success-response id (format! this-doc st-ln st-ch ed-ln ed-ch #:formatting-options opts))]
     [_
      (error-response id INVALID-PARAMS "textDocument/rangeFormatting failed")]))
 
 ;; On-type formatting request
 (define (on-type-formatting! id params)
   (match params
-    ;; We're ignoring 'options for now
     [(hash-table ['textDocument (DocIdentifier #:uri uri)]
                  ;; `position` is assumed to be the cursor position that after the edit.
                  ;; Therefore, `position - 1` is the position of `ch`.
                  ;; Also see issue https://github.com/jeapostrophe/racket-langserver/issues/111
                  ['position (Pos #:line line #:char char)]
-                 ['ch ch])
+                 ['ch ch]
+                 ['options (as-FormattingOptions opts)])
      (define this-doc (hash-ref open-docs (string->symbol uri)))
 
      (define ch-pos (- (doc-pos this-doc line char) 1))
@@ -499,7 +499,9 @@
             (doc-line/ch this-doc (or (doc-find-containing-paren this-doc (max 0 (sub1 ch-pos))) 0)))
           (define-values (ed-ln ed-ch) (doc-line/ch this-doc ch-pos))
           (values st-ln st-ch ed-ln ed-ch)]))
-     (success-response id (format! this-doc st-ln st-ch ed-ln ed-ch #:on-type? #t))]
+     (success-response id (format! this-doc st-ln st-ch ed-ln ed-ch
+                                   #:on-type? #t
+                                   #:formatting-options opts))]
     [_
      (error-response id INVALID-PARAMS "textDocument/onTypeFormatting failed")]))