Suggest unopened active-pattern cases in patterns

docs/release-notes/.FSharp.Compiler.Service/11.0.200.md

@@ -1,6 +1,7 @@
 ### Added
 
 * F# Interactive gains a JSON-RPC server mode, `--fsi-server-jsonrpc:<pipe name>`, in which a host submits interactions over a named pipe and receives structured results — diagnostics with positions, escaping exceptions, the values each interaction bound, and the session's own process id — instead of recovering them by looking for a `SERVER-PROMPT>` marker in the output text. Program output continues to flow through the redirected console streams. The pipe admits only the user running the session; `--fsi-server-client-pid:<pid>` names the host process whose exit ends the session. `FsiEvaluationSession` exposes both options as `JsonRpcServerPipeName` and `JsonRpcClientProcessId`. The mode is part of the .NET fsi only. ([PR #20396](https://github.com/dotnet/fsharp/pull/20396))
+* Include individual active-pattern cases from unopened modules in pattern completion. ([PR #20719](https://github.com/dotnet/fsharp/pull/20719))
 
 ### Fixed
 

src/Compiler/Checking/NameResolution.fsi

@@ -1001,5 +1001,7 @@ val GetVisibleNamespacesAndModulesAtPoint:
 
 val IsItemResolvable: NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> Item -> bool
 
+val ItemIsUnseen: AccessorDomain -> TcGlobals -> ImportMap -> range -> allowObsolete: bool -> Item -> bool
+
 val TrySelectExtensionMethInfoOfILExtMem:
     range -> ImportMap -> TType -> TyconRef * MethInfo * ExtensionMethodPriority -> MethInfo option

src/Compiler/Service/FSharpCheckerResults.fs

@@ -1564,10 +1564,15 @@ type internal TypeCheckInfo
             loc,
             filterCtors,
             resolveOverloads,
-            isInRangeOperator,
+            completionContext: CompletionContext option,
             allSymbols: unit -> AssemblySymbol list,
             options: FSharpCodeCompletionOptions
         ) =
+        let isInRangeOperator =
+            match completionContext with
+            | Some CompletionContext.RangeOperator -> true
+            | _ -> false
+
         let isSpread =
             FindFirstNonWhitespacePosition lineStr (colAtEndOfNamesAndResidue - 1)
             |> Option.exists (fun i ->
@@ -1761,6 +1766,19 @@ type internal TypeCheckInfo
                                         &&
 
                                         match x.Symbol with
+                                        | :? FSharpActivePatternCase as symbol ->
+                                            match symbol.Item, completionContext with
+                                            | Item.ActivePatternCase case, Some(CompletionContext.Pattern _) ->
+                                                not (
+                                                    ItemIsUnseen
+                                                        ad
+                                                        g
+                                                        ncenv.amap
+                                                        m
+                                                        options.SuggestObsoleteSymbols
+                                                        (Item.Value case.ActivePatternVal)
+                                                )
+                                            | _ -> false
                                         | :? FSharpMemberOrFunctionOrValue as m when
                                             m.IsConstructor && filterCtors = ResolveTypeNamesToTypeRefs
                                             ->
@@ -1831,6 +1849,19 @@ type internal TypeCheckInfo
             | atStart when atStart = 0 -> 0
             | otherwise -> otherwise - 1
 
+        let pos = mkPos line colAtEndOfNamesAndResidue
+
+        // Look for a "special" completion context
+        let completionContext =
+            // If the completion context we have computed higher up the stack is for the same position,
+            // reuse it, otherwise recompute
+            match completionContextAtPos with
+            | Some(contextForPos, context) when contextForPos = pos -> context
+            | _ ->
+                parseResultsOpt
+                |> Option.map (fun x -> x.ParseTree)
+                |> Option.bind (fun parseTree -> ParsedInput.TryGetCompletionContext(pos, parseTree, lineStr))
+
         let getDeclaredItemsNotInRangeOpWithAllSymbols () =
             GetDeclaredItems(
                 parseResultsOpt,
@@ -1843,24 +1874,11 @@ type internal TypeCheckInfo
                 loc,
                 filterCtors,
                 resolveOverloads,
-                false,
+                completionContext,
                 getAllSymbols,
                 options
             )
 
-        let pos = mkPos line colAtEndOfNamesAndResidue
-
-        // Look for a "special" completion context
-        let completionContext =
-            // If the completion context we have computed higher up the stack is for the same position,
-            // reuse it, otherwise recompute
-            match completionContextAtPos with
-            | Some(contextForPos, context) when contextForPos = pos -> context
-            | _ ->
-                parseResultsOpt
-                |> Option.map (fun x -> x.ParseTree)
-                |> Option.bind (fun parseTree -> ParsedInput.TryGetCompletionContext(pos, parseTree, lineStr))
-
         let res =
             match completionContext with
             // Invalid completion locations
@@ -1905,7 +1923,7 @@ type internal TypeCheckInfo
                             loc,
                             filterCtors,
                             resolveOverloads,
-                            false,
+                            None,
                             (fun () -> []),
                             options
                         )
@@ -1930,7 +1948,7 @@ type internal TypeCheckInfo
                             loc,
                             filterCtors,
                             resolveOverloads,
-                            false,
+                            None,
                             (fun () -> []),
                             options
                         )
@@ -1952,7 +1970,7 @@ type internal TypeCheckInfo
                         loc,
                         filterCtors,
                         resolveOverloads,
-                        false,
+                        None,
                         (fun () -> []),
                         options
                     )
@@ -2121,11 +2139,6 @@ type internal TypeCheckInfo
                     // because providing generic parameters list is context aware, which we don't have here (yet).
                     None
                 | _ ->
-                    let isInRangeOperator =
-                        (match cc with
-                         | Some CompletionContext.RangeOperator -> true
-                         | _ -> false)
-
                     GetDeclaredItems(
                         parseResultsOpt,
                         lineStr,
@@ -2137,7 +2150,7 @@ type internal TypeCheckInfo
                         loc,
                         filterCtors,
                         resolveOverloads,
-                        isInRangeOperator,
+                        cc,
                         getAllSymbols,
                         options
                     )
@@ -2229,7 +2242,9 @@ type internal TypeCheckInfo
                             items
 
                     let getAccessibility item =
-                        FSharpSymbol.Create(cenv, item).Accessibility
+                        match item with
+                        | Item.ActivePatternCase case -> FSharpAccessibility(case.ActivePatternVal.Accessibility)
+                        | _ -> FSharpSymbol.Create(cenv, item).Accessibility
 
                     let currentNamespaceOrModule =
                         parseResultsOpt

src/Compiler/Service/ServiceAssemblyContent.fs

@@ -12,6 +12,7 @@ open System.Collections.Generic
 open Internal.Utilities.Library
 open FSharp.Compiler.Diagnostics
 open FSharp.Compiler.IO
+open FSharp.Compiler.NameResolution
 open FSharp.Compiler.Symbols
 open FSharp.Compiler.Syntax
 
@@ -168,23 +169,33 @@ module AssemblyContent =
               UnresolvedSymbol = UnresolvedSymbol topRequireQualifiedAccessParent cleanIdents fullName ns
             })
 
-    let traverseMemberFunctionAndValues ns (parent: Parent) (membersFunctionsAndValues: seq<FSharpMemberOrFunctionOrValue>) =
+    let createFunctionOrValue ns (parent: Parent) =
         let topRequireQualifiedAccessParent = parent.TopRequiresQualifiedAccess false |> Option.map parent.FixParentModuleSuffix
+        let nearestRequireQualifiedAccessParent = parent.ThisRequiresQualifiedAccess true |> Option.map parent.FixParentModuleSuffix
         let autoOpenParent = parent.AutoOpen |> Option.map parent.FixParentModuleSuffix
+        fun fullName idents (symbol: FSharpSymbol) isActivePattern ->
+            let cleanedIdents = parent.FixParentModuleSuffix idents
+            { FullName = fullName
+              CleanedIdents = cleanedIdents
+              Namespace = ns
+              NearestRequireQualifiedAccessParent = nearestRequireQualifiedAccessParent
+              TopRequireQualifiedAccessParent = topRequireQualifiedAccessParent
+              AutoOpenParent = autoOpenParent
+              Symbol = symbol
+              Kind = fun _ -> EntityKind.FunctionOrValue isActivePattern
+              UnresolvedSymbol = UnresolvedSymbol topRequireQualifiedAccessParent cleanedIdents fullName ns }
+
+    let isPublic (symbol: FSharpSymbol) =
+        match symbol.Item with
+        | Item.ActivePatternCase case -> case.ActivePatternVal.Accessibility.IsPublic
+        | _ -> symbol.Accessibility.IsPublic
+
+    let traverseMemberFunctionAndValues (createSymbol: string -> ShortIdents -> FSharpSymbol -> bool -> AssemblySymbol) (membersFunctionsAndValues: seq<FSharpMemberOrFunctionOrValue>) =
         membersFunctionsAndValues
         |> Seq.filter (fun x -> not x.IsInstanceMember && not x.IsPropertyGetterMethod && not x.IsPropertySetterMethod)
         |> Seq.collect (fun func ->
             let processIdents fullName idents =
-                let cleanedIdents = parent.FixParentModuleSuffix idents
-                { FullName = fullName
-                  CleanedIdents = cleanedIdents
-                  Namespace = ns
-                  NearestRequireQualifiedAccessParent = parent.ThisRequiresQualifiedAccess true |> Option.map parent.FixParentModuleSuffix
-                  TopRequireQualifiedAccessParent = topRequireQualifiedAccessParent
-                  AutoOpenParent = autoOpenParent
-                  Symbol = func
-                  Kind = fun _ -> EntityKind.FunctionOrValue func.IsActivePattern
-                  UnresolvedSymbol = UnresolvedSymbol topRequireQualifiedAccessParent cleanedIdents fullName ns }
+                createSymbol fullName idents func func.IsActivePattern
 
             [ yield! func.TryGetFullDisplayName()
                      |> Option.map (fun fullDisplayName ->
@@ -252,9 +263,23 @@ module AssemblyContent =
                           Namespace = ns
                           IsModule = entity.IsFSharpModule }
 
+                    let createValue = createFunctionOrValue ns currentParent
                     match entity.TryGetMembersFunctionsAndValues() with
                     | xs when xs.Count > 0 ->
-                        yield! traverseMemberFunctionAndValues ns currentParent xs
+                        yield! traverseMemberFunctionAndValues createValue xs
+                    | _ -> ()
+
+                    match currentEntity with
+                    | Some moduleSymbol when entity.IsFSharpModule ->
+                        for case in entity.ActivePatternCases do
+                            if contentType = Full || isPublic case then
+                                let idents = Array.append moduleSymbol.CleanedIdents [| case.Name |]
+                                let symbol = createValue case.FullName idents case true
+                                let struct (_, openableNs, restIdents) =
+                                    Entity.getOpenableNamespace symbol.TopRequireQualifiedAccessParent symbol.AutoOpenParent symbol.CleanedIdents
+                                yield { symbol with
+                                            UnresolvedSymbol =
+                                                UnresolvedSymbol None (Array.append openableNs restIdents) case.FullName (Some openableNs) }
                     | _ -> ()
 
                     for e in (try entity.NestedEntities :> _ seq with _ -> Seq.empty) do
@@ -312,7 +337,7 @@ module AssemblyContent =
         |> List.filter (fun entity ->
             match contentType with
             | Full -> true
-            | Public -> entity.Symbol.Accessibility.IsPublic)
+            | Public -> isPublic entity.Symbol)
 
 type EntityCache() =
     let dic = Dictionary<AssemblyPath, AssemblyContentCacheEntry>()
@@ -325,4 +350,3 @@ type EntityCache() =
 
     member _.Clear() = dic.Clear()
     member x.Locking f = lock dic <| fun _ -> f (x :> IAssemblyContentCache)
-

src/Compiler/Service/ServiceDeclarationLists.fs

@@ -1238,8 +1238,9 @@ type DeclarationListInfo(declarations: DeclarationListItem[], isForType: bool, i
                     item.Unresolved
                     |> Option.map (fun x -> x.Namespace)
                     |> Option.bind (fun ns ->
-                        if ns |> Array.startsWith fsharpNamespace then None
-                        else Some ns)
+                        match item.Item with
+                        | Item.ActivePatternCase _ -> Some ns
+                        | _ -> if ns |> Array.startsWith fsharpNamespace then None else Some ns)
                     |> Option.map (fun ns ->
                         match currentNamespace with
                         | Some currentNs ->

src/Compiler/Service/ServiceParsedInputOps.fs

@@ -204,6 +204,24 @@ module Entity =
 
         candidateNs[0 .. nsCount - 1]
 
+    let getOpenableNamespace (requiresQualifiedAccessParent: ShortIdents option) autoOpenParent (candidate: ShortIdents) =
+        let openableNsCount =
+            match requiresQualifiedAccessParent with
+            | Some parent -> min parent.Length candidate.Length
+            | None -> candidate.Length
+
+        let fullOpenableNs = candidate[0 .. openableNsCount - 2]
+        struct (fullOpenableNs, cutAutoOpenModules autoOpenParent fullOpenableNs, candidate[openableNsCount - 1 ..])
+
+    let formatIdents idents =
+        idents
+        |> Array.map (fun ident ->
+            if IsOperatorDisplayName ident then
+                ident
+            else
+                NormalizeIdentifierBackticks ident)
+        |> String.concat "."
+
     let tryCreate
         (
             targetNamespace: ShortIdents option,
@@ -230,15 +248,8 @@ module Entity =
                 else
                     let identCount = parts.Length
 
-                    let fullOpenableNs, restIdents =
-                        let openableNsCount =
-                            match requiresQualifiedAccessParent with
-                            | Some parent -> min parent.Length candidate.Length
-                            | None -> candidate.Length
-
-                        candidate[0 .. openableNsCount - 2], candidate[openableNsCount - 1 ..]
-
-                    let openableNs = cutAutoOpenModules autoOpenParent fullOpenableNs
+                    let struct (fullOpenableNs, openableNs, restIdents) =
+                        getOpenableNamespace requiresQualifiedAccessParent autoOpenParent candidate
 
                     let getRelativeNs ns =
                         match targetNamespace, candidateNamespace with
@@ -258,8 +269,8 @@ module Entity =
                             match relativeNs with
                             | [||] -> None
                             | _ when identCount > 1 && relativeNs.Length >= identCount ->
-                                Some(relativeNs[0 .. relativeNs.Length - identCount] |> String.concat ".")
-                            | _ -> Some(relativeNs |> String.concat ".")
+                                Some(relativeNs[0 .. relativeNs.Length - identCount] |> formatIdents)
+                            | _ -> Some(formatIdents relativeNs)
 
                         let qualifier =
                             if fullRelativeName.Length > 1 && fullRelativeName.Length >= identCount then
@@ -269,13 +280,13 @@ module Entity =
 
                         Some
                             {
-                                FullRelativeName = String.concat "." fullRelativeName //.[0..fullRelativeName.Length - identCount - 1]
-                                Qualifier = String.concat "." qualifier
+                                FullRelativeName = formatIdents fullRelativeName
+                                Qualifier = formatIdents qualifier
                                 Namespace = ns
                                 FullDisplayName =
                                     match restIdents with
                                     | [| _ |] -> ""
-                                    | _ -> String.concat "." restIdents
+                                    | _ -> formatIdents restIdents
                                 LastIdent = Array.tryLast restIdents |> Option.defaultValue ""
                             })
 

src/Compiler/Service/ServiceParsedInputOps.fsi

@@ -210,6 +210,15 @@ module public ParsedInput =
     /// Corrects insertion line number based on kind of scope and text surrounding the insertion point.
     val AdjustInsertionPoint: getLineStr: (int -> string) -> ctx: InsertionContext -> pos
 
+[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
+module internal Entity =
+
+    val getOpenableNamespace:
+        requiresQualifiedAccessParent: ShortIdents option ->
+        autoOpenParent: ShortIdents option ->
+        candidate: ShortIdents ->
+            struct (ShortIdents * ShortIdents * ShortIdents)
+
 // implementation details used by other code in the compiler
 module internal SourceFileImpl =