lsp-bjolang/Check.fs

/// 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 = { Build.dependencyOptions with IsLibrary = false; 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) ]
    )