SemanticTokens.fs

/// <summary>
/// Generation of semantic tokens
/// </summary>
/// <see href="https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocument_semanticTokens"/>
module LspExample.SemanticTokens

open System
open LspExample.Types.DemoLang

/// <summary>
/// Unit of measure for semantic token types
/// </summary>
[<Measure>]
type private Type

/// <summary>
/// Semantic tokens used by this server
/// </summary>
/// <remarks>Types should have integral values starting from 0 and increasing</remarks>
[<RequireQualifiedAccess>]
module Type =
    let String = 0u<Type>
    let Number = 1u<Type>

/// <summary>
/// The string names of the semantic token types that are used by this server. Communicated to the client on startup
/// </summary>
/// <remarks>The index of the names must match the numbers assigned in the Type module</remarks>
let tokenTypes = [| "string"; "number" |]

/// <summary>
/// Unit of measure for semantic tokens modifiers
/// </summary>
[<Measure>]
type private Modifier

/// <summary>
/// Semantic token modifiers used by this server
/// </summary>
/// <remarks>Modifiers should have numerical values based on powers of 2 because they are packed into a bit array (uint32)</remarks>
[<RequireQualifiedAccess>]
module Modifier =
    let ReadOnly = 1u<Modifier>

let private packModifiers (modifiers: uint32<Modifier>[]) = Array.sum modifiers

/// <summary>
/// The string names of the semantic token modifiers that are used by this server. Communicated to the client on startup
/// </summary>
/// <remarks>The index of the names must match the numbers assigned in the Modifier module</remarks>
let tokenModifiers = [| "readonly" |]

/// <summary>
/// A token is a range in the source code that has some semantic meaning (function/variable name, or keyword, or type for example).
/// Tokens may overlap, but they must be ordered when sent over the wire because the packed format uses relative positioning.
/// </summary>
[<Struct>]
type private Token =
    { Line: uint32
      StartChar: uint32
      Length: uint32
      TokenType: uint32<Type>
      TokenModifiers: uint32<Modifier> }

    static member create
        (line: int, column: int, length: int, tokenType: uint32<Type>, [<ParamArray>] tokenModifiers: uint32<Modifier>[]) =
        { Line = uint32 line
          StartChar = uint32 column
          Length = uint32 length
          TokenType = tokenType
          TokenModifiers = packModifiers tokenModifiers }

let private packToken (token: Token) =
    [| token.Line
       token.StartChar
       token.Length
       uint32 token.TokenType
       uint32 token.TokenModifiers |]

/// <summary>
/// Convert tokens from absolute to relative positioning
/// </summary>
/// <param name="tokens">The tokens to transform</param>
let private makeTokensRelative (tokens: #seq<Token>) : Token seq =

    if Seq.isEmpty tokens then
        Seq.empty
    else
        seq {
            yield Seq.head tokens

            yield!
                tokens
                |> Seq.pairwise
                |> Seq.map (fun (predecessor, current) ->
                    assert (predecessor.Line <= current.Line)
                    assert (predecessor.Line = current.Line || predecessor.StartChar <= current.StartChar)

                    { Token.Line = current.Line - predecessor.Line
                      Length = current.Length
                      TokenModifiers = current.TokenModifiers
                      TokenType = current.TokenType
                      StartChar =
                        if current.Line = predecessor.Line then
                            current.StartChar - predecessor.StartChar
                        else
                            current.StartChar })
        }

let private packAllTokens (tokens: #seq<Token>) : uint32[] =
    tokens |> makeTokensRelative |> Seq.collect packToken |> Seq.toArray

/// <summary>
/// Generate semantic tokens for a series of lines
/// </summary>
/// <param name="lines">Lines to generate tokens from</param>
let SemanticTokenArray (lines: #seq<Line>) : uint32[]=
    lines
    |> Seq.choose (fun line ->
        match line with
        | { Value = Empty _ } -> None
        | { Value = Number _
            Contents = contents
            Line = line } -> Some <| Token.create (line, 0, contents.Length, Type.Number, Modifier.ReadOnly)
        | { Value = Text text; Line = line } ->
            Some <| Token.create (line, 0, text.Length, Type.String, Modifier.ReadOnly))
    |> packAllTokens