LSP.fs

/// <summary>
/// The entry point for the language server program.
/// The first couple definitions are mostly boilerplate and just help with converting to/from JsonRpc
/// which is the protocol used by the LSP.
/// </summary>
/// <see href="https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/"/>
module LspExample.LSP

open System
open System.Threading.Tasks
open Ionide.LanguageServerProtocol
open Ionide.LanguageServerProtocol.JsonUtils
open LspExample
open Newtonsoft.Json
open StreamJsonRpc

let private defaultJsonRpcFormatter () =
    let jsonRpcFormatter = new JsonMessageFormatter()
    jsonRpcFormatter.JsonSerializer.NullValueHandling <- NullValueHandling.Ignore
    jsonRpcFormatter.JsonSerializer.ConstructorHandling <- ConstructorHandling.AllowNonPublicDefaultConstructor
    jsonRpcFormatter.JsonSerializer.MissingMemberHandling <- MissingMemberHandling.Ignore
    jsonRpcFormatter.JsonSerializer.Converters.Add(StrictNumberConverter())
    jsonRpcFormatter.JsonSerializer.Converters.Add(StrictStringConverter())
    jsonRpcFormatter.JsonSerializer.Converters.Add(StrictBoolConverter())
    jsonRpcFormatter.JsonSerializer.Converters.Add(SingleCaseUnionConverter())
    jsonRpcFormatter.JsonSerializer.Converters.Add(OptionConverter())
    jsonRpcFormatter.JsonSerializer.Converters.Add(ErasedUnionConverter())
    jsonRpcFormatter.JsonSerializer.ContractResolver <- OptionAndCamelCasePropertyNamesContractResolver()
    jsonRpcFormatter

let private jsonRpcFormatter = defaultJsonRpcFormatter ()

let private createRpc (handler: IJsonRpcMessageHandler) : JsonRpc =
    let rec (|HandleableException|_|) (e: exn) =
        match e with
        | :? LocalRpcException -> Some()
        | :? TaskCanceledException -> Some()
        | :? OperationCanceledException -> Some()
        | :? Newtonsoft.Json.JsonSerializationException -> Some()
        | :? System.AggregateException as aex ->
            aex.InnerExceptions |> Seq.tryHead |> Option.bind (|HandleableException|_|)
        | _ -> None

    let (|Flatten|_|) (e: exn) =
        match e with
        | :? AggregateException as aex ->
            let aex = aex.Flatten()
            aex.InnerExceptions |> Seq.tryHead |> Option.defaultValue e |> Some
        | _ -> Some e

    let strategy = StreamJsonRpc.ActivityTracingStrategy()

    { new JsonRpc(handler, ActivityTracingStrategy = strategy) with
        member this.IsFatalException(ex: Exception) =
            match ex with
            | HandleableException -> false
            | _ -> true

        member this.CreateErrorDetails(request: Protocol.JsonRpcRequest, ex: Exception) =
            let isSerializable = this.ExceptionStrategy = ExceptionProcessing.ISerializable

            match ex with
            | Flatten(:? Newtonsoft.Json.JsonSerializationException as ex) ->

                let data: obj = if isSerializable then ex else Protocol.CommonErrorData(ex)

                Protocol.JsonRpcError.ErrorDetail(
                    Code = Protocol.JsonRpcErrorCode.ParseError,
                    Message = ex.Message,
                    Data = data
                )
            | _ -> base.CreateErrorDetails(request, ex) }

/// Start the LSP server
let private startCore () =

    // The LSP protocol takes over stdio. DO NOT read from or write to stdio under ANY circumstances.
    // The process will terminate if you do. To send messages to the user, use the Client type.
    let input = Console.OpenStandardInput()
    let output = Console.OpenStandardOutput()

    /// Create the handlers that we can work with. Custom extensions can be added here if desired.
    /// See the F# Ionide language server (FsAutoComplete) for examples on how to add custom request types
    /// https://github.com/ionide/FsAutoComplete/blob/9b8de8c575faaa6016ffe69236686d83fe7e0e56/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs#L3206
    let requestHandlings: Map<string, Mappings.ServerRequestHandling<_>> =
        Ionide.LanguageServerProtocol.Server.defaultRequestHandlings ()

    use jsonRpcHandler =
        new HeaderDelimitedMessageHandler(output, input, defaultJsonRpcFormatter ())

    // Start the server process
    // Do some bootstrapping by injecting the dependencies
    Server.start
        requestHandlings
        input
        output
        // Create the client. It is provided notifier and requester which are used to send messages to the actual separate client process.
        (fun (notifier, requester) -> new Client(notifier, requester))
        // The created client will be provided to the server initializer here which is where the LSP logic happens.
        (fun client -> new Server(client))
        createRpc

let private StartLanguageServer () =
    try
        let result = startCore ()
        int result
    with ex ->
        eprintfn $"Language server crashed with: %A{ex}"
        raise ex

[<EntryPoint>]
let main args = StartLanguageServer()