From be644b0be6acd3cdeb957d46e9477ea3e16599ba Mon Sep 17 00:00:00 2001 From: Simon Van Casteren Date: Fri, 13 Dec 2019 11:32:02 +0100 Subject: Moved json and lsp code into seperate modules --- src/lspspec.sml | 447 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 447 insertions(+) create mode 100644 src/lspspec.sml (limited to 'src/lspspec.sml') diff --git a/src/lspspec.sml b/src/lspspec.sml new file mode 100644 index 00000000..7993038e --- /dev/null +++ b/src/lspspec.sml @@ -0,0 +1,447 @@ +structure LspSpec = struct + + datatype lspError = InternalError of string + exception LspError of lspError + + fun debug (str: string): unit = + (TextIO.output (TextIO.stdErr, str ^ "\n\n"); TextIO.flushOut TextIO.stdErr) + + fun trim (s: substring): substring = + Substring.dropr + (fn c => c = #" " orelse c = #"\n" orelse c = #"\r") + (Substring.dropl (fn c => c = #" " orelse c = #"\n" orelse c = #"\r") s) + + fun readHeader (): (string * string) option = + let + val line = TextIO.inputLine TextIO.stdIn + in + case line of + NONE => OS.Process.exit OS.Process.success + | SOME str => + if Substring.isEmpty (trim (Substring.full str)) + then NONE + else + let + val (key, value) = Substring.splitl (fn c => c <> #":") (Substring.full str) + in + if Substring.isEmpty (trim value) + then raise Fail ("Failed to parse LSP header: Line is not empty but is also not a valid header: " ^ str) + else SOME ( Substring.string (trim key) + , Substring.string (trim (Substring.dropl (fn c => c = #":") (trim value)))) + end + end + + fun readAllHeaders (): (string * string) list = + let + fun doReadAllHeaders (l: (string * string) list): (string * string) list = + case readHeader () of + NONE => l + | SOME tup => tup :: doReadAllHeaders l + + in + doReadAllHeaders [] + end + datatype message = + RequestMessage of { id: Json.json, method: string, params: Json.json} + | Notification of { method: string, params: Json.json} + fun parseMessage (j: Json.json): message = + let + val id = SOME (FromJson.get "id" j) + handle ex => NONE + val method = FromJson.asString (FromJson.get "method" j) + val params = FromJson.get "params" j + in + case id of + NONE => Notification {method = method, params = params} + | SOME id => RequestMessage {id = id, method = method, params = params} + end + + type documentUri = + { scheme: string + , authority: string + , path: string + , query: string + , fragment: string + } + fun parseDocumentUri (str: string): documentUri = + let + val str = Substring.full str + val (scheme, rest) = Substring.splitl (fn c => c <> #":") str + val (authority, rest) = Substring.splitl (fn c => c <> #"/") (Substring.triml 3 rest (* :// *)) + val (path, rest) = Substring.splitl (fn c => c <> #"?" orelse c <> #"#") rest + val (query, rest) = if Substring.first rest = SOME #"?" + then Substring.splitl (fn c => c <> #"#") (Substring.triml 1 rest (* ? *)) + else (Substring.full "", rest) + val fragment = if Substring.first rest = SOME #"#" + then (Substring.triml 1 rest (* # *)) + else Substring.full "" + + in + { scheme = Substring.string scheme + , authority = Substring.string authority + , path = Substring.string path + , query = Substring.string query + , fragment = Substring.string fragment + } + end + fun printDocumentUri (d: documentUri) = + (#scheme d) ^ "://" ^ + (#authority d) ^ + (#path d) ^ + (if #query d <> "" then "?" ^ #query d else "") ^ + (if #fragment d <> "" then "#" ^ #fragment d else "") + + type textDocumentIdentifier = { uri: documentUri} + fun parseTextDocumentIdentifier (j: Json.json): textDocumentIdentifier = + { uri = parseDocumentUri (FromJson.asString (FromJson.get "uri" j))} + + type versionedTextDocumentIdentifier = + { uri: documentUri + , version: int option + } + fun parseVersionedTextDocumentIdentifier (j: Json.json): versionedTextDocumentIdentifier = + { uri = parseDocumentUri (FromJson.asString (FromJson.get "uri" j)) + , version = FromJson.asOptionalInt (FromJson.get "version" j) + } + + type textDocumentItem = { + uri: documentUri, + languageId: string, + version: int, (* The version number of this document (it will increase after each change, including undo/redo). *) + text: string + } + fun parseTextDocumentItem (j: Json.json) = + { uri = parseDocumentUri (FromJson.asString (FromJson.get "uri" j)) + , languageId = FromJson.asString (FromJson.get "languageId" j) + , version = FromJson.asInt (FromJson.get "version" j) + , text = FromJson.asString (FromJson.get "text" j) + } + + type position = { line: int + , character: int + } + fun parsePosition (j: Json.json) = + { line = FromJson.asInt (FromJson.get "line" j) + , character = FromJson.asInt (FromJson.get "character" j) + } + fun printPosition (p: position): Json.json = Json.Obj [ ("line", Json.Int (#line p)) + , ("character", Json.Int (#character p))] + + type range = { start: position + , end_: position } + fun parseRange (j: Json.json): range = + { start = parsePosition (FromJson.get "start" j) + , end_ = parsePosition (FromJson.get "end" j) + } + fun printRange (r: range): Json.json = Json.Obj [ ("start", printPosition (#start r)) + , ("end", printPosition (#end_ r))] + + fun readRequestFromStdIO (): message = + let + val headers = readAllHeaders () + val lengthO = List.find (fn (k,v) => k = "Content-Length") headers + val request = case lengthO of + NONE => raise Fail "No header with Content-Length found" + | SOME (k, v) => + case Int.fromString v of + NONE => raise Fail ("Couldn't parse content-length from string: " ^ v) + | SOME i => TextIO.inputN (TextIO.stdIn, i) + val parsed = Json.parse request + in + parseMessage parsed + end + + type hoverReq = { textDocument: textDocumentIdentifier , position: position } + type hoverResp = {contents: string} option + fun parseHoverReq (params: Json.json): hoverReq = + { textDocument = parseTextDocumentIdentifier (FromJson.get "textDocument" params) + , position = parsePosition (FromJson.get "position" params) + } + fun printHoverResponse (resp: hoverResp): Json.json = + case resp of + NONE => Json.Null + | SOME obj => Json.Obj [("contents", Json.String (#contents obj))] + + type didOpenParams = { textDocument: textDocumentItem } + fun parseDidOpenParams (params: Json.json): didOpenParams = + { textDocument = parseTextDocumentItem (FromJson.get "textDocument" params) } + + type contentChange = { range: range option + , rangeLength: int option + , text: string } + type didChangeParams = + { textDocument: versionedTextDocumentIdentifier + , contentChanges: contentChange list + } + fun parseDidChangeParams (params: Json.json): didChangeParams = + { textDocument = parseVersionedTextDocumentIdentifier (FromJson.get "textDocument" params) + , contentChanges = case FromJson.get "contentChanges" params of + Json.Array js => + List.map (fn j => { range = Option.map parseRange (FromJson.getO "range" j) + , rangeLength = Option.map FromJson.asInt (FromJson.getO "rangeLength" j) + , text = FromJson.asString (FromJson.get "text" j) + } + ) js + | j => raise Fail ("Expected JSON array, got: " ^ Json.print j) + } + + type didSaveParams = { textDocument: textDocumentIdentifier } + fun parseDidSaveParams (params: Json.json): didSaveParams = + { textDocument = parseTextDocumentIdentifier (FromJson.get "textDocument" params) + (* , text = ... *) + } + type didCloseParams = { textDocument: textDocumentIdentifier } + fun parseDidCloseParams (params: Json.json): didCloseParams = + { textDocument = parseTextDocumentIdentifier (FromJson.get "textDocument" params) + } + type initializeParams = + { rootUri: documentUri option } + fun parseInitializeParams (j: Json.json) = + { rootUri = + Option.map + parseDocumentUri + (FromJson.asOptionalString (FromJson.get "rootUri" j)) + } + type diagnostic = { range: range + (* code?: number | string *) + , severity: int (* 1 = error, 2 = warning, 3 = info, 4 = hint*) + , source: string + , message: string + (* relatedInformation?: DiagnosticRelatedInformation[]; *) + } + fun printDiagnostic (d: diagnostic): Json.json = + Json.Obj [ ("range", printRange (#range d)) + , ("severity", Json.Int (#severity d)) + , ("source", Json.String (#source d)) + , ("message", Json.String (#message d)) + ] + type publishDiagnosticsParams = { uri: documentUri + , diagnostics: diagnostic list + } + fun printPublishDiagnosticsParams (p: publishDiagnosticsParams): Json.json = + Json.Obj [ ("uri", Json.String (printDocumentUri (#uri p))) + , ("diagnostics", Json.Array (List.map printDiagnostic (#diagnostics p)))] + + type completionReq = + { textDocument: textDocumentIdentifier + , position: position + , context: { triggerCharacter: string option + , triggerKind: int (* 1 = Invoked = typing an identifier or manual invocation or API + 2 = TriggerCharacter + 3 = TriggerForIncompleteCompletions*)} option + } + fun parseCompletionReq (j: Json.json): completionReq = + { textDocument = parseTextDocumentIdentifier (FromJson.get "textDocument" j) + , position = parsePosition (FromJson.get "position" j) + , context = case FromJson.getO "context" j of + NONE => NONE + | SOME ctx => SOME { triggerCharacter = Option.map FromJson.asString (FromJson.getO "triggerCharacter" ctx) + , triggerKind = FromJson.asInt (FromJson.get "triggerKind" ctx) + } + } + + datatype completionItemKind = Text | Method | Function | Constructor | Field | Variable | Class | Interface | Module | Property | Unit | Value | Enum | Keyword | Snippet | Color | File | Reference | Folder | EnumMember | Constant | Struct | Event | Operator | TypeParameter + fun completionItemKindToInt (a: completionItemKind) = + case a of + Text => 1 + | Method => 2 + | Function => 3 + | Constructor => 4 + | Field => 5 + | Variable => 6 + | Class => 7 + | Interface => 8 + | Module => 9 + | Property => 10 + | Unit => 11 + | Value => 12 + | Enum => 13 + | Keyword => 14 + | Snippet => 15 + | Color => 16 + | File => 17 + | Reference => 18 + | Folder => 19 + | EnumMember => 20 + | Constant => 21 + | Struct => 22 + | Event => 23 + | Operator => 24 + | TypeParameter => 25 + + type completionItem = { label: string + , kind: completionItemKind + , detail: string + } + type completionResp = { isIncomplete: bool + , items: completionItem list + } + + fun printCompletionItem (a: completionItem): Json.json = + Json.Obj [ ("label", Json.String (#label a)) + , ("kind", Json.Int (completionItemKindToInt (#kind a))) + , ("detail", Json.String (#detail a)) + ] + fun printCompletionResp (a: completionResp): Json.json = + Json.Obj [ ("isIncomplete", Json.Bool (#isIncomplete a)) + , (("items", Json.Array (List.map printCompletionItem (#items a))))] + + type initializeResponse = { capabilities: + { hoverProvider: bool + , completionProvider: {triggerCharacters: string list} option + , textDocumentSync: + { openClose: bool + , change: int (* 0 = None, 1 = Full, 2 = Incremental *) + , save: { includeText: bool } option + } + }} + fun printInitializeResponse (res: initializeResponse) = + Json.Obj [("capabilities", + let + val capabilities = #capabilities res + in + Json.Obj [ ("hoverProvider", Json.Bool (#hoverProvider capabilities)) + , ("completionProvider", case #completionProvider capabilities of + NONE => Json.Null + | SOME cp => Json.Obj [("triggerCharacters", Json.Array (List.map Json.String (#triggerCharacters cp)))] + ) + , ("textDocumentSync", + let + val textDocumentSync = #textDocumentSync capabilities + in + Json.Obj [ ("openClose", Json.Bool (#openClose textDocumentSync )) + , ("change", Json.Int (#change textDocumentSync)) + , ("save", case #save textDocumentSync of + NONE => Json.Null + | SOME save => Json.Obj [("includeText", Json.Bool (#includeText save) )])] + end + )] + end + )] + + datatype 'a result = + Success of 'a + | Error of (int * string) + + fun mapResult (f: 'a -> 'b) (a: 'a result): 'b result = + case a of + Success contents => Success (f contents) + | Error e => Error e + type toclient = { showMessage: string -> int -> unit + , publishDiagnostics: publishDiagnosticsParams -> unit } + type messageHandlers = + { initialize: initializeParams -> initializeResponse result + , shutdown: unit -> unit result + , textDocument_hover: toclient -> hoverReq -> hoverResp result + , textDocument_completion: completionReq -> completionResp result + } + + fun showMessage str typ = + let + val jsonToPrint = Json.print (Json.Obj [ ("jsonrpc", Json.String "2.0") + , ("method", Json.String "window/showMessage") + , ("params", Json.Obj [ ("type", Json.Int typ) + , ("message", Json.String str)]) + ]) + val toPrint = "Content-Length:" ^ Int.toString (String.size jsonToPrint) ^ "\r\n\r\n" ^ jsonToPrint + in + TextIO.print toPrint + end + fun publishDiagnostics diags = + let + val jsonToPrint = Json.print ((Json.Obj [ ("jsonrpc", Json.String "2.0") + , ("method", Json.String "textDocument/publishDiagnostics") + , ("params", printPublishDiagnosticsParams diags) + ])) + val toPrint = "Content-Length:" ^ Int.toString (String.size jsonToPrint) ^ "\r\n\r\n" ^ jsonToPrint + in + TextIO.print toPrint + end + val toclient: toclient = {showMessage = showMessage, publishDiagnostics = publishDiagnostics} + + fun handleMessage + (requestMessage: {id: Json.json, method: string, params: Json.json}) + (handlers: messageHandlers) + : unit = + let + val result: Json.json result = + ((case #method requestMessage of + "initialize" => + mapResult + printInitializeResponse + ((#initialize handlers) + (parseInitializeParams (#params requestMessage))) + | "textDocument/hover" => + mapResult + printHoverResponse + ((#textDocument_hover handlers) + toclient + (parseHoverReq (#params requestMessage))) + | "textDocument/completion" => + mapResult + printCompletionResp + ((#textDocument_completion handlers) + (parseCompletionReq (#params requestMessage))) + | "shutdown" => + mapResult + (fn () => Json.Null) + ((#shutdown handlers) ()) + | "exit" => + OS.Process.exit OS.Process.success + | method => (debug ("Method not supported: " ^ method); + Error (~32601, "Method not supported: " ^ method))) + handle LspError (InternalError str) => Error (~32603, str) + | ex => Error (~32603, (General.exnMessage ex)) + ) + (* val () = (TextIO.output (TextIO.stdErr, "Got result: " ^ (case result of Success _ => "success\n" *) + (* | Error _ => "error\n")); TextIO.flushOut TextIO.stdErr) *) + in + case result of + Success j => + let + val jsonToPrint = + Json.print (Json.Obj [ ("id", #id requestMessage) + , ("jsonrpc", Json.String "2.0") + , ("result", j) + ]) + val toPrint = "Content-Length:" ^ Int.toString (String.size jsonToPrint) ^ "\r\n\r\n" ^ jsonToPrint + in + TextIO.print toPrint + end + | Error (i, err) => + let + val jsonToPrint = + Json.print (Json.Obj [ ("id", #id requestMessage) + , ("jsonrpc", Json.String "2.0") + , ("error", Json.Obj [ ("code", Json.Int i) + , ("message", Json.String err) + ]) + ]) + val toPrint = "Content-Length:" ^ Int.toString (String.size jsonToPrint) ^ "\r\n\r\n" ^ jsonToPrint + in + TextIO.print toPrint + end + end + + type notificationHandlers = + { initialized: unit -> unit + , textDocument_didOpen: toclient -> didOpenParams -> unit + , textDocument_didChange: toclient -> didChangeParams -> unit + , textDocument_didSave: toclient -> didSaveParams -> unit + , textDocument_didClose: toclient -> didCloseParams -> unit + } + fun handleNotification + (notification: {method: string, params: Json.json}) + (handlers: notificationHandlers) + = + (case #method notification of + "initialized" => (#initialized handlers) () + | "textDocument/didOpen" => (#textDocument_didOpen handlers) toclient (parseDidOpenParams (#params notification)) + | "textDocument/didChange" => (#textDocument_didChange handlers) toclient (parseDidChangeParams (#params notification)) + | "textDocument/didSave" => (#textDocument_didSave handlers) toclient (parseDidSaveParams (#params notification)) + | "textDocument/didClose" => (#textDocument_didClose handlers) toclient (parseDidCloseParams (#params notification)) + | m => debug ("Notification method not supported: " ^ m)) + handle LspError (InternalError str) => showMessage str 1 + | ex => showMessage (General.exnMessage ex) 1 + +end -- cgit v1.2.3 From e74d203806efea612ef2ab33da1e561c077d6c16 Mon Sep 17 00:00:00 2001 From: Simon Van Casteren Date: Fri, 13 Dec 2019 14:44:20 +0100 Subject: Added initializationOption to specify project if multiple urp files --- src/lsp.sml | 11 ++++++++--- src/lspspec.sml | 4 +++- 2 files changed, 11 insertions(+), 4 deletions(-) (limited to 'src/lspspec.sml') diff --git a/src/lsp.sml b/src/lsp.sml index d902fed4..34137a4f 100644 --- a/src/lsp.sml +++ b/src/lsp.sml @@ -47,12 +47,17 @@ fun initState (initParams: LspSpec.initializeParams): state = val rootPath = case #rootUri initParams of NONE => raise Fail "No rootdir found" | SOME a => #path a + val optsUrpFile = + (SOME (FromJson.asString (FromJson.get "urpfile" (FromJson.get "project" (FromJson.get "urweb" (#initializationOptions initParams)))))) + handle ex => NONE val foundUrps = scanDir (fn fname => OS.Path.ext fname = SOME "urp") rootPath in { urpPath = case foundUrps of [] => raise Fail ("No .urp files found in path " ^ rootPath) | one :: [] => OS.Path.base (OS.Path.file one) - | many => raise Fail ("Found multiple .urp files in path " ^ rootPath) + | many => case List.find (fn m => SOME (OS.Path.base (OS.Path.file m)) = optsUrpFile) many of + NONE => raise Fail ("Found multiple .urp files in path " ^ rootPath) + | SOME f => OS.Path.base (OS.Path.file f) , fileStates = SM.empty } end @@ -531,8 +536,8 @@ fun serverLoop () = LspSpec.RequestMessage m => LspSpec.handleMessage m - { initialize = fn _ => - (let val st = initState (LspSpec.parseInitializeParams (#params m)) + { initialize = fn p => + (let val st = initState p in stateRef := SOME st; LspSpec.Success diff --git a/src/lspspec.sml b/src/lspspec.sml index 7993038e..fe1711f0 100644 --- a/src/lspspec.sml +++ b/src/lspspec.sml @@ -195,12 +195,14 @@ structure LspSpec = struct { textDocument = parseTextDocumentIdentifier (FromJson.get "textDocument" params) } type initializeParams = - { rootUri: documentUri option } + { rootUri: documentUri option + , initializationOptions: Json.json } fun parseInitializeParams (j: Json.json) = { rootUri = Option.map parseDocumentUri (FromJson.asOptionalString (FromJson.get "rootUri" j)) + , initializationOptions = FromJson.get "initializationOptions" j } type diagnostic = { range: range (* code?: number | string *) -- cgit v1.2.3 From 91d154f3fa8634698faea010c9d965009a76fbcb Mon Sep 17 00:00:00 2001 From: Simon Van Casteren Date: Sat, 14 Dec 2019 12:47:27 +0100 Subject: Refactored state into its own module --- src/lsp.sml | 210 +++++++++++++++++++++++++++++--------------------------- src/lspspec.sml | 23 ++++--- 2 files changed, 121 insertions(+), 112 deletions(-) (limited to 'src/lspspec.sml') diff --git a/src/lsp.sml b/src/lsp.sml index 4259c9ec..23b54a28 100644 --- a/src/lsp.sml +++ b/src/lsp.sml @@ -18,14 +18,68 @@ type state = { urpPath : string , fileStates : fileState SM.map } + +(* Wrapping this in structure as an attempt to not get concurrency bugs *) +structure State : + sig + val init: state -> unit + val insertText: string -> string -> unit + val insertElabRes: string -> ElabEnv.env -> Elab.decl list -> unit + val removeFile: string -> unit + val withState: (state -> 'a) -> 'a + end = struct val stateRef = ref (NONE: state option) +fun init (s: state) = + stateRef := SOME s +fun withState (f: state -> 'a): 'a = + case !stateRef of + NONE => raise LspSpec.LspError LspSpec.ServerNotInitialized + | SOME s => f s + +fun insertText (fileName: string) (text: string) = + withState (fn oldS => + stateRef := SOME { urpPath = #urpPath oldS + , fileStates = + case SM.find (#fileStates oldS, fileName) of + NONE => SM.insert ( #fileStates oldS + , fileName + , { text = text + , decls = [] + , envBeforeThisModule = ElabEnv.empty }) + | SOME oldfs => + SM.insert ( #fileStates oldS + , fileName + , { text = text + , decls = #decls oldfs + , envBeforeThisModule = #envBeforeThisModule oldfs }) + } + ) + +fun insertElabRes (fileName: string) (env: ElabEnv.env) decls = + withState (fn oldS => + stateRef := SOME { urpPath = #urpPath oldS + , fileStates = + case SM.find (#fileStates oldS, fileName) of + NONE => raise Fail ("No text found for file " ^ fileName) + | SOME oldfs => + SM.insert ( #fileStates oldS + , fileName + , { text = #text oldfs + , decls = decls + , envBeforeThisModule = env }) + } + ) + +fun removeFile (fileName: string) = + withState (fn oldS => + stateRef := SOME { urpPath = #urpPath oldS + , fileStates = #1 (SM.remove (#fileStates oldS, fileName)) + } + ) + +end + -fun insertFileState (state: state) (fileName: string) (fs: fileState) = - stateRef := SOME { urpPath = #urpPath state - , fileStates = SM.insert ( #fileStates state - , fileName - , fs) - } fun scanDir (f: string -> bool) (path: string) = let @@ -204,41 +258,16 @@ fun elabFile (state: state) (fileName: string): ({ decls: Elab.decl list, envBef end end -(* TODO Bad API: text0 = NONE is Save, text0 = SOME is open *) -(* TODO whole function isn't great, could use a refactor *) -fun handleDocumentSavedOrOpened (state: state) (toclient: LspSpec.toclient) (documentUri: LspSpec.documentUri) (textO: string option) = +fun elabFileAndSendDiags (state: state) (toclient: LspSpec.toclient) (documentUri: LspSpec.documentUri): unit = let val fileName = #path documentUri - val previousState = SM.find (#fileStates state, fileName) - val text = case textO of - NONE => (case previousState of - NONE => ((#showMessage toclient) ("No previous state for file " ^ fileName) 2; NONE) - | SOME previousState => SOME (#text previousState)) - | SOME text => SOME text + val res = elabFile state fileName in - case text of - NONE => () - | SOME text => - let - (* Insert text before elabFile since that can fail *) - val () = insertFileState state fileName { text = text - , envBeforeThisModule = case previousState of - NONE => ElabEnv.empty - | SOME p => #envBeforeThisModule p - , decls = case previousState of - NONE => [] - | SOME p => #decls p - } - val res = elabFile state fileName - in - (case #1 res of - NONE => () - | SOME fs => - (insertFileState state fileName { text = text - , envBeforeThisModule = #envBeforeThisModule fs - , decls = #decls fs }); - #publishDiagnostics toclient { uri = documentUri , diagnostics = #2 res}) - end + (case #1 res of + NONE => () + | SOME fs => + (State.insertElabRes fileName (#envBeforeThisModule fs) (#decls fs)); + #publishDiagnostics toclient { uri = documentUri , diagnostics = #2 res}) end fun scanDir (f: string -> bool) (path: string) = @@ -518,79 +547,56 @@ fun handleDocumentDidChange (state: state) (toclient: LspSpec.toclient) (p: LspS (debug ("Got change event for file that isn't open: " ^ fileName); (#showMessage toclient) ("Got change event for file that isn't open: " ^ fileName) 1) | SOME s => - let - val newtext = List.foldl applyContentChange (#text s) (#contentChanges p) - in - insertFileState state fileName { text = newtext - , decls = #decls s - , envBeforeThisModule = #envBeforeThisModule s} - end + State.insertText fileName (List.foldl applyContentChange (#text s) (#contentChanges p)) end -fun handleDocumentDidClose (state: state) (toclient: LspSpec.toclient) (p: LspSpec.didCloseParams): unit = - let - val fileName = #path (#uri (#textDocument p)) - val s = SM.find (#fileStates state, fileName) - in - stateRef := SOME { urpPath = #urpPath state - , fileStates = (#1 (SM.remove (#fileStates state, fileName))) handle ex => #fileStates state - } - end +fun handleRequest (requestMessage: LspSpec.message) = + case requestMessage of + LspSpec.Notification n => + (LspSpec.matchNotification + n + { initialized = fn () => () + , textDocument_didOpen = + fn (p, toclient) => State.withState (fn state => + (State.insertText (#path (#uri (#textDocument p))) (#text (#textDocument p)) ; + elabFileAndSendDiags state toclient (#uri (#textDocument p)))) + , textDocument_didChange = + fn (p, toclient) => State.withState (fn state => handleDocumentDidChange state toclient p) + , textDocument_didSave = + fn (p, toclient) => State.withState (fn state => elabFileAndSendDiags state toclient (#uri (#textDocument p))) + , textDocument_didClose = + fn (p, toclient) => State.removeFile (#path (#uri (#textDocument p))) + }) + | LspSpec.RequestMessage m => + (* TODO should error handling here be inside handleMessage? *) + (LspSpec.matchMessage + m + { initialize = fn p => + (let val st = initState p + in + State.init st; + LspSpec.Success + { capabilities = + { hoverProvider = true + , completionProvider = SOME { triggerCharacters = ["."]} + , textDocumentSync = { openClose = true + , change = 2 + , save = SOME { includeText = false } + }} + } + end) + , shutdown = fn () => LspSpec.Success () + , textDocument_hover = fn toclient => State.withState handleHover + , textDocument_completion = State.withState handleCompletion + }) fun serverLoop () = let - val state = !stateRef val requestMessage = LspSpec.readRequestFromStdIO () handle ex => (debug (General.exnMessage ex) ; raise ex) in - case state of - NONE => - (case requestMessage of - LspSpec.RequestMessage m => - LspSpec.handleMessage - m - { initialize = fn p => - (let val st = initState p - in - stateRef := SOME st; - LspSpec.Success - { capabilities = - { hoverProvider = true - , completionProvider = SOME { triggerCharacters = ["."]} - , textDocumentSync = { openClose = true - , change = 2 - , save = SOME { includeText = false } - }} - } - end) - handle (Fail str) => LspSpec.Error (~32602, str) - , shutdown = fn () => LspSpec.Error (~32002, "Server not initialized") - , textDocument_hover = fn toclient => fn _ => LspSpec.Error (~32002, "Server not initialized") - , textDocument_completion = fn _ => LspSpec.Error (~32002, "Server not initialized") - } - | LspSpec.Notification n => ()) - | SOME state => - (case requestMessage of - LspSpec.Notification n => - (LspSpec.handleNotification - n - { initialized = fn () => () - , textDocument_didOpen = fn toclient => fn p => handleDocumentSavedOrOpened state toclient (#uri (#textDocument p)) (SOME (#text (#textDocument p))) - , textDocument_didChange = handleDocumentDidChange state - , textDocument_didSave = fn toclient => fn p => handleDocumentSavedOrOpened state toclient (#uri (#textDocument p)) NONE - , textDocument_didClose = fn toclient => fn p => handleDocumentDidClose state toclient p - }) - | LspSpec.RequestMessage m => - (* TODO should error handling here be inside handleMessage? *) - (LspSpec.handleMessage - m - { initialize = fn _ => LspSpec.Error (~32600, "Server already initialized") - , shutdown = fn () => LspSpec.Success () - , textDocument_hover = fn toclient => handleHover state - , textDocument_completion = handleCompletion state - }) - ) + handleRequest requestMessage end fun startServer () = while true do serverLoop () diff --git a/src/lspspec.sml b/src/lspspec.sml index fe1711f0..bbc78606 100644 --- a/src/lspspec.sml +++ b/src/lspspec.sml @@ -1,6 +1,7 @@ structure LspSpec = struct datatype lspError = InternalError of string + | ServerNotInitialized exception LspError of lspError fun debug (str: string): unit = @@ -361,7 +362,7 @@ structure LspSpec = struct end val toclient: toclient = {showMessage = showMessage, publishDiagnostics = publishDiagnostics} - fun handleMessage + fun matchMessage (requestMessage: {id: Json.json, method: string, params: Json.json}) (handlers: messageHandlers) : unit = @@ -393,6 +394,7 @@ structure LspSpec = struct | method => (debug ("Method not supported: " ^ method); Error (~32601, "Method not supported: " ^ method))) handle LspError (InternalError str) => Error (~32603, str) + | LspError ServerNotInitialized => Error (~32002, "Server not initialized") | ex => Error (~32603, (General.exnMessage ex)) ) (* val () = (TextIO.output (TextIO.stdErr, "Got result: " ^ (case result of Success _ => "success\n" *) @@ -427,23 +429,24 @@ structure LspSpec = struct type notificationHandlers = { initialized: unit -> unit - , textDocument_didOpen: toclient -> didOpenParams -> unit - , textDocument_didChange: toclient -> didChangeParams -> unit - , textDocument_didSave: toclient -> didSaveParams -> unit - , textDocument_didClose: toclient -> didCloseParams -> unit + , textDocument_didOpen: (didOpenParams * toclient) -> unit + , textDocument_didChange: (didChangeParams * toclient) -> unit + , textDocument_didSave: (didSaveParams * toclient) -> unit + , textDocument_didClose: (didCloseParams * toclient) -> unit } - fun handleNotification + fun matchNotification (notification: {method: string, params: Json.json}) (handlers: notificationHandlers) = (case #method notification of "initialized" => (#initialized handlers) () - | "textDocument/didOpen" => (#textDocument_didOpen handlers) toclient (parseDidOpenParams (#params notification)) - | "textDocument/didChange" => (#textDocument_didChange handlers) toclient (parseDidChangeParams (#params notification)) - | "textDocument/didSave" => (#textDocument_didSave handlers) toclient (parseDidSaveParams (#params notification)) - | "textDocument/didClose" => (#textDocument_didClose handlers) toclient (parseDidCloseParams (#params notification)) + | "textDocument/didOpen" => (#textDocument_didOpen handlers) (parseDidOpenParams (#params notification), toclient) + | "textDocument/didChange" => (#textDocument_didChange handlers) (parseDidChangeParams (#params notification), toclient) + | "textDocument/didSave" => (#textDocument_didSave handlers) (parseDidSaveParams (#params notification), toclient) + | "textDocument/didClose" => (#textDocument_didClose handlers) (parseDidCloseParams (#params notification), toclient) | m => debug ("Notification method not supported: " ^ m)) handle LspError (InternalError str) => showMessage str 1 + | LspError ServerNotInitialized => showMessage "Server not initialized" 1 | ex => showMessage (General.exnMessage ex) 1 end -- cgit v1.2.3 From 028f15cce127360f29afa41754aab3816718492f Mon Sep 17 00:00:00 2001 From: Simon Van Casteren Date: Wed, 8 Jan 2020 12:12:24 +0100 Subject: Fixed smaller review remarks --- src/getinfo.sml | 8 ++++---- src/lspspec.sml | 4 +--- 2 files changed, 5 insertions(+), 7 deletions(-) (limited to 'src/lspspec.sml') diff --git a/src/getinfo.sml b/src/getinfo.sml index d84f792b..5a0fe752 100644 --- a/src/getinfo.sml +++ b/src/getinfo.sml @@ -37,7 +37,7 @@ fun isPosIn (file: string) (row: int) (col: int) (span: ErrorMsg.span) = val start = #first span val end_ = #last span in - String.isSuffix file (#file span) + OS.Path.base file = OS.Path.base (#file span) andalso (#line start < row orelse #line start = row andalso #char start <= col) @@ -281,7 +281,7 @@ fun getInfo env str fileName {line = row, character = col} = let val distanceFromRow = Int.abs (#line (#first (#2 (#3 decl))) - row) val accDistanceFromRow = case accO of - NONE => 999 + NONE => Option.getOpt (Int.maxInt, 99999) | SOME acc => Int.abs (#line (#first (#2 (#3 acc))) - row) in if distanceFromRow < accDistanceFromRow andalso distanceFromRow <= 1 @@ -368,10 +368,10 @@ fun getInfo env str fileName {line = row, character = col} = { smallestgoodpart = NONE , smallest = { item = Str (str, { file = fileName , first = { line = 0, char = 0} - , last = { line = 99999, char = 0} }) + , last = { line = Option.getOpt (Int.maxInt, 99999), char = 0} }) , span = { file = fileName , first = { line = 0, char = 0} - , last = { line = 99999, char = 0} } + , last = { line = Option.getOpt (Int.maxInt, 99999), char = 0} } , env = env } } ( L.DStr (Compiler.moduleOf "fileName", 0, (L.SgnError, ErrorMsg.dummySpan), (str, {file = fileName, first = ErrorMsg.dummyPos, last = ErrorMsg.dummyPos})) diff --git a/src/lspspec.sml b/src/lspspec.sml index bbc78606..0d766056 100644 --- a/src/lspspec.sml +++ b/src/lspspec.sml @@ -8,9 +8,7 @@ structure LspSpec = struct (TextIO.output (TextIO.stdErr, str ^ "\n\n"); TextIO.flushOut TextIO.stdErr) fun trim (s: substring): substring = - Substring.dropr - (fn c => c = #" " orelse c = #"\n" orelse c = #"\r") - (Substring.dropl (fn c => c = #" " orelse c = #"\n" orelse c = #"\r") s) + Substring.dropr Char.isSpace (Substring.dropl Char.isSpace s) fun readHeader (): (string * string) option = let -- cgit v1.2.3