A language server for Bjolang

Runs the compiler in-process against the Bjolang checkout beside it, and
answers diagnostics, an outline, go to definition, hover and completion,
plus a request of its own for macro expansion.

Diagnostics come from the compiler's own check of the editor's text,
saved or not: on open, on save, and 400 ms after typing pauses. The
outline, definitions, hovers and completions read only as far as the
reader, with no type checking, so they answer on every request: the
top-level names of the file, its imports and the prelude, local names
from the binding forms the parser knows, the declarations and docs as
written, and the builtins with their types. emacs/bjolang-lsp.el shows a
macro call's expansion, one step or all of it, in a buffer.

test/smoke.py drives the server as an editor would.

🤖 Generated with [ECA](https://eca.dev)

Co-Authored-By: eca-agent <git@eca.dev>

Check.fs

@@ -0,0 +1,177 @@
+/// Checking one file with the compiler's frontend, and turning what it
+/// collected into LSP diagnostics.
+module BjolangLsp.Check
+
+open System
+open System.IO
+open System.Text.Json.Nodes
+open System.Text.RegularExpressions
+open Bjolang
+
+/// A diagnostic as the client gets it: 0-based lines and columns, end
+/// exclusive.
+type Found =
+    { Line: int
+      Column: int
+      EndLine: int
+      EndColumn: int
+      IsError: bool
+      Message: string }
+
+/// `at file.bjo:12` or `at file.bjo:12:3`, as `Lexer.formatPos` and
+/// `Lexer.formatAt` write a location into a message.
+let private location = Regex(@"\n?\s*\bat (\S+?):(\d+)(?::(\d+))?\s*$", RegexOptions.Multiline)
+
+let private firstLocation = Regex(@"\bat (\S+?):(\d+)(?::(\d+))?")
+
+/// The message with the location lines the compiler appends taken off, since
+/// the client shows the location as the diagnostic's range.
+let private withoutLocations (message: string) = location.Replace(message, "").TrimEnd()
+
+let private wholeLine (line: int) =
+    {| Line = line; Column = 0; EndLine = line + 1; EndColumn = 0 |}
+
+/// Where a diagnostic is, if it is in `file`. Anywhere else, such as in an
+/// imported module, it is `None`, and the caller puts it at the top of `file`
+/// with the location left in the message.
+let private placeIn (file: string) (d: Diagnostics.Diagnostic) =
+    let sameFile (other: string) =
+        // A range carries the full path; a location read from a message only
+        // the file name, which is all `Lexer.formatPos` writes.
+        if Path.IsPathRooted other then
+            Path.GetFullPath other = Path.GetFullPath file
+        else
+            other = Path.GetFileName file
+
+    match d.Where with
+    | Some r when sameFile r.File ->
+        // The lexer's lines are 1-based and its columns 0-based, as LSP's are.
+        let line = max 0 (r.Start.Line - 1)
+        let column = r.Start.Column
+        let endLine = max line (r.End.Line - 1)
+        let endColumn = r.End.Column
+
+        // A range with no width is still something to underline: the rest of
+        // its line.
+        if endLine = line && endColumn <= column then
+            Some {| Line = line; Column = column; EndLine = line + 1; EndColumn = 0 |}
+        else
+            Some {| Line = line; Column = column; EndLine = endLine; EndColumn = endColumn |}
+    | Some _ -> None
+    | None ->
+        let m = firstLocation.Match d.Message
+
+        if m.Success && sameFile m.Groups[1].Value then
+            let line = max 0 (int m.Groups[2].Value - 1)
+
+            if m.Groups[3].Success then
+                let column = max 0 (int m.Groups[3].Value - 1)
+                Some {| Line = line; Column = column; EndLine = line + 1; EndColumn = 0 |}
+            else
+                Some(wholeLine line)
+        else
+            None
+
+let private found (file: string) (d: Diagnostics.Diagnostic) : Found =
+    let isError = d.Severity = Diagnostics.Error
+
+    match placeIn file d with
+    | Some p ->
+        { Line = p.Line
+          Column = p.Column
+          EndLine = p.EndLine
+          EndColumn = p.EndColumn
+          IsError = isError
+          Message = withoutLocations d.Message }
+    | None ->
+        let where =
+            match d.Where with
+            | Some r -> $"\n  at %s{Lexer.formatPos r}"
+            | None -> ""
+
+        let p = wholeLine 0
+
+        { Line = p.Line
+          Column = p.Column
+          EndLine = p.EndLine
+          EndColumn = p.EndColumn
+          IsError = isError
+          Message = d.Message + where }
+
+let private options: Build.Options =
+    { IsLibrary = false
+      Debug = false
+      Runtime = []
+      EmitCs = None
+      Check = true }
+
+/// Checks `file` as `bjolang --check` does, reading every file in `buffers`,
+/// by full path, from there rather than from disk: the editor's unsaved text,
+/// of the file and of any include or doc file that is open too.
+///
+/// In `Session.isolated`, so that one check leaves nothing behind for the
+/// next, and in `Diagnostics.captured`, so that what the compiler prints goes
+/// to a buffer rather than into the protocol. The buffer is only read when the
+/// check failed with nothing collected: a failure the compiler printed rather
+/// than recorded, such as a bug in it, which would otherwise fail silently.
+let file (buffers: Map<string, string>) (path: string) : Found list =
+    Diagnostics.verbose <- false
+    Diagnostics.reset ()
+    Paths.sourceOverrides <- buffers
+
+    let status, printed =
+        try
+            Diagnostics.captured (fun () ->
+                try
+                    Expansion.recording path (fun () -> Session.isolated (fun () -> Build.compile options path))
+                with ex ->
+                    printfn "%s" (Diagnostics.humanize ex.Message)
+                    1)
+        finally
+            Paths.sourceOverrides <- Map.empty
+
+    // With BJOLANG_TIMING set, where the check's time went, to the log.
+    if Timing.enabled then
+        let _, report = Diagnostics.captured Timing.report
+        Rpc.log report
+
+    let collected = Diagnostics.snapshot () |> List.map (found path)
+
+    if status <> 0 && not (collected |> List.exists (fun f -> f.IsError)) then
+        let message =
+            match printed.Trim() with
+            | "" -> "The check failed and said nothing about why."
+            | text -> text
+
+        collected
+        @ [ { Line = 0
+              Column = 0
+              EndLine = 1
+              EndColumn = 0
+              IsError = true
+              Message = message } ]
+    else
+        collected
+
+/// The `textDocument/publishDiagnostics` parameters for `uri`.
+let publishParams (uri: string) (found: Found list) : JsonNode =
+    let position (line: int) (character: int) =
+        JsonObject(dict [ "line", JsonValue.Create line :> JsonNode; "character", JsonValue.Create character ])
+
+    let diagnostic (f: Found) =
+        JsonObject(
+            dict
+                [ "range",
+                  JsonObject(dict [ "start", position f.Line f.Column :> JsonNode; "end", position f.EndLine f.EndColumn ])
+                  :> JsonNode
+                  "severity", JsonValue.Create(if f.IsError then 1 else 2)
+                  "source", JsonValue.Create "bjolang"
+                  "message", JsonValue.Create f.Message ]
+        )
+        :> JsonNode
+
+    JsonObject(
+        dict
+            [ "uri", JsonValue.Create uri :> JsonNode
+              "diagnostics", JsonArray(found |> List.map diagnostic |> Array.ofList) ]
+    )