Moved json and lsp code into seperate modules

5 files changed, 506 insertions, 526 deletions

diff --git a/src/fromjson.sig b/src/fromjson.sig
new file mode 100644
index 00000000..3fdc1a89
--- /dev/null
+++ b/src/fromjson.sig
@@ -0,0 +1,8 @@
+signature FROMJSON = sig 
+    val getO: string -> Json.json -> Json.json option
+    val get: string -> Json.json -> Json.json
+    val asInt: Json.json -> int
+    val asString: Json.json -> string
+    val asOptionalInt: Json.json -> int option
+    val asOptionalString: Json.json -> string option
+end
diff --git a/src/fromjson.sml b/src/fromjson.sml
new file mode 100644
index 00000000..6a9bd71b
--- /dev/null
+++ b/src/fromjson.sml
@@ -0,0 +1,35 @@
+structure FromJson :> FROMJSON = struct 
+fun getO (s: string) (l: Json.json): Json.json option = 
+    case l of
+        Json.Obj pairs =>
+        (case List.find (fn tup => #1 tup = s) pairs of
+             NONE => NONE
+           | SOME tup => SOME (#2 tup))
+      | _ => raise Fail ("Expected JSON object, got: " ^ Json.print l)
+fun get (s: string) (l: Json.json): Json.json =
+        (case getO s l of
+             NONE => raise Fail ("Failed to find JSON object key " ^ s ^ " in " ^ Json.print l)
+           | SOME a => a)
+
+fun asInt (j: Json.json): int = 
+    case j of
+        Json.Int i => i
+     |  _ => raise Fail ("Expected JSON int, got: " ^ Json.print j)
+
+fun asString (j: Json.json): string =
+    case j of
+        Json.String s => s
+     |  _ => raise Fail ("Expected JSON string, got: " ^ Json.print j)
+
+fun asOptionalInt (j: Json.json): int option =
+    case j of
+        Json.Null => NONE
+     |  Json.Int i => SOME i
+     |  _ => raise Fail ("Expected JSON int or null, got: " ^ Json.print j)
+
+fun asOptionalString (j: Json.json): string option =
+    case j of
+        Json.Null => NONE
+     |  Json.String s => SOME s
+     |  _ => raise Fail ("Expected JSON string or null, got: " ^ Json.print j)
+end
diff --git a/src/lsp.sml b/src/lsp.sml
index 920f9f35..d902fed4 100644
--- a/src/lsp.sml
+++ b/src/lsp.sml
@@ -1,519 +1,8 @@
 structure C = Compiler
-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 joinStr (sep: string) (strs: string list): string =
-    List.foldl (fn (str, acc) => if acc = "" then str else acc ^ sep ^ str) "" strs
-
-structure FromJson = struct 
-fun getO (s: string) (l: Json.json): Json.json option = 
-    case l of
-        Json.Obj pairs =>
-        (case List.find (fn tup => #1 tup = s) pairs of
-             NONE => NONE
-           | SOME tup => SOME (#2 tup))
-      | _ => raise Fail ("Expected JSON object, got: " ^ Json.print l)
-fun get (s: string) (l: Json.json): Json.json =
-        (case getO s l of
-             NONE => raise Fail ("Failed to find JSON object key " ^ s ^ " in " ^ Json.print l)
-           | SOME a => a)
-
-fun asInt (j: Json.json): int = 
-    case j of
-        Json.Int i => i
-     |  _ => raise Fail ("Expected JSON int, got: " ^ Json.print j)
-
-fun asString (j: Json.json): string =
-    case j of
-        Json.String s => s
-     |  _ => raise Fail ("Expected JSON string, got: " ^ Json.print j)
-
-fun asOptionalInt (j: Json.json): int option =
-    case j of
-        Json.Null => NONE
-     |  Json.Int i => SOME i
-     |  _ => raise Fail ("Expected JSON int or null, got: " ^ Json.print j)
-
-fun asOptionalString (j: Json.json): string option =
-    case j of
-        Json.Null => NONE
-     |  Json.String s => SOME s
-     |  _ => raise Fail ("Expected JSON string or null, got: " ^ Json.print j)
-end
-
-structure LspSpec (* :> LSPSPEC *) = struct 
-  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))
-        (* 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)
-      
-end
 
 structure Lsp :> LSP = struct 
 
-
-datatype lspError = InternalError of string
-exception LspError of lspError
-fun handleLspErrorInNotification (e: lspError) : unit =
-    let
-        fun print (message: string) =
-            let
-                val jsonStr = Json.print (Json.Obj [ ("jsonrpc", Json.String "2.0")
-                                                   , ("method", Json.String "window/showMessage")
-                                                   , ("params", Json.Obj [ ("type", Json.Int 1 (* Error*))
-                                                                         , ("message", Json.String message)])
-                                                   ])
-            in
-                TextIO.print ("Content-Length:" ^ Int.toString (String.size jsonStr) ^ "\r\n\r\n" ^ jsonStr)
-            end
-    in
-        case e of
-            InternalError str => print str
-    end
-fun handleLspErrorInRequest (id: Json.json) (e: lspError): unit =
-    let
-        fun print (code: int) (message: string) =
-            let
-                val jsonStr = Json.print (Json.Obj [ ("jsonrpc", Json.String "2.0")
-                                                   , ("id", id)
-                                                   , ("error", Json.Obj [ ("code", Json.Int code (* Error*))
-                                                                        , ("message", Json.String message)])
-                                                   ])
-            in
-                TextIO.print ("Content-Length:" ^ Int.toString (String.size jsonStr) ^ "\r\n\r\n" ^ jsonStr)
-            end
-    in
-        case e of
-            InternalError str => print (~32603) str
-    end
+val debug = LspSpec.debug
 
 structure SK = struct
   type ord_key = string
@@ -614,7 +103,7 @@ fun elabFile (state: state) (fileName: string): ({ decls: Elab.decl list, envBef
         val () = Elaborate.incremental := true
         (* Parsing .urp *)
         val job = case C.run (C.transform C.parseUrp "parseUrp") (#urpPath state) of
-                      NONE => raise LspError (InternalError ("Couldn't parse .urp file at " ^ (#urpPath state)))
+                      NONE => raise LspSpec.LspError (LspSpec.InternalError ("Couldn't parse .urp file at " ^ (#urpPath state)))
                     | SOME a => a
         val moduleSearchRes =
             List.foldl
@@ -629,7 +118,7 @@ fun elabFile (state: state) (fileName: string): ({ decls: Elab.decl list, envBef
         val modulesBeforeThisFile = #1 moduleSearchRes 
         val () = if #2 moduleSearchRes
                  then ()
-                 else raise LspError (InternalError ("Couldn't find file " ^ fileName ^ " referenced in .urp file at " ^ (#urpPath state)))
+                 else raise LspSpec.LspError (LspSpec.InternalError ("Couldn't find file " ^ fileName ^ " referenced in .urp file at " ^ (#urpPath state)))
         (* Parsing .urs files of previous modules *)
         val parsedUrss = List.map (fn entry =>
                                       let
@@ -639,9 +128,9 @@ fun elabFile (state: state) (fileName: string): ({ decls: Elab.decl list, envBef
                                           , parsed =
                                             if OS.FileSys.access (fileName, [])
                                             then case C.run (C.transform C.parseUrs "parseUrs") fileName of
-                                                     NONE => raise LspError (InternalError ("Failed to parse .urs file at " ^ fileName))
+                                                     NONE => raise LspSpec.LspError (LspSpec.InternalError ("Failed to parse .urs file at " ^ fileName))
                                                    | SOME a => a
-                                            else raise LspError (InternalError ("Couldn't find an .urs file for " ^ fileName))
+                                            else raise LspSpec.LspError (LspSpec.InternalError ("Couldn't find an .urs file for " ^ fileName))
                                           }
                                       end)
                                   modulesBeforeThisFile
@@ -655,15 +144,15 @@ fun elabFile (state: state) (fileName: string): ({ decls: Elab.decl list, envBef
 
         val parsedBasisUrs =
             case C.run (C.transform C.parseUrs "parseUrs") basisF of
-                NONE => raise LspError (InternalError ("Failed to parse basis.urs file at " ^ basisF))
+                NONE => raise LspSpec.LspError (LspSpec.InternalError ("Failed to parse basis.urs file at " ^ basisF))
               | SOME a => a
         val parsedTopUrs =
             case C.run (C.transform C.parseUrs "parseUrs") topF of
-                NONE => raise LspError (InternalError ("Failed to parse top.urs file at " ^ topF))
+                NONE => raise LspSpec.LspError (LspSpec.InternalError ("Failed to parse top.urs file at " ^ topF))
               | SOME a => a
         val parsedTopUr =
             case C.run (C.transform C.parseUr "parseUr") topF' of
-                NONE => raise LspError (InternalError ("Failed to parse top.ur file at " ^ topF'))
+                NONE => raise LspSpec.LspError (LspSpec.InternalError ("Failed to parse top.ur file at " ^ topF'))
               | SOME a => a
 
         (* Parsing .ur and .urs of current file *)
@@ -1031,10 +520,10 @@ fun handleDocumentDidClose (state: state) (toclient: LspSpec.toclient) (p: LspSp
 
 fun serverLoop () =            
     let 
+        val state = !stateRef
         val requestMessage =
             LspSpec.readRequestFromStdIO ()
             handle ex => (debug (General.exnMessage ex) ; raise ex)
-        val state = !stateRef
     in
         case state of
             NONE =>
@@ -1065,7 +554,7 @@ fun serverLoop () =
           | SOME state => 
             (case requestMessage of
                 LspSpec.Notification n =>
-                ((LspSpec.handleNotification
+                (LspSpec.handleNotification
                   n
                   { initialized = fn () => ()
                   , textDocument_didOpen = fn toclient => fn p => handleDocumentSavedOrOpened state toclient (#uri (#textDocument p)) (SOME (#text (#textDocument p)))
@@ -1073,19 +562,15 @@ fun serverLoop () =
                   , textDocument_didSave = fn toclient => fn p => handleDocumentSavedOrOpened state toclient (#uri (#textDocument p)) NONE
                   , textDocument_didClose = fn toclient => fn p => handleDocumentDidClose state toclient p
                   })
-                 handle LspError e => handleLspErrorInNotification e
-                      | ex => handleLspErrorInNotification (InternalError (General.exnMessage ex)))
               | LspSpec.RequestMessage m => 
                 (* TODO should error handling here be inside handleMessage? *)
-                ((LspSpec.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
                   })
-                 handle LspError e => handleLspErrorInRequest (#id m) e
-                      | ex => handleLspErrorInRequest (#id m) (InternalError (General.exnMessage ex)))
             ) 
     end
 
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
diff --git a/src/sources b/src/sources
index c407ea2a..74171365 100644
--- a/src/sources
+++ b/src/sources
@@ -280,6 +280,11 @@ $(SRC)/getinfo.sml
 $(SRC)/json.sig
 $(SRC)/json.sml
 
+$(SRC)/fromjson.sig
+$(SRC)/fromjson.sml
+
+$(SRC)/lspspec.sml
+
 $(SRC)/lsp.sig
 $(SRC)/lsp.sml