lsp-bjolang/Hover.fs

/// What a hover shows for a name: its signature as written, and its doc from
/// the module's `(:doc ...)` forms, the `.bjodoc` files included, as Markdown.
module BjolangLsp.Hover

open System
open System.Text
open Bjolang
open Bjolang.Lexer
open Bjolang.Ast
open BjolangLsp.Symbols

/// A doc text's markup as Markdown. The texts use `@code{...}`, `@strong`,
/// `@em`, `@sup` and `@itemlist{@item{...} ...}`, which nest; anything else
/// after an `@` is left as it is.
let markdown (text: string) : string =
    let out = StringBuilder()

    // The index after the brace that closes the one at `start`.
    let closing (start: int) =
        let mutable depth = 0
        let mutable i = start
        let mutable found = -1

        while found < 0 && i < text.Length do
            match text[i] with
            | '{' -> depth <- depth + 1
            | '}' ->
                depth <- depth - 1
                if depth = 0 then found <- i
            | _ -> ()

            i <- i + 1

        found

    let rec go (from: int) (until: int) =
        let mutable i = from

        while i < until do
            let c = text[i]

            if c = '@' then
                let mutable j = i + 1

                while j < until && Char.IsLetter text[j] do
                    j <- j + 1

                let command = text.Substring(i + 1, j - i - 1)

                if j < until && text[j] = '{' && command <> "" then
                    let close = closing j

                    if close < 0 then
                        out.Append c |> ignore
                        i <- i + 1
                    else
                        let wrap (before: string) (after: string) =
                            out.Append before |> ignore
                            go (j + 1) close
                            out.Append after |> ignore

                        match command with
                        | "code" -> wrap "`" "`"
                        | "strong" -> wrap "**" "**"
                        | "em" -> wrap "*" "*"
                        | "sup" -> wrap "^" ""
                        | "item" -> wrap "\n- " ""
                        | "itemlist" -> wrap "" "\n"
                        | _ -> wrap ("@" + command + "{") "}"

                        i <- close + 1
                else
                    out.Append c |> ignore
                    i <- i + 1
            else
                out.Append c |> ignore
                i <- i + 1

    go 0 text.Length
    // The space between two `@item`s is left at the end of a line.
    RegularExpressions.Regex.Replace(out.ToString(), " +\n", "\n")

/// The `(: name Type)` declaration of `name` among `forms`, if it has one.
let rec private declaration (name: string) (forms: SExpr list) : SExpr option =
    forms
    |> List.tryPick (fun form ->
        match form with
        | SList(SAtom { Token = Colon } :: SAtom { Token = Symbol n } :: _, _) when n = name -> Some form
        | SList(SAtom { Token = Symbol("begin" | "module") } :: rest, _) -> declaration name rest
        | _ -> None)

/// The `(:doc ...)` entries among `forms`. One that does not read is left
/// out: the compiler reports it, and a hover has nothing to say about it.
let private entries (forms: SExpr list) : Docs.Entry list =
    forms
    |> List.filter Docs.isDocForm
    |> List.choose (fun f ->
        try
            Some(Docs.parseEntry f)
        with _ ->
            None)

let private longest = 20

/// At most `longest` lines of `text`.
let private clip (text: string) =
    let lines = text.Split('\n')

    if lines.Length <= longest then
        text
    else
        String.Join("\n", Array.truncate longest lines) + "\n…"

let private fence (code: string) = $"```lisp\n%s{code}\n```"

/// The signature: the `(: name Type)` declaration if there is one, and the
/// form's head with its parameters, as written.
let private signature (found: Found) : string =
    let s = found.Symbol
    let m = found.Module
    let declared = declaration s.Name m.Forms |> Option.map (fun d -> m.Slice(getRange d))
    let shape = m.Slice s.Signature

    let head =
        match s.Kind with
        | Kind.Function when s.Detail.StartsWith "def" -> $"(%s{s.Detail} %s{shape})"
        | Kind.Variable -> $"(%s{s.Detail} %s{shape})"
        | _ -> shape

    [ yield! Option.toList declared; yield clip head ] |> String.concat "\n" |> fence

let private docText (entry: Docs.Entry) (member': string option) : string =
    let clauses = entry.Clauses |> List.map fst

    let section (title: string) (items: string list) =
        if items.IsEmpty then [] else [ $"**%s{title}**\n\n" + String.concat "\n" items ]

    let item (name: string) (text: string) = $"- `%s{name}`: %s{markdown text}"

    [ for c in clauses do
          match c with
          | Docs.Summary t -> yield markdown t
          | _ -> ()

      // The member hovered over, documented in its type's doc.
      match member' with
      | Some name ->
          for c in clauses do
              match c with
              | Docs.Case(n, t)
              | Docs.Field(n, t) when n = name -> yield $"`%s{name}`: %s{markdown t}"
              | _ -> ()
      | None -> ()

      yield!
          section
              "Parameters"
              (clauses
               |> List.choose (function
                   | Docs.Arg(n, t) -> Some(item n t)
                   | Docs.Rest(n, t) -> Some(item $". %s{n}" t)
                   | Docs.Key(n, t) -> Some(item $"#:%s{n}" t)
                   | Docs.TParam(n, t) -> Some(item $"%%%s{n}" t)
                   | _ -> None))

      if member'.IsNone then
          yield!
              section
                  "Cases"
                  (clauses
                   |> List.choose (function
                       | Docs.Case(n, t) -> Some(item n t)
                       | _ -> None))

          yield!
              section
                  "Fields"
                  (clauses
                   |> List.choose (function
                       | Docs.Field(n, t) -> Some(item n t)
                       | _ -> None))

      for c in clauses do
          match c with
          | Docs.Returns t -> yield $"**Returns** %s{markdown t}"
          | _ -> ()

      yield!
          section
              "Raises"
              (clauses
               |> List.choose (function
                   | Docs.Raises(n, t) -> Some(item n t)
                   | _ -> None))

      for c in clauses do
          match c with
          | Docs.Example t -> yield fence (t.Trim())
          | _ -> ()

      for c in clauses do
          match c with
          | Docs.Reference t -> yield markdown t
          | _ -> ()

      for c in clauses do
          match c with
          | Docs.See names -> yield "See " + (names |> List.map (fun n -> $"`%s{n}`") |> String.concat ", ") + "."
          | _ -> () ]
    |> String.concat "\n\n"

/// The doc of what `found` is: its own, or for a constructor or field, its
/// type's, with the member's line picked out.
let private doc (found: Found) : string option =
    let all = entries found.Module.Forms
    let named (n: string) = all |> List.tryFind (fun e -> e.Subject = Docs.Named n)

    match named found.Symbol.Name with
    | Some entry -> Some(docText entry None)
    | None ->
        match found.Symbol.Kind with
        | Kind.EnumMember
        | Kind.Field ->
            named found.Symbol.Detail
            |> Option.map (fun entry -> docText entry (Some found.Symbol.Name))
        | _ -> None

/// The hover for a local name: its binding as written, and what binds it.
let local (b: Scope.Binder) (shown: string) : string =
    let what = b.Description

    let sentence = string (Char.ToUpperInvariant what[0]) + what.Substring 1
    [ fence (clip shown); $"*%s{sentence}.*" ]
    |> String.concat "\n\n"

/// The type of a builtin, one the compiler defines rather than a module, as a
/// declaration: `(: seq-unfold (-> ...))`. `None` for a name that is not one.
let builtinDeclaration (name: string) : string option =
    Prelude.prelude.Bindings
    |> Map.tryFind name
    |> Option.map (fun b ->
        let (TypedAST.Scheme(_, _, t)) = b.Scheme
        $"(: %s{name} %s{DotNetInterop.showType t})")

/// The hover for a builtin: its type, and its doc, which the prelude's docs
/// hold although the prelude does not define it.
let builtin (name: string) : string option =
    builtinDeclaration name
    |> Option.map (fun declared ->
        let entry =
            Symbols.prelude ()
            |> Option.bind (fun m -> entries m.Forms |> List.tryFind (fun e -> e.Subject = Docs.Named name))

        [ yield fence declared
          yield! entry |> Option.map (fun e -> docText e None) |> Option.toList
          yield "*Built into the compiler.*" ]
        |> String.concat "\n\n")

/// The hover for `found`: its signature, where it is, and its doc.
let text (found: Found) : string =
    let where =
        let file = IO.Path.GetFileName found.Symbol.NameRange.File

        match found.Symbol.Kind with
        | Kind.EnumMember -> $"A case of `%s{found.Symbol.Detail}`, in %s{file}."
        | Kind.Field -> $"A field of `%s{found.Symbol.Detail}`, in %s{file}."
        | Kind.Method -> $"A method of the trait `%s{found.Symbol.Detail}`, in %s{file}."
        | _ -> $"In %s{file}."

    [ yield signature found
      yield! Option.toList (doc found)
      yield $"*%s{where}*" ]
    |> String.concat "\n\n"