starlight-fsharp-oracle 0.1.0

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

@@ -0,0 +1,150 @@
+namespace FSharp.Oracle
+
+open FSharp.Compiler.Symbols
+open FSharp.Oracle.Schema
+
+module internal Helpers =
+    /// Returns everything before the last dot, e.g. "A.B.C" → "A.B".
+    /// Returns "" for unqualified names.
+    let namespaceOf (fullName: string) =
+        let lastDot = fullName.LastIndexOf('.')
+
+        if lastDot < 0 then
+            ""
+        else
+            fullName.[.. lastDot - 1]
+
+    /// Try to get FullName from a FSharpEntity; returns None for primitives
+    /// like 'string', 'int' that are F# type abbreviations with no qualified name.
+    let tryGetFullName (entity: FSharpEntity) =
+        try
+            Some entity.FullName
+        with _ ->
+            None
+
+    /// Compute a safe FullName for any entity.
+    /// Type abbreviations for primitives (e.g. `type Meters = float`) throw on FullName;
+    /// fall back to constructing it from Namespace + DisplayName.
+    let safeFullName (entity: FSharpEntity) =
+        match tryGetFullName entity with
+        | Some fullName -> fullName
+        | None ->
+            let ns = entity.Namespace |> Option.defaultValue ""
+
+            if ns = "" then
+                entity.DisplayName
+            else
+                $"{ns}.{entity.DisplayName}"
+
+    /// True for SRTP parameters (have member/static-member constraints).
+    let isSrtp (gp: FSharpGenericParameter) =
+        gp.Constraints |> Seq.exists (fun c -> c.IsMemberConstraint)
+
+    /// Display names for types that conventionally use postfix syntax in F#.
+    let postfixTypeDisplayNames =
+        Set.ofList
+            [
+                "list"
+                "option"
+                "seq"
+                "voption"
+                "ref"
+            ]
+
+    /// Full names for types that conventionally use postfix syntax in F#.
+    let postfixTypeNames =
+        Set.ofList
+            [
+                // list
+                "Microsoft.FSharp.Collections.list"
+                "Microsoft.FSharp.Collections.List"
+                "Microsoft.FSharp.Collections.FSharpList"
+                // option
+                "Microsoft.FSharp.Core.option"
+                "Microsoft.FSharp.Core.Option"
+                "Microsoft.FSharp.Core.FSharpOption"
+                // seq
+                "Microsoft.FSharp.Collections.seq"
+                "Microsoft.FSharp.Collections.Seq"
+                "System.Collections.Generic.IEnumerable"
+                "System.Collections.Generic.IEnumerable`1"
+                // voption
+                "Microsoft.FSharp.Core.voption"
+                "Microsoft.FSharp.Core.ValueOption"
+                "Microsoft.FSharp.Core.FSharpValueOption"
+                // ref
+                "Microsoft.FSharp.Core.ref"
+                "Microsoft.FSharp.Core.Ref"
+                "Microsoft.FSharp.Core.FSharpRef"
+            ]
+
+    let memberKindOf (mfv: FSharpMemberOrFunctionOrValue) =
+        if mfv.IsConstructor then
+            MemberKind.Constructor
+        elif mfv.IsProperty then
+            MemberKind.Property
+        elif mfv.LogicalName.StartsWith("op_") && not mfv.IsActivePattern then
+            MemberKind.Operator
+        else
+            MemberKind.Method
+
+    let obsoleteOf (mfv: FSharpMemberOrFunctionOrValue) : ObsoleteInfo =
+        mfv.Attributes
+        |> Seq.tryFind (fun a -> a.AttributeType.FullName = "System.ObsoleteAttribute")
+        |> function
+            | None -> ObsoleteInfo.Active
+            | Some a ->
+                a.ConstructorArguments
+                |> Seq.tryHead
+                |> Option.map (snd >> string)
+                |> function
+                    | Some "" -> ObsoleteInfo.Deprecated
+                    | Some msg -> ObsoleteInfo.DeprecatedWithMessage msg
+                    | None -> ObsoleteInfo.Deprecated
+
+    let hasAttribute (fullName: string) (entity: FSharpEntity) =
+        entity.Attributes
+        |> Seq.exists (fun a -> a.AttributeType.FullName = fullName)
+
+    let isStruct (entity: FSharpEntity) =
+        hasAttribute "Microsoft.FSharp.Core.StructAttribute" entity
+
+    let isMeasure (entity: FSharpEntity) =
+        hasAttribute "Microsoft.FSharp.Core.MeasureAttribute" entity
+
+    let obsoleteOfEntity (entity: FSharpEntity) : ObsoleteInfo =
+        entity.Attributes
+        |> Seq.tryFind (fun a -> a.AttributeType.FullName = "System.ObsoleteAttribute")
+        |> function
+            | None -> ObsoleteInfo.Active
+            | Some a ->
+                a.ConstructorArguments
+                |> Seq.tryHead
+                |> Option.map (snd >> string)
+                |> function
+                    | Some "" -> ObsoleteInfo.Deprecated
+                    | Some msg -> ObsoleteInfo.DeprecatedWithMessage msg
+                    | None -> ObsoleteInfo.Deprecated
+
+    /// Resolves XML-doc <see cref="..."/> strings to page URLs.
+    /// cref format: T:Namespace.Type or M:Namespace.Type.Member(...)
+    let resolveCref (toUrl: string -> string) (cref: string) : string option =
+        if System.String.IsNullOrWhiteSpace cref then
+            None
+        else
+            let stripped =
+                if cref.Length > 2 && cref.[1] = ':' then
+                    cref.[2..]
+                else
+                    cref
+
+            let typeName =
+                // For member refs, drop parameters and the last segment to get the type
+                let withoutParams =
+                    let paren = stripped.IndexOf('(')
+                    if paren >= 0 then stripped.[..paren - 1] else stripped
+
+                let lastDot = withoutParams.LastIndexOf('.')
+                if lastDot > 0 then withoutParams.[..lastDot - 1] else withoutParams
+
+            Some(toUrl typeName)

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

@@ -0,0 +1,172 @@
+namespace FSharp.Oracle
+
+open FSharp.Compiler.Symbols
+open FSharp.Oracle.Schema
+open Oracle.XmlDoc
+open Helpers
+open SignatureRendering
+open ParameterExtractor
+
+module internal MemberExtractor =
+    /// Builds the signature TextNode for the per-member DocEntry slot (no anchors, no indentation).
+    /// This is the pre-computed Declaration stored on Member.
+    let buildMemberDeclaration
+        (kind: MemberKind)
+        (name: string)
+        (isStatic: bool)
+        (isAbstract: bool)
+        (parameters: Parameter list list)
+        (returnType: TextNode)
+        (constraintClause: TextNode)
+        : TextNode
+        =
+        let prefixNodes =
+            match kind with
+            | MemberKind.Constructor -> [ TextNode.Keyword "new" ]
+            | MemberKind.Operator ->
+                // Operators are always static in F#
+                [
+                    TextNode.Keyword "static"
+                    TextNode.Space
+                    TextNode.Keyword "member"
+                    TextNode.Space
+                    TextNode.Text name
+                ]
+            | MemberKind.Property ->
+                if isStatic then
+                    [
+                        TextNode.Keyword "static"
+                        TextNode.Space
+                        TextNode.Keyword "property"
+                        TextNode.Space
+                        TextNode.Text name
+                    ]
+                elif isAbstract then
+                    [
+                        TextNode.Keyword "abstract"
+                        TextNode.Space
+                        TextNode.Keyword "property"
+                        TextNode.Space
+                        TextNode.Text name
+                    ]
+                else
+                    [
+                        TextNode.Keyword "property"
+                        TextNode.Space
+                        TextNode.Text name
+                    ]
+            | MemberKind.Method ->
+                if isStatic then
+                    [
+                        TextNode.Keyword "static"
+                        TextNode.Space
+                        TextNode.Keyword "member"
+                        TextNode.Space
+                        TextNode.Text name
+                    ]
+                elif isAbstract then
+                    [
+                        TextNode.Keyword "abstract"
+                        TextNode.Space
+                        TextNode.Keyword "member"
+                        TextNode.Space
+                        TextNode.Text name
+                    ]
+                else
+                    [
+                        TextNode.Keyword "member"
+                        TextNode.Space
+                        TextNode.Text name
+                    ]
+
+        let allParams = parameters |> List.collect id
+
+        let typeNodes =
+            if allParams.IsEmpty then
+                [
+                    returnType
+                    constraintClause
+                ]
+            else
+                [
+                    for i, param in List.indexed allParams do
+                        if i > 0 then
+                            yield TextNode.Space
+                            yield TextNode.Arrow
+                            yield TextNode.Space
+
+                        yield param.Declaration
+                    yield TextNode.Space
+                    yield TextNode.Arrow
+                    yield TextNode.Space
+                    yield returnType
+                    yield constraintClause
+                ]
+
+        let withGetNodes =
+            if kind = MemberKind.Property then
+                [
+                    TextNode.Space
+                    TextNode.Keyword "with"
+                    TextNode.Space
+                    TextNode.Keyword "get"
+                ]
+            else
+                []
+
+        TextNode.Node
+            [
+                yield! prefixNodes
+                yield TextNode.Space
+                yield TextNode.Colon
+                yield TextNode.Space
+                yield! typeNodes
+                yield! withGetNodes
+            ]
+
+    let extractMember
+        (toUrl: string -> string)
+        (docs: Map<string, string>)
+        (mfv: FSharpMemberOrFunctionOrValue)
+        : Member
+        =
+        let obsoleteInfo = obsoleteOf mfv
+        let kind = memberKindOf mfv
+        // Constructors are all named ".ctor" by FCS; use "new" as a canonical
+        // display name. Multiple-constructor disambiguation happens in extractEntity.
+        let name =
+            if mfv.IsConstructor then
+                "new"
+            else
+                mfv.DisplayName
+
+        let parameters = curriedParams toUrl mfv
+        let returnType = renderFSharpType toUrl false mfv.ReturnParameter.Type
+        let isStatic = mfv.IsModuleValueOrMember && not mfv.IsInstanceMember
+        let isAbstract = mfv.IsDispatchSlot
+
+        let genericParams = renderGenericParams toUrl mfv.GenericParameters
+
+        let constraintClause = stripGenericParamBrackets genericParams
+
+        {
+            Kind = kind
+            Name = name
+            FullName = mfv.FullName
+            Parameters = parameters
+            ReturnType = returnType
+            Declaration =
+                buildMemberDeclaration
+                    kind
+                    name
+                    isStatic
+                    isAbstract
+                    parameters
+                    returnType
+                    constraintClause
+            GenericParameters = genericParams
+            XmlDoc = xmlDocOf docs mfv.XmlDocSig
+            IsStatic = isStatic
+            IsAbstract = isAbstract
+            ObsoleteInfo = obsoleteInfo
+        }

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

@@ -0,0 +1,45 @@
+namespace FSharp.Oracle
+
+open FSharp.Compiler.Symbols
+open FSharp.Oracle.Schema
+open Oracle.XmlDoc
+open Helpers
+open EntityExtractor
+open ValueExtractor
+
+module internal ModuleExtractor =
+    let extractModule
+        (toUrl: string -> string)
+        (docs: Map<string, string>)
+        (entity: FSharpEntity)
+        : Module
+        =
+        let nested = entity.NestedEntities |> Seq.toList
+
+        let functions, values =
+            entity.MembersFunctionsAndValues
+            |> Seq.filter (fun m -> not m.IsCompilerGenerated)
+            |> Seq.toList
+            |> List.partition (fun m -> m.IsFunction)
+
+        let obsoleteInfo = obsoleteOfEntity entity
+
+        let entities =
+            nested
+            |> List.filter (fun e -> not e.IsFSharpModule)
+            |> List.map (extractEntity toUrl docs)
+
+        let funcs = functions |> List.map (extractFunction toUrl docs)
+        let vals = values |> List.map (extractValue toUrl docs)
+
+        {
+            Name = entity.DisplayName
+            FullName = entity.FullName
+            Namespace = namespaceOf entity.FullName
+            XmlDoc = moduleDocOf docs entity.XmlDocSig
+            Entities = entities
+            Functions = funcs
+            Values = vals
+            IsSynthetic = false
+            ObsoleteInfo = obsoleteInfo
+        }

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

@@ -0,0 +1,47 @@
+namespace FSharp.Oracle
+
+open FSharp.Compiler.Symbols
+open FSharp.Oracle.Schema
+open SignatureRendering
+
+module internal ParameterExtractor =
+    let extractParameter (toUrl: string -> string) (param: FSharpParameter) : Parameter =
+        let name = param.DisplayName
+        let typeNode = renderFSharpType toUrl false param.Type
+
+        let declaration =
+            TextNode.Node
+                [
+                    TextNode.TypeVar name
+                    TextNode.Space
+                    TextNode.Colon
+                    TextNode.Space
+                    typeNode
+                ]
+
+        {
+            Name = name
+            Type = typeNode
+            Declaration = declaration
+            AlignedDeclaration = declaration // overwritten by extractFunction once maxNameLength is known
+        }
+
+    let curriedParams (toUrl: string -> string) (mfv: FSharpMemberOrFunctionOrValue) =
+        mfv.CurriedParameterGroups
+        |> Seq.map (fun group -> group |> Seq.map (extractParameter toUrl) |> Seq.toList)
+        |> Seq.toList
+        // Drop unit-only groups for properties only — they are FCS artifacts on
+        // no-arg getters (e.g. `member _.Zero`). For real functions and methods
+        // (e.g. `let timestamp ()`) the unit group is explicit and must be kept.
+        |> List.filter (fun group ->
+            not (
+                mfv.IsProperty
+                && group.Length = 1
+                && (
+                    match group.[0].Type with
+                    | TextNode.TypeRef(name, _, _) -> name = "unit"
+                    | TextNode.Text "unit" -> true
+                    | _ -> false
+                )
+            )
+        )