starlight-fsharp-oracle 0.1.0

package/packages/FSharp.Oracle/Extractor/SignatureRendering.fs

@@ -0,0 +1,464 @@
+namespace FSharp.Oracle
+
+open FSharp.Compiler.Symbols
+open FSharp.Oracle.Schema
+open Helpers
+
+module internal SignatureRendering =
+    let rec renderFSharpType
+        (toUrl: string -> string)
+        (isTopLevel: bool)
+        (typ: FSharpType)
+        : TextNode
+        =
+        if typ.IsGenericParameter then
+            let gp = typ.GenericParameter
+
+            TextNode.Node
+                [
+                    if isSrtp gp then
+                        TextNode.Text "^"
+                    else
+                        TextNode.Tick
+                    TextNode.Text gp.DisplayName
+                ]
+        elif typ.IsFunctionType then
+            let parts =
+                [
+                    for i in 0 .. typ.GenericArguments.Count - 1 do
+                        let arg = typ.GenericArguments.[i]
+
+                        if i > 0 then
+                            TextNode.Space
+                            TextNode.Arrow
+                            TextNode.Space
+
+                        renderFSharpType toUrl false arg
+                ]
+
+            if isTopLevel then
+                TextNode.Node parts
+            else
+                TextNode.Node
+                    [
+                        TextNode.LeftParen
+                        yield! parts
+                        TextNode.RightParen
+                    ]
+        elif typ.IsTupleType then
+            TextNode.Node
+                [
+                    for i in 0 .. typ.GenericArguments.Count - 1 do
+                        let arg = typ.GenericArguments.[i]
+
+                        if i > 0 then
+                            TextNode.Space
+                            TextNode.Star
+                            TextNode.Space
+
+                        renderFSharpType toUrl false arg
+                ]
+        elif typ.IsAnonRecordType then
+            let details = typ.AnonRecordTypeDetails
+            let names = details.SortedFieldNames
+            let types = typ.GenericArguments |> Seq.toArray
+
+            let fields =
+                names
+                |> Array.mapi (fun i name ->
+                    let fieldType = types.[i]
+
+                    TextNode.Node
+                        [
+                            TextNode.Text name
+                            TextNode.Space
+                            TextNode.Colon
+                            TextNode.Space
+                            renderFSharpType toUrl false fieldType
+                        ]
+                )
+                |> Array.toList
+
+            TextNode.Node
+                [
+                    yield TextNode.Text "{|"
+                    yield TextNode.Space
+                    for i, field in List.indexed fields do
+                        if i > 0 then
+                            yield TextNode.Text ";"
+                            yield TextNode.Space
+
+                        yield field
+                    yield TextNode.Space
+                    yield TextNode.Text "|}"
+                ]
+        elif typ.HasTypeDefinition && typ.GenericArguments.Count = 0 then
+            let td = typ.TypeDefinition
+
+            match tryGetFullName td with
+            | Some fullName -> TextNode.TypeRef(td.DisplayName, fullName, toUrl fullName)
+            | None -> TextNode.Text td.DisplayName
+        elif
+            typ.HasTypeDefinition
+            && typ.TypeDefinition.IsArrayType
+            && typ.GenericArguments.Count = 1
+        then
+            let arg = renderFSharpType toUrl false typ.GenericArguments.[0]
+
+            TextNode.Node
+                [
+                    arg
+                    TextNode.Text "[]"
+                ]
+        elif typ.HasTypeDefinition && typ.GenericArguments.Count = 1 then
+            let td = typ.TypeDefinition
+            let arg = renderFSharpType toUrl false typ.GenericArguments.[0]
+
+            let isPostfix =
+                Set.contains td.DisplayName postfixTypeDisplayNames
+                || match tryGetFullName td with
+                   | Some fullName -> Set.contains fullName postfixTypeNames
+                   | None -> false
+
+            if isPostfix then
+                let head =
+                    match tryGetFullName td with
+                    | Some fullName -> TextNode.TypeRef(td.DisplayName, fullName, toUrl fullName)
+                    | None -> TextNode.Text td.DisplayName
+
+                TextNode.Node
+                    [
+                        arg
+                        TextNode.Space
+                        head
+                    ]
+            else
+                let args =
+                    [
+                        for i in 0 .. typ.GenericArguments.Count - 1 do
+                            let a = typ.GenericArguments.[i]
+
+                            if i > 0 then
+                                TextNode.Comma
+                                TextNode.Space
+
+                            renderFSharpType toUrl false a
+                    ]
+
+                let head =
+                    match tryGetFullName td with
+                    | Some fullName -> TextNode.TypeRef(td.DisplayName, fullName, toUrl fullName)
+                    | None -> TextNode.Text td.DisplayName
+
+                TextNode.Node
+                    [
+                        head
+                        TextNode.LessThan
+                        yield! args
+                        TextNode.GreaterThan
+                    ]
+        elif typ.HasTypeDefinition then
+            let td = typ.TypeDefinition
+
+            let args =
+                [
+                    for i in 0 .. typ.GenericArguments.Count - 1 do
+                        let arg = typ.GenericArguments.[i]
+
+                        if i > 0 then
+                            TextNode.Comma
+                            TextNode.Space
+
+                        renderFSharpType toUrl false arg
+                ]
+
+            let head =
+                match tryGetFullName td with
+                | Some fullName -> TextNode.TypeRef(td.DisplayName, fullName, toUrl fullName)
+                | None -> TextNode.Text td.DisplayName
+
+            TextNode.Node
+                [
+                    head
+                    TextNode.LessThan
+                    yield! args
+                    TextNode.GreaterThan
+                ]
+        else
+            TextNode.Text(typ.Format FSharpDisplayContext.Empty)
+
+    /// Render a single generic parameter constraint as a TextNode list.
+    let renderConstraint
+        (toUrl: string -> string)
+        (gp: FSharpGenericParameter)
+        (c: FSharpGenericParameterConstraint)
+        : TextNode list
+        =
+        if c.IsComparisonConstraint then
+            [
+                TextNode.Colon
+                TextNode.Space
+                TextNode.Keyword "comparison"
+            ]
+        elif c.IsEqualityConstraint then
+            [
+                TextNode.Colon
+                TextNode.Space
+                TextNode.Keyword "equality"
+            ]
+        elif c.IsUnmanagedConstraint then
+            [
+                TextNode.Colon
+                TextNode.Space
+                TextNode.Keyword "unmanaged"
+            ]
+        elif c.IsNonNullableValueTypeConstraint then
+            [
+                TextNode.Colon
+                TextNode.Space
+                TextNode.Keyword "struct"
+            ]
+        elif c.IsReferenceTypeConstraint then
+            [
+                TextNode.Colon
+                TextNode.Space
+                TextNode.Keyword "not null"
+            ]
+        elif c.IsNotSupportsNullConstraint then
+            [
+                TextNode.Colon
+                TextNode.Space
+                TextNode.Keyword "not null"
+            ]
+        elif c.IsSupportsNullConstraint then
+            [
+                TextNode.Colon
+                TextNode.Space
+                TextNode.Keyword "null"
+            ]
+        elif c.IsCoercesToConstraint then
+            let ty = c.CoercesToTarget
+
+            [
+                TextNode.Text ":>"
+                TextNode.Space
+                renderFSharpType toUrl false ty
+            ]
+        elif c.IsMemberConstraint then
+            // SRTP — render simplified member constraint
+            let m = c.MemberConstraintData
+            let argTypes = m.MemberArgumentTypes |> Seq.toList
+
+            let argNodes =
+                if List.isEmpty argTypes then
+                    []
+                else
+                    [
+                        TextNode.Space
+                        for i, arg in List.indexed argTypes do
+                            if i > 0 then
+                                TextNode.Space
+                                TextNode.Star
+                                TextNode.Space
+
+                            renderFSharpType toUrl false arg
+                    ]
+
+            let retNodes =
+                let rt = m.MemberReturnType
+
+                if isNull (box rt) then
+                    []
+                elif List.isEmpty argTypes then
+                    // No args, just return type: `: ret`
+                    [
+                        TextNode.Space
+                        renderFSharpType toUrl false rt
+                    ]
+                else
+                    // Args + return type: `: args -> ret`
+                    [
+                        TextNode.Space
+                        TextNode.Arrow
+                        TextNode.Space
+                        renderFSharpType toUrl false rt
+                    ]
+
+            [
+                TextNode.Colon
+                TextNode.Space
+                TextNode.LeftParen
+                if m.MemberIsStatic then
+                    TextNode.Keyword "static member"
+                else
+                    TextNode.Keyword "member"
+                TextNode.Space
+                TextNode.Text m.MemberName
+                if not (List.isEmpty argTypes) || not (isNull (box m.MemberReturnType)) then
+                    TextNode.Space
+                    TextNode.Colon
+                    yield! argNodes
+                    yield! retNodes
+                TextNode.RightParen
+            ]
+        elif c.IsRequiresDefaultConstructorConstraint then
+            [
+                TextNode.Colon
+                TextNode.Space
+                TextNode.LeftParen
+                TextNode.Keyword "new"
+                TextNode.Space
+                TextNode.Colon
+                TextNode.Space
+                TextNode.Text "unit"
+                TextNode.Space
+                TextNode.Arrow
+                TextNode.Space
+                TextNode.Tick
+                TextNode.Text gp.DisplayName
+                TextNode.RightParen
+            ]
+        elif c.IsEnumConstraint then
+            let target = c.EnumConstraintTarget
+
+            [
+                TextNode.Colon
+                TextNode.Space
+                TextNode.Keyword "enum"
+                TextNode.LessThan
+                renderFSharpType toUrl false target
+                TextNode.GreaterThan
+            ]
+        elif c.IsDelegateConstraint then
+            [
+                TextNode.Colon
+                TextNode.Space
+                TextNode.Keyword "delegate"
+            ]
+        elif c.IsDefaultsToConstraint then
+            let data = c.DefaultsToConstraintData
+
+            [
+                TextNode.Equal
+                TextNode.Space
+                renderFSharpType toUrl false data.DefaultsToTarget
+            ]
+        elif c.IsSimpleChoiceConstraint then
+            c.SimpleChoices
+            |> Seq.map (renderFSharpType toUrl false)
+            |> Seq.toList
+            |> List.mapi (fun i tn ->
+                if i = 0 then
+                    tn
+                else
+                    TextNode.Node
+                        [
+                            TextNode.Space
+                            TextNode.Text "|"
+                            TextNode.Space
+                            tn
+                        ]
+            )
+        else
+            []
+
+    /// Render the generic-parameter list for a function or member, e.g.
+    /// `<'T when 'T : comparison>` or `<^T when ^T : (static member (+) : ^T * ^T -> ^T)>`.
+    /// Returns `None` when there are no parameters.
+    let renderGenericParams
+        (toUrl: string -> string)
+        (gps: FSharpGenericParameter seq)
+        : TextNode option
+        =
+        let gps = gps |> Seq.toList
+
+        if List.isEmpty gps then
+            None
+        else
+            let nodes =
+                [
+                    TextNode.LessThan
+                    for i, gp in List.indexed gps do
+                        if i > 0 then
+                            TextNode.Comma
+                            TextNode.Space
+                        // Use ^ only for SRTP (member constraints)
+                        if isSrtp gp then
+                            TextNode.Text "^"
+                        else
+                            TextNode.Tick
+
+                        TextNode.Text gp.DisplayName
+
+                        let constraints =
+                            gp.Constraints |> Seq.toList |> List.map (renderConstraint toUrl gp)
+
+                        if not (List.isEmpty constraints) then
+                            TextNode.Space
+                            TextNode.Keyword "when"
+                            TextNode.Space
+
+                            if isSrtp gp then
+                                TextNode.Text "^"
+                            else
+                                TextNode.Tick
+
+                            TextNode.Text gp.DisplayName
+
+                            for i, cList in List.indexed constraints do
+                                TextNode.Space
+
+                                if i > 0 then
+                                    TextNode.Keyword "and"
+                                    TextNode.Space
+
+                                    if isSrtp gp then
+                                        TextNode.Text "^"
+                                    else
+                                        TextNode.Tick
+
+                                    TextNode.Text gp.DisplayName
+                                    TextNode.Space
+
+                                for cNode in cList do
+                                    cNode
+                    TextNode.GreaterThan
+                ]
+
+            Some(TextNode.Node nodes)
+
+    /// Strip `<`, `>` and the leading type variable from a generic-parameter list,
+    /// returning only the constraint clause (e.g. ` when 'T : comparison`).
+    /// Used to append constraints after a value/member signature.
+    let stripGenericParamBrackets (genericParams: TextNode option) : TextNode =
+        match genericParams with
+        | None -> TextNode.Node []
+        | Some(TextNode.Node nodes) ->
+            let inner =
+                nodes
+                |> List.skipWhile (
+                    function
+                    | TextNode.LessThan -> true
+                    | _ -> false
+                )
+                |> List.skipWhile (
+                    function
+                    | TextNode.Tick -> true
+                    | TextNode.Text _ -> true
+                    | _ -> false
+                )
+                |> List.rev
+                |> List.skipWhile (
+                    function
+                    | TextNode.GreaterThan -> true
+                    | _ -> false
+                )
+                |> List.rev
+                |> List.skipWhile (
+                    function
+                    | TextNode.Space -> true
+                    | _ -> false
+                )
+
+            TextNode.Node(TextNode.Space :: inner)
+        | Some _ -> TextNode.Node []

package/packages/FSharp.Oracle/Extractor/ValueExtractor.fs

@@ -0,0 +1,171 @@
+namespace FSharp.Oracle
+
+open FSharp.Compiler.Symbols
+open FSharp.Oracle.Schema
+open Oracle.XmlDoc
+open Helpers
+open SignatureRendering
+open ParameterExtractor
+
+module internal ValueExtractor =
+    let extractFunction
+        (toUrl: string -> string)
+        (docs: Map<string, string>)
+        (mfv: FSharpMemberOrFunctionOrValue)
+        : Function
+        =
+        let obsoleteInfo = obsoleteOf mfv
+        let parameters = curriedParams toUrl mfv
+        let allParams = parameters |> List.collect id
+        let returnTypeNode = renderFSharpType toUrl false mfv.ReturnParameter.Type
+
+        // The colon column is determined by the longest of: function name, parameter names.
+        // Both the `val name :` line and parameter lines align their colons to this column.
+        let maxNameLength =
+            let maxParamNameLength =
+                if allParams.IsEmpty then
+                    0
+                else
+                    allParams |> List.map (fun p -> p.Name.Length) |> List.max
+
+            (max mfv.DisplayName.Length maxParamNameLength) + 1 // name + space before colon
+
+        // Compute AlignedDeclaration for each parameter now that maxNameLength is known.
+        let alignedParameters =
+            parameters
+            |> List.map (fun group ->
+                group
+                |> List.map (fun p ->
+                    { p with
+                        AlignedDeclaration =
+                            TextNode.Node
+                                [
+                                    TextNode.NewLine
+                                    TextNode.Spaces 4
+                                    TextNode.Text p.Name
+                                    TextNode.Spaces(maxNameLength - p.Name.Length)
+                                    TextNode.Colon
+                                    TextNode.Space
+                                    p.Type
+                                ]
+                    }
+                )
+            )
+
+        let genericParams = renderGenericParams toUrl mfv.GenericParameters
+
+        let isInline =
+            (mfv.InlineAnnotation = FSharpInlineAnnotation.AlwaysInline
+             || mfv.InlineAnnotation = FSharpInlineAnnotation.AggressiveInline)
+            && not mfv.IsActivePattern
+
+        let constraintClause = stripGenericParamBrackets genericParams
+
+        let valKeyword =
+            if isInline then
+                "val inline"
+            elif mfv.IsMutable then
+                "val mutable"
+            else
+                "val"
+
+        let simpleDeclaration =
+            TextNode.Node
+                [
+                    TextNode.Keyword valKeyword
+                    TextNode.Space
+                    TextNode.Text mfv.DisplayName
+                    TextNode.Space
+                    TextNode.Colon
+                ]
+
+        let alignedDeclaration =
+            TextNode.Node
+                [
+                    TextNode.Keyword valKeyword
+                    TextNode.Space
+                    TextNode.Text mfv.DisplayName
+                    TextNode.Spaces(max (maxNameLength - mfv.DisplayName.Length) 1)
+                    TextNode.Colon
+                ]
+
+        let signatureNode = renderFSharpType toUrl true mfv.FullType
+        let xmlDoc = xmlDocOf docs mfv.XmlDocSig
+
+        {
+            Name = mfv.DisplayName
+            FullName = mfv.FullName
+            Signature = signatureNode
+            Parameters = alignedParameters
+            Declaration = simpleDeclaration
+            AlignedDeclaration = alignedDeclaration
+            GenericParameters = genericParams
+            ReturnType =
+                if allParams.IsEmpty then
+                    TextNode.Node
+                        [
+                            TextNode.Space
+                            returnTypeNode
+                            constraintClause
+                        ]
+                else
+                    // The arrow aligns with the colons above:
+                    // 4 (indent) + maxNameLength
+                    TextNode.Node
+                        [
+                            TextNode.NewLine
+                            TextNode.Spaces(4 + maxNameLength)
+                            TextNode.Arrow
+                            TextNode.Space
+                            returnTypeNode
+                            constraintClause
+                        ]
+            XmlDoc = xmlDoc
+            ObsoleteInfo = obsoleteInfo
+        }
+
+    let extractValue
+        (toUrl: string -> string)
+        (docs: Map<string, string>)
+        (mfv: FSharpMemberOrFunctionOrValue)
+        : Value
+        =
+        let obsoleteInfo = obsoleteOf mfv
+        let typeNode = renderFSharpType toUrl true mfv.FullType
+        let genericParams = renderGenericParams toUrl mfv.GenericParameters
+
+        let isInline =
+            (mfv.InlineAnnotation = FSharpInlineAnnotation.AlwaysInline
+             || mfv.InlineAnnotation = FSharpInlineAnnotation.AggressiveInline)
+            && not mfv.IsActivePattern
+
+        let constraintClause = stripGenericParamBrackets genericParams
+
+        let valKeyword =
+            if isInline then
+                "val inline"
+            elif mfv.IsMutable then
+                "val mutable"
+            else
+                "val"
+
+        {
+            Name = mfv.DisplayName
+            FullName = mfv.FullName
+            Signature = typeNode
+            Declaration =
+                TextNode.Node
+                    [
+                        TextNode.Keyword valKeyword
+                        TextNode.Space
+                        TextNode.Text mfv.DisplayName
+                        TextNode.Space
+                        TextNode.Colon
+                        TextNode.Space
+                        typeNode
+                        constraintClause
+                    ]
+            GenericParameters = genericParams
+            XmlDoc = xmlDocOf docs mfv.XmlDocSig
+            ObsoleteInfo = obsoleteInfo
+        }

package/packages/FSharp.Oracle/FSharp.Oracle.fsproj

@@ -0,0 +1,36 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <OutputType>Exe</OutputType>
+    <TargetFramework>net10.0</TargetFramework>
+    <PackAsTool>true</PackAsTool>
+    <ToolCommandName>fsharp-docs-oracle</ToolCommandName>
+    <AssemblyName>Oracle</AssemblyName>
+    <RootNamespace>Oracle</RootNamespace>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="XmlDoc.fs" />
+    <Compile Include="Extractor/Helpers.fs" />
+    <Compile Include="Extractor/SignatureRendering.fs" />
+    <Compile Include="Extractor/ParameterExtractor.fs" />
+    <Compile Include="Extractor/ValueExtractor.fs" />
+    <Compile Include="Extractor/MemberExtractor.fs" />
+    <Compile Include="Extractor/EntityExtractor.fs" />
+    <Compile Include="Extractor/ModuleExtractor.fs" />
+    <Compile Include="Extractor/Assembly.fs" />
+    <Compile Include="Program.fs" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Include="FSharp.Compiler.Service" />
+    <PackageReference Include="Thoth.Json.Core.Auto" />
+    <PackageReference Include="Thoth.Json.System.Text.Json" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <ProjectReference Include="../FSharp.Oracle.Schema/FSharp.Oracle.Schema.fsproj" />
+  </ItemGroup>
+
+
+</Project>