Small refactor (#190)

* Remove undef type for absent fields

Nothing in common/json-util.rkt is prefered now. It supports automatic json encode/decode.

* Rewrite error codes with enum type, move it to common/interfaces.rkt

* Use racket/base lang instead of racket in non test files

* Add test for error path

* Allow client-wait-response forward error response

resolve #168

Author: 6cdh

common/interfaces.rkt

@@ -20,6 +20,7 @@
          (json-type-out WorkspaceEdit)
          (json-type-out CodeAction)
          (json-type-out DiagnosticSeverity)
+         (json-type-out ErrorCode)
          (json-type-out Diagnostic)
          (json-type-out Location)
          (json-type-out DocumentHighlight)
@@ -75,6 +76,21 @@
   [Information 3]
   [Hint 4])
 
+(define-json-enum ErrorCode
+  ;; Defined by JSON RPC
+  [ParseError -32700]
+  [InvalidRequest -32600]
+  [MethodNotFound -32601]
+  [InvalidParams -32602]
+  [InternalError -32603]
+  [ServerErrorStart -32099]
+  [ServerErrorEnd -32000]
+  [ServerNotInitialized -32002]
+  [UnknownErrorCode -32001]
+
+  ;; Defined by LSP protocol
+  [RequestCancelled -32800])
+
 (define-json-struct Diagnostic
   [range Range]
   [severity DiagnosticSeverity]

common/path-util.rkt

@@ -1,9 +1,10 @@
-#lang racket
+#lang racket/base
 
 (provide path->uri
          uri->path)
 
-(require net/url)
+(require net/url
+         racket/string)
 
 (define path->uri (compose url->string path->url))
 

common/version.rkt

@@ -1,4 +1,4 @@
-#lang racket
+#lang racket/base
 
 (provide version>=9.0?)
 

doclib/autocomplete/module.rkt

@@ -11,8 +11,14 @@
 ; particular means that you must release the source code for the
 ; modified software.  See http://www.gnu.org/copyleft/lesser.html
 ; for more information.
-#lang racket
-(require setup/link)
+#lang racket/base
+
+(require setup/link
+         racket/set
+         racket/match
+         racket/string
+         racket/list
+         racket/path)
 
 (define (collections)
   (define h1

doclib/internal-types.rkt

@@ -70,15 +70,6 @@
    [right exact-nonnegative-integer?])
   #:transparent)
 
-(define undef-object (gensym 'undef))
-
-(define (undef? x)
-  (eq? x undef-object))
-
-(define (undef/c pred?)
-  (λ (x)
-    (or/c (undef? x) (pred? x))))
-
 (define (interval-map-of value/c)
   (define value-flat/c (coerce-flat-contract 'interval-map-of value/c))
   (define value? (flat-contract-predicate value-flat/c))
@@ -89,7 +80,3 @@
            (for/and ([(k value) (in-dict m)])
              (value? value))))))
 
-(provide undef?
-         undef/c
-         undef-object)
-

lsp/error-codes.rkt

@@ -6,7 +6,6 @@
          racket/match
          racket/class
          racket/async-channel
-         "error-codes.rkt"
          "../common/interfaces.rkt"
          "../common/json-util.rkt"
          "responses.rkt"
@@ -125,7 +124,7 @@
          (define id-ref (hash-ref msg 'id void))
          (define id (if ((or/c number? string?) id-ref) id-ref (json-null)))
          (define err "The JSON sent is not a valid request object.")
-         (send-response (error-response id INVALID-REQUEST err))]))
+         (send-response (error-response id ErrorCode-InvalidRequest err))]))
 
     ;; Handle a request. This procedure should always return a jsexpr
     ;; which is a suitable response object.
@@ -172,7 +171,7 @@
           [_
            (eprintf "invalid request for method ~v\n" method)
            (define err (format "The method ~v was not found" method))
-           (error-response id METHOD-NOT-FOUND err)])))
+           (error-response id ErrorCode-MethodNotFound err)])))
 
     ;; Handle a notification. Because notifications do not require
     ;; a response, this procedure always returns void.
@@ -206,7 +205,7 @@
 (define ((report-request-error id method) exn)
   (eprintf "Caught exn in request ~v\n~a\n" method (exn->string exn))
   (define err (format "internal error in method ~v" method))
-  (error-response id INTERNAL-ERROR err))
+  (error-response id ErrorCode-InternalError err))
 
 ;;
 ;; Requests
@@ -279,7 +278,7 @@
      (set! already-initialized? #t)
      resp]
     [_
-     (error-response id INVALID-PARAMS "initialize failed")]))
+     (error-response id ErrorCode-InvalidParams "initialize failed")]))
 
 (define (shutdown id)
   (set! already-shutdown? #t)

lsp/methods.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 (require json
-         racket/contract/base)
+         racket/contract/base
+         "../common/interfaces.rkt"
+         "../common/json-util.rkt")
 
 (define not-given (gensym 'not-given))
 
@@ -12,7 +14,7 @@
 
 ;; Constructor for a response object representing failure.
 (define (error-response id code message [data not-given])
-  (define err (hasheq 'code code
+  (define err (hasheq 'code (->jsexpr code)
                       'message message))
   (define err* (if (eq? data not-given)
                    err
@@ -26,7 +28,7 @@
     [success-response
      ((or/c number? string?) jsexpr? . -> . jsexpr?)]
     [error-response
-     (->* ((or/c number? string? (json-null)) number? string?)
+     (->* ((or/c number? string? (json-null)) (or/c number? ErrorCode?) string?)
           (any/c)
           jsexpr?)]))
 

lsp/responses.rkt

@@ -4,7 +4,6 @@
          racket/list
          racket/bool
          racket/contract
-         "error-codes.rkt"
          "../common/interfaces.rkt"
          "../common/json-util.rkt"
          "responses.rkt"
@@ -80,7 +79,7 @@
            (doc-hover doc pos))))
      (success/enc id result)]
     [_
-     (error-response id INVALID-PARAMS "textDocument/hover failed")]))
+     (error-response id ErrorCode-InvalidParams "textDocument/hover failed")]))
 
 ;; Code Action request
 (define (code-action id params)
@@ -100,9 +99,9 @@
            (doc-code-action doc range))))
      (success/enc id actions)]
     [(hash-table ['textDocument (DocIdentifier-js #:uri uri)])
-     (error-response id INVALID-PARAMS
+     (error-response id ErrorCode-InvalidParams
                      (format "textDocument/codeAction failed uri is not a path ~a" uri))]
-    [_ (error-response id INVALID-PARAMS "textDocument/codeAction failed")]))
+    [_ (error-response id ErrorCode-InvalidParams "textDocument/codeAction failed")]))
 
 ;; Signature Help request
 (define (signatureHelp id params)
@@ -116,7 +115,7 @@
            (doc-signature-help doc pos))))
      (success/enc id result)]
     [_
-     (error-response id INVALID-PARAMS "textDocument/signatureHelp failed")]))
+     (error-response id ErrorCode-InvalidParams "textDocument/signatureHelp failed")]))
 
 ;; Completion Request
 (define (completion id params)
@@ -129,7 +128,7 @@
          (λ (doc) (doc-completion doc pos))))
      (success/enc id result)]
     [_
-     (error-response id INVALID-PARAMS "textDocument/completion failed")]))
+     (error-response id ErrorCode-InvalidParams "textDocument/completion failed")]))
 
 ;; Definition request
 
@@ -143,7 +142,7 @@
          (λ (doc) (doc-definition doc uri pos))))
      (success/enc id result)]
     [_
-     (error-response id INVALID-PARAMS "textDocument/definition failed")]))
+     (error-response id ErrorCode-InvalidParams "textDocument/definition failed")]))
 
 ;; Reference request
 (define (references id params)
@@ -157,7 +156,7 @@
          (λ (doc) (doc-references doc uri pos include-decl?))))
      (success/enc id result)]
     [_
-     (error-response id INVALID-PARAMS "textDocument/references failed")]))
+     (error-response id ErrorCode-InvalidParams "textDocument/references failed")]))
 
 ;; Document Highlight request
 (define (document-highlight id params)
@@ -170,7 +169,7 @@
          (λ (doc) (doc-highlights doc pos))))
      (success/enc id result)]
     [_
-     (error-response id INVALID-PARAMS "textDocument/documentHighlight failed")]))
+     (error-response id ErrorCode-InvalidParams "textDocument/documentHighlight failed")]))
 
 ;; Rename request
 (define (_rename id params)
@@ -184,7 +183,7 @@
          (λ (doc) (doc-rename doc uri pos new-name))))
      (success/enc id result)]
     [_
-     (error-response id INVALID-PARAMS "textDocument/rename failed")]))
+     (error-response id ErrorCode-InvalidParams "textDocument/rename failed")]))
 
 ;; Prepare rename
 (define (prepareRename id params)
@@ -197,7 +196,7 @@
          (λ (doc) (doc-prepare-rename doc pos))))
      (success/enc id result)]
     [_
-     (error-response id INVALID-PARAMS "textDocument/prepareRename failed")]))
+     (error-response id ErrorCode-InvalidParams "textDocument/prepareRename failed")]))
 
 ;; Document Symbol request
 (define (document-symbol id params)
@@ -209,15 +208,15 @@
          (λ (doc) (doc-symbols doc uri))))
      (success/enc id results)]
     [_
-     (error-response id INVALID-PARAMS "textDocument/documentSymbol failed")]))
+     (error-response id ErrorCode-InvalidParams "textDocument/documentSymbol failed")]))
 
 ;; Inlay Hint
 (define (inlay-hint id params)
   (match params
     [(hash-table ['textDocument (DocIdentifier-js #:uri uri)]
                  ['range (^Range _ _)])
      (success/enc id '())]
-    [_ (error-response id INVALID-PARAMS "textDocument/inlayHint failed")]))
+    [_ (error-response id ErrorCode-InvalidParams "textDocument/inlayHint failed")]))
 
 ;; Full document formatting request
 (define (formatting! id params)
@@ -236,7 +235,7 @@
                              (Range start end)
                              #:formatting-options opts))))]
     [_
-     (error-response id INVALID-PARAMS "textDocument/formatting failed")]))
+     (error-response id ErrorCode-InvalidParams "textDocument/formatting failed")]))
 
 ;; Range Formatting request
 (define (range-formatting! id params)
@@ -251,7 +250,7 @@
            id
            (doc-format-edits doc range #:formatting-options opts))))]
     [_
-     (error-response id INVALID-PARAMS "textDocument/rangeFormatting failed")]))
+     (error-response id ErrorCode-InvalidParams "textDocument/rangeFormatting failed")]))
 
 ;; On-type formatting request
 (define (on-type-formatting! id params)
@@ -287,7 +286,7 @@
                              #:on-type? #t
                              #:formatting-options opts))))]
     [_
-     (error-response id INVALID-PARAMS "textDocument/onTypeFormatting failed")]))
+     (error-response id ErrorCode-InvalidParams "textDocument/onTypeFormatting failed")]))
 
 (define (full-semantic-tokens id params)
   (match params
@@ -299,15 +298,15 @@
            (Range (doc-abs-pos->pos doc 0)
                   (doc-abs-pos->pos doc (doc-end-abs-pos doc))))))
      (semantic-tokens uri id safe-doc full-range)]
-    [_ (error-response id INVALID-PARAMS "textDocument/semanticTokens/full failed")]))
+    [_ (error-response id ErrorCode-InvalidParams "textDocument/semanticTokens/full failed")]))
 
 (define (range-semantic-tokens id params)
   (match params
     [(hash-table ['textDocument (DocIdentifier-js #:uri uri)]
                  ['range (as-Range range)])
      (define safe-doc (lsp-get-doc uri))
      (semantic-tokens uri id safe-doc range)]
-    [_ (error-response id INVALID-PARAMS "textDocument/semanticTokens/range failed")]))
+    [_ (error-response id ErrorCode-InvalidParams "textDocument/semanticTokens/range failed")]))
 
 (define (semantic-tokens uri id safe-doc range)
   (define tokens

lsp/text-document.rkt

@@ -1,11 +1,12 @@
-#lang racket
+#lang racket/base
 (provide didRenameFiles
          didChangeWorkspaceFolders
          didChangeWatchedFiles
          didChangeConfiguration
          update-configuration)
 (require compiler/module-suffix
-         json)
+         json
+         racket/match)
 (require "../common/json-util.rkt"
          "../common/path-util.rkt"
          "../common/interfaces.rkt"