Add call hierarchy helpers and tests for outgoing calls in local functions, operators, and properties

Author: TheAngryByrd

src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs

@@ -44,12 +44,56 @@ open System.Threading.Tasks
 open FsAutoComplete.FCSPatches
 open Helpers
 open System.Runtime.ExceptionServices
+open FSharp.Compiler.CodeAnalysis
 
 module ArrayHelpers =
   let (|EmptyArray|NonEmptyArray|) (a: 'a array) = if a.Length = 0 then EmptyArray else NonEmptyArray a
 
 open ArrayHelpers
 
+module CallHierarchyHelpers =
+  /// Determines if a symbol represents a callable (function, method, constructor, or applicable entity)
+  let isCallableSymbol (symbol: FSharpSymbol) =
+    match symbol with
+    | :? FSharpMemberOrFunctionOrValue as mfv ->
+      mfv.IsFunction
+      || mfv.IsMethod
+      || mfv.IsConstructor
+      || (mfv.IsProperty && not (mfv.LogicalName.Contains("get_") || mfv.LogicalName.Contains("set_")))
+    | :? FSharpEntity as ent ->
+      ent.IsClass || ent.IsFSharpRecord || ent.IsFSharpUnion
+    | _ -> false
+
+  /// Filters symbol uses to those within a binding range that represent outgoing calls
+  let getOutgoingCallsInBinding (bindingRange: Range) (pos: FSharp.Compiler.Text.Position) (allSymbolUses: FSharpSymbolUse seq) =
+    allSymbolUses
+    |> Seq.filter (fun su ->
+      Range.rangeContainsRange bindingRange su.Range
+      && not su.IsFromDefinition
+      && su.Range.Start <> pos
+      && isCallableSymbol su.Symbol)
+    |> Seq.toArray
+
+  /// Gets the appropriate SymbolKind for a given FSharpSymbol
+  let getSymbolKind (symbol: FSharpSymbol) =
+    match symbol with
+    | :? FSharpMemberOrFunctionOrValue as mfv ->
+      if mfv.IsConstructor then SymbolKind.Constructor
+      elif mfv.IsProperty then SymbolKind.Property
+      elif mfv.IsMethod then SymbolKind.Method
+      elif mfv.IsEvent then SymbolKind.Event
+      else SymbolKind.Function
+    | :? FSharpEntity as ent ->
+      if ent.IsClass then SymbolKind.Class
+      elif ent.IsInterface then SymbolKind.Interface
+      elif ent.IsFSharpModule then SymbolKind.Module
+      elif ent.IsEnum then SymbolKind.Enum
+      elif ent.IsValueType then SymbolKind.Struct
+      else SymbolKind.Object
+    | _ -> SymbolKind.Function
+
+open CallHierarchyHelpers
+
 type AdaptiveFSharpLspServer
   (
     workspaceLoader: IWorkspaceLoader,
@@ -2218,31 +2262,12 @@ type AdaptiveFSharpLspServer
             let allSymbolUses = tyRes.GetCheckResults.GetAllUsesOfAllSymbolsInFile()
 
             // Filter to symbol uses within the function body, focusing only on calls
-            let bodySymbolUses =
-              allSymbolUses
-              |> Seq.filter (fun su ->
-                Range.rangeContainsRange bindingRange su.Range
-                && not su.IsFromDefinition
-                && su.Range.Start <> pos
-                // Filter to only include actual function/method calls, not parameter references or type annotations
-                && match su.Symbol with
-                   | :? FSharpMemberOrFunctionOrValue as mfv ->
-                     // Include functions, methods, constructors but be careful with parameters vs calls
-                     mfv.IsFunction
-                     || mfv.IsMethod
-                     || mfv.IsConstructor
-                     || (mfv.IsProperty
-                         && not (mfv.LogicalName.Contains("get_") || mfv.LogicalName.Contains("set_")))
-                   | :? FSharpEntity as ent ->
-                     // Include entities only if used as constructors (when they appear in expressions)
-                     ent.IsClass || ent.IsFSharpRecord || ent.IsFSharpUnion
-                   | _ -> false)
-              |> Seq.toArray
+            let bodySymbolUses = getOutgoingCallsInBinding bindingRange pos allSymbolUses
 
             // Group symbol uses by the called symbol
             let groupedBySymbol = bodySymbolUses |> Array.groupBy (fun su -> su.Symbol.FullName)
 
-            let createOutgoingCallItem (_symbolName: string, uses: FSharp.Compiler.CodeAnalysis.FSharpSymbolUse[]) =
+            let createOutgoingCallItem (_symbolName: string, uses: FSharpSymbolUse[]) =
               asyncOption {
                 if uses.Length = 0 then
                   do! None
@@ -2260,20 +2285,8 @@ type AdaptiveFSharpLspServer
                     let targetFile = declLoc.FileName |> Utils.normalizePath
                     let targetUri = Path.LocalPathToUri targetFile
 
-                    // Get symbol kind
-                    let symbolKind =
-                      match symbol with
-                      | :? FSharpMemberOrFunctionOrValue as mfv ->
-                        if mfv.IsConstructor then SymbolKind.Constructor
-                        elif mfv.IsProperty then SymbolKind.Property
-                        elif mfv.IsMethod then SymbolKind.Method
-                        else SymbolKind.Function
-                      | :? FSharpEntity as ent ->
-                        if ent.IsClass then SymbolKind.Class
-                        elif ent.IsInterface then SymbolKind.Interface
-                        elif ent.IsFSharpModule then SymbolKind.Module
-                        else SymbolKind.Object
-                      | _ -> SymbolKind.Function
+                    // Get symbol kind using helper
+                    let symbolKind = getSymbolKind symbol
 
                     let displayName = symbol.DisplayName
                     let detail = $"In {System.IO.Path.GetFileName(UMX.untag targetFile)}"
@@ -2291,7 +2304,7 @@ type AdaptiveFSharpLspServer
                     // Symbol without declaration location (e.g., built-in functions)
                     Some
                       { CallHierarchyItem.Name = symbol.DisplayName
-                        Kind = SymbolKind.Function
+                        Kind = getSymbolKind symbol
                         Tags = None
                         Detail = Some "Built-in"
                         Uri = p.Item.Uri // Use current file as fallback

test/FsAutoComplete.Tests.Lsp/CallHierarchyTests.fs

@@ -201,6 +201,108 @@ let outgoingTests createServer =
           "Should find higher-order function calls"
       }
 
+      testCaseAsync "OperatorExample - Custom operator calls"
+      <| async {
+        let! (aDoc, _) = Server.openDocument "OperatorExample.fsx" server
+        use aDoc = aDoc
+        let! server = server
+
+        // Test outgoing calls from main function (line 10, character 4 - on the function name)
+        let prepareParams = CallHierarchyPrepareParams.create aDoc.Uri 10u 4u
+
+        let! prepareResult =
+          server.Server.TextDocumentPrepareCallHierarchy prepareParams
+          |> Async.map resultOptionGet
+
+        Expect.equal prepareResult.Length 1 "Should find one symbol"
+        Expect.equal prepareResult[0].Name "main" "Should find main function"
+
+        let outgoingParams: CallHierarchyOutgoingCallsParams =
+          { Item = prepareResult[0]
+            PartialResultToken = None
+            WorkDoneToken = None }
+
+        let! outgoingResult =
+          server.Server.CallHierarchyOutgoingCalls outgoingParams
+          |> Async.map resultOptionGet
+
+        Expect.isGreaterThan outgoingResult.Length 0 "Should find outgoing calls"
+
+        // Should find calls to custom operators ++ and |>>
+        let callNames = outgoingResult |> Array.map (fun call -> call.To.Name)
+        Expect.isTrue
+          (callNames |> Array.exists (fun name -> name.Contains("++") || name = "op_PlusPlus"))
+          "Should find call to custom ++ operator"
+      }
+
+      testCaseAsync "LocalFunctionExample - Local function calls"
+      <| async {
+        let! (aDoc, _) = Server.openDocument "LocalFunctionExample.fsx" server
+        use aDoc = aDoc
+        let! server = server
+
+        // Test outgoing calls from outerFunction (line 2, character 4 - on the function name)
+        let prepareParams = CallHierarchyPrepareParams.create aDoc.Uri 2u 4u
+
+        let! prepareResult =
+          server.Server.TextDocumentPrepareCallHierarchy prepareParams
+          |> Async.map resultOptionGet
+
+        Expect.equal prepareResult.Length 1 "Should find one symbol"
+        Expect.equal prepareResult[0].Name "outerFunction" "Should find outerFunction"
+
+        let outgoingParams: CallHierarchyOutgoingCallsParams =
+          { Item = prepareResult[0]
+            PartialResultToken = None
+            WorkDoneToken = None }
+
+        let! outgoingResult =
+          server.Server.CallHierarchyOutgoingCalls outgoingParams
+          |> Async.map resultOptionGet
+
+        Expect.isGreaterThan outgoingResult.Length 0 "Should find outgoing calls"
+
+        // Should find calls to local functions
+        let callNames = outgoingResult |> Array.map (fun call -> call.To.Name)
+        Expect.contains callNames "localHelper" "Should find call to localHelper"
+        Expect.contains callNames "localProcessor" "Should find call to localProcessor"
+        Expect.contains callNames "nestedOuter" "Should find call to nestedOuter"
+      }
+
+      testCaseAsync "PropertyExample - Property and method calls"
+      <| async {
+        let! (aDoc, _) = Server.openDocument "PropertyExample.fsx" server
+        use aDoc = aDoc
+        let! server = server
+
+        // Test outgoing calls from main function (line 18 1-indexed = line 17 0-indexed, character 4 - on the function name)
+        let prepareParams = CallHierarchyPrepareParams.create aDoc.Uri 17u 4u
+
+        let! prepareResult =
+          server.Server.TextDocumentPrepareCallHierarchy prepareParams
+          |> Async.map resultOptionGet
+
+        Expect.equal prepareResult.Length 1 "Should find one symbol"
+        Expect.equal prepareResult[0].Name "main" "Should find main function"
+
+        let outgoingParams: CallHierarchyOutgoingCallsParams =
+          { Item = prepareResult[0]
+            PartialResultToken = None
+            WorkDoneToken = None }
+
+        let! outgoingResult =
+          server.Server.CallHierarchyOutgoingCalls outgoingParams
+          |> Async.map resultOptionGet
+
+        Expect.isGreaterThan outgoingResult.Length 0 "Should find outgoing calls"
+
+        // Should find calls to methods
+        let callNames = outgoingResult |> Array.map (fun call -> call.To.Name)
+        Expect.contains callNames "Increment" "Should find call to Increment method"
+        Expect.contains callNames "GetDouble" "Should find call to GetDouble method"
+        Expect.contains callNames "createPerson" "Should find call to createPerson function"
+      }
+
       testCaseAsync "RecursiveExample1 - Simple recursion and mutual recursion"
       <| async {
         let! (aDoc, _) = Server.openDocument "RecursiveExample1.fsx" server

test/FsAutoComplete.Tests.Lsp/TestCases/CallHierarchy/OutgoingCalls/LocalFunctionExample.fsx

@@ -0,0 +1,24 @@
+module LocalFunctionExample
+
+let outerFunction x =
+  // Local function definition
+  let localHelper y = y * 2
+
+  // Another local function that calls the first
+  let localProcessor z =
+    let doubled = localHelper z
+    doubled + 1
+
+  // Nested local function
+  let nestedOuter a =
+    let nestedInner b = b + 10
+    nestedInner a + localHelper a
+
+  // Using local functions - these should be detected as outgoing calls
+  let result1 = localHelper x
+  let result2 = localProcessor x
+  let result3 = nestedOuter x
+
+  result1 + result2 + result3
+
+ignore outerFunction

test/FsAutoComplete.Tests.Lsp/TestCases/CallHierarchy/OutgoingCalls/OperatorExample.fsx

@@ -0,0 +1,22 @@
+module OperatorExample
+
+// Custom operator definition
+let (++) x y = x + y + 1
+
+// Another custom operator
+let (|>>) x f = f x |> f
+
+let double x = x * 2
+
+let main () =
+  // Using custom operators - these should be detected as outgoing calls
+  let a = 1 ++ 2
+  let b = 3 ++ 4
+  let c = a ++ b
+
+  // Piping with custom operator
+  let d = 5 |>> double
+
+  c + d
+
+ignore main

test/FsAutoComplete.Tests.Lsp/TestCases/CallHierarchy/OutgoingCalls/PropertyExample.fsx

@@ -0,0 +1,39 @@
+module PropertyExample
+
+type Counter() =
+  let mutable count = 0
+
+  member _.Value
+    with get () = count
+    and set v = count <- v
+
+  member _.Increment() = count <- count + 1
+
+  member _.GetDouble() = count * 2
+
+type Person = { mutable Name: string; mutable Age: int }
+
+let createPerson name age = { Name = name; Age = age }
+
+let main () =
+  // Constructor call
+  let counter = Counter()
+
+  // Property getter
+  let initialValue = counter.Value
+
+  // Property setter
+  counter.Value <- 10
+
+  // Method calls
+  counter.Increment()
+  let doubled = counter.GetDouble()
+
+  // Record creation and property access
+  let person = createPerson "John" 30
+  let personName = person.Name
+  person.Age <- 31
+
+  initialValue + doubled + person.Age
+
+ignore main