feat: Add LSP skeleton architecture

src/stdlib/lsp/json-rpc.mc

@@ -0,0 +1,39 @@
+include "common.mc"
+include "json.mc"
+include "./utils.mc"
+
+type RPCRequest = {
+  method: String,
+  params: Map String JsonValue,
+  id: Option Int
+}
+
+type RPCError = {
+  code: Int,
+  message: String,
+  data: JsonValue
+}
+
+type RPCResult
+con RPCSuccess : JsonValue -> RPCResult
+con RPCFailure : RPCError  -> RPCResult
+
+type RPCResponse = {
+  result: RPCResult,
+  id: Int
+}
+
+let getContentLength: String -> Int = lam header.
+  match header with "Content-Length: " ++ len ++ "\n" then
+    string2int len
+  else
+    error "The JSON-RPC header could not be read, this shouldn't happen!"
+
+let getRPCRequest: JsonValue -> Option RPCRequest = lam request.
+  match request with JsonObject request in
+  let lookup = (flip mapLookup) request in
+  let id = match lookup "id" with Some JsonInt id then Some id else None () in
+  match (lookup "method", lookup "params") with (Some JsonString method, Some JsonObject params) then
+    Some { method = method, params = params, id = id }
+  else
+    None ()

src/stdlib/lsp/methods.mc

@@ -0,0 +1,8 @@
+include "./methods/unknown.mc"
+include "./methods/initialize.mc"
+
+-- To be extended with more methods
+lang LSP =
+LSPInitialize
++ LSPUnknownMethod
+end

src/stdlib/lsp/methods/initialize.mc

@@ -0,0 +1,37 @@
+include "../utils.mc"
+include "./root.mc"
+
+lang LSPInitialize = LSPRoot
+  syn Message =
+  | Initialized {}
+  | Initialize {
+    processId: Option Int,
+    locale: Option String,
+    rootPath: Option String,
+    rootUri: Option String,
+    initializationOptions: Option JsonValue,
+    trace: Option String -- 'off' | 'messages' | 'verbose'
+  }
+
+  sem getMessage request =
+  | "initialized" ->
+    Initialized {}
+  | "initialize" ->
+    let getParam = (flip mapLookup) request.params in
+
+    let processId = match getParam "processId" with JsonInt processId then Some processId else None () in
+    let locale = match getParam "locale" with JsonString locale then Some locale else None () in
+    let rootPath = match getParam "rootPath" with JsonString rootPath then Some rootPath else None () in
+    let rootUri = match getParam "rootUri" with JsonString rootUri then Some rootUri else None () in
+    let initializationOptions = getParam "initializationOptions" in
+    let trace = match getParam "trace" with JsonString trace then Some trace else None () in
+
+    Initialize {
+      processId = processId,
+      locale = locale,
+      rootPath = optionMap stripUriProtocol rootPath,
+      rootUri = optionMap stripUriProtocol rootUri,
+      initializationOptions = initializationOptions,
+      trace = trace
+    }
+end

src/stdlib/lsp/methods/root.mc

@@ -0,0 +1,7 @@
+include "../json-rpc.mc"
+
+lang LSPRoot
+  syn Message =
+
+  sem getMessage: RPCRequest -> String -> Message
+end

src/stdlib/lsp/methods/unknown.mc

@@ -0,0 +1,14 @@
+include "./root.mc"
+
+lang LSPUnknownMethod = LSPRoot
+  syn Message =
+  | UnknownMethod {
+    method: String
+  }
+
+  sem getMessage request =
+  | method ->
+    UnknownMethod {
+      method = method
+    }
+end

src/stdlib/lsp/utils.mc

@@ -0,0 +1,20 @@
+include "ext/file-ext.mc"
+
+-- returns Option content if the requested number of bytes could be read
+-- otherwise, None is returned
+let readBytesBuffered : ReadChannel -> Int -> Option [Int] =
+  lam rc. lam len.
+  recursive let work = lam remainLen. lam acc.
+    if leqi remainLen 0 then Some acc
+    else switch fileReadBytes rc remainLen
+      case Some s then
+        let acc = concat acc s in
+        let readLen = length s in
+        work (subi remainLen readLen) acc
+      case None () then None ()
+    end
+  in work len []
+
+let stripUriProtocol = lam uri. match uri
+  with "file://" ++ rest then rest
+  else uri