#1097 incoming call hierarchy (#1164)

* WIP Incoming Hierarchy

* Call Hierarchy Incoming calls

* outgoing call poc

* Using TryRangeOfNameOfNearestOuterBindingContainingPos for CallHierarchyIncomingCalls

* Fixing incoming call hierarchy plus tests

* Fixing incoming call typechecks

* formatting

* Fixing up Adaptive Cancellation

* Adding Versioning to DiagnosticCollection

* Fixing tests

* cleanup

* cleanup

* revert removing altcover

---------

Co-authored-by: Chet Husk <[email protected]>

src/FsAutoComplete.Core/AdaptiveExtensions.fs

@@ -480,46 +480,44 @@ module AsyncAVal =
   let ofTask (value: Task<'a>) = ConstantVal(value) :> asyncaval<_>
 
   let ofCancellableTask (value: CancellableTask<'a>) =
-    ConstantVal(
-      let cts = new CancellationTokenSource()
-
-      let cancel () =
-        cts.Cancel()
-        cts.Dispose()
-
-      let real =
-        task {
-          try
-            return! value cts.Token
-          finally
+    { new AbstractVal<'a>() with
+        member x.Compute t =
+          let cts = new CancellationTokenSource()
+
+          let cancel () =
+            cts.Cancel()
             cts.Dispose()
-        }
 
-      AdaptiveCancellableTask(cancel, real)
-    )
-    :> asyncaval<_>
+          let real =
+            task {
+              try
+                return! value cts.Token
+              finally
+                cts.Dispose()
+            }
 
+          AdaptiveCancellableTask(cancel, real) }
+    :> asyncaval<_>
 
   let ofAsync (value: Async<'a>) =
-    ConstantVal(
-      let cts = new CancellationTokenSource()
-
-      let cancel () =
-        cts.Cancel()
-        cts.Dispose()
-
-      let real =
-        task {
-          try
-            return! Async.StartImmediateAsTask(value, cts.Token)
-          finally
+    { new AbstractVal<'a>() with
+        member x.Compute t =
+          let cts = new CancellationTokenSource()
+
+          let cancel () =
+            cts.Cancel()
             cts.Dispose()
-        }
 
-      AdaptiveCancellableTask(cancel, real)
-    )
-    :> asyncaval<_>
+          let real =
+            task {
+              try
+                return! Async.StartImmediateAsTask(value, cts.Token)
+              finally
+                cts.Dispose()
+            }
 
+          AdaptiveCancellableTask(cancel, real) }
+    :> asyncaval<_>
 
   /// <summary>
   /// Creates an async adaptive value evaluation the given value.
@@ -604,7 +602,13 @@ module AsyncAVal =
   /// adaptive inputs.
   /// </summary>
   let mapSync (mapping: 'a -> CancellationToken -> 'b) (input: asyncaval<'a>) =
-    map (fun a ct -> Task.FromResult(mapping a ct)) input
+    map
+      (fun a ct ->
+        if ct.IsCancellationRequested then
+          Task.FromCanceled<_>(ct)
+        else
+          Task.FromResult(mapping a ct))
+      input
 
   /// <summary>
   /// Returns a new async adaptive value that adaptively applies the mapping function to the given
@@ -729,11 +733,10 @@ module AsyncAVal =
 
   /// Returns a new async adaptive value that adaptively applies the mapping function to the given
   /// optional adaptive inputs.
-  let mapOption f (value: asyncaval<'a option>) : asyncaval<'b option> =
+  let mapOption (f: 'a -> CancellationToken -> 'b) (value: asyncaval<'a option>) : asyncaval<'b option> =
     mapSync (fun data ctok -> data |> Option.map (fun d -> f d ctok)) value
 
 type AsyncAValBuilder() =
-
   member inline x.MergeSources(v1: asyncaval<'T1>, v2: asyncaval<'T2>) =
     (v1, v2)
     ||> AsyncAVal.map2 (fun a b ctok ->
@@ -742,24 +745,24 @@ type AsyncAValBuilder() =
       else
         Task.FromResult(a, b))
 
-
-  // member inline x.MergeSources3(v1 : aval<'T1>, v2 : aval<'T2>, v3 : aval<'T3>) =
-  //     AVal.map3 (fun a b c -> a,b,c) v1 v2 v3
-
   member inline x.BindReturn(value: asyncaval<'T1>, [<InlineIfLambda>] mapping: 'T1 -> CancellationToken -> Task<'T2>) =
     AsyncAVal.map mapping value
 
   member inline x.BindReturn(value: asyncaval<'T1>, [<InlineIfLambda>] mapping: 'T1 -> Async<'T2>) =
     AsyncAVal.mapAsync mapping value
 
-  member inline x.BindReturn(value: asyncaval<'T1>, [<InlineIfLambda>] mapping: 'T1 -> Task<'T2>) =
-    AsyncAVal.map (fun data _ -> mapping data) value
-
   member inline x.Bind(value: asyncaval<'T1>, [<InlineIfLambda>] mapping: 'T1 -> CancellationToken -> asyncaval<'T2>) =
-    AsyncAVal.bind (mapping) value
+    AsyncAVal.bind mapping value
 
   member inline x.Bind(value: asyncaval<'T1>, [<InlineIfLambda>] mapping: 'T1 -> asyncaval<'T2>) =
-    AsyncAVal.bind (fun data _ -> mapping data) value
+    AsyncAVal.bind
+      (fun data ct ->
+        if ct.IsCancellationRequested then
+          AsyncAVal.ConstantVal(Task.FromCanceled<_> ct)
+        else
+          mapping data)
+      value
+
 
   member inline x.Return(value: 'T) = AsyncAVal.constant value
 
@@ -775,12 +778,14 @@ module AsyncAValBuilderExtensions =
 
     member inline x.Source(value: aval<'T>) = AsyncAVal.ofAVal value
     member inline x.Source(value: Task<'T>) = AsyncAVal.ofTask value
+    member inline x.Source(value: Async<'T>) = AsyncAVal.ofAsync value
+    member inline x.Source(value: CancellableTask<'T>) = AsyncAVal.ofCancellableTask value
 
     member inline x.BindReturn(value: asyncaval<'T1>, [<InlineIfLambda>] mapping: 'T1 -> CancellationToken -> 'T2) =
       AsyncAVal.mapSync (fun data ctok -> mapping data ctok) value
 
     member inline x.BindReturn(value: asyncaval<'T1>, [<InlineIfLambda>] mapping: 'T1 -> 'T2) =
-      AsyncAVal.mapSync (fun data ctok -> mapping data) value
+      AsyncAVal.mapSync (fun data _ -> mapping data) value
 
 module AMapAsync =
 

src/FsAutoComplete.Core/AdaptiveExtensions.fsi

@@ -323,8 +323,6 @@ type AsyncAValBuilder =
   member inline Bind:
     value: asyncaval<'T1> * mapping: ('T1 -> System.Threading.CancellationToken -> asyncaval<'T2>) -> asyncaval<'T2>
 
-  member inline BindReturn: value: asyncaval<'T1> * mapping: ('T1 -> System.Threading.Tasks.Task<'T2>) -> asyncaval<'T2>
-
   member inline BindReturn: value: asyncaval<'T1> * mapping: ('T1 -> Async<'T2>) -> asyncaval<'T2>
 
   member inline BindReturn:
@@ -341,24 +339,19 @@ type AsyncAValBuilder =
 
 [<AutoOpen>]
 module AsyncAValBuilderExtensions =
-
+  open IcedTasks
   val asyncAVal: AsyncAValBuilder
 
   type AsyncAValBuilder with
 
     member inline Source: value: FSharp.Data.Adaptive.aval<'T> -> asyncaval<'T>
-
-  type AsyncAValBuilder with
-
     member inline Source: value: System.Threading.Tasks.Task<'T> -> asyncaval<'T>
-
-  type AsyncAValBuilder with
+    member inline Source: value: Async<'T> -> asyncaval<'T>
+    member inline Source: value: CancellableTask<'T> -> asyncaval<'T>
 
     member inline BindReturn:
       value: asyncaval<'T1> * mapping: ('T1 -> System.Threading.CancellationToken -> 'T2) -> asyncaval<'T2>
 
-  type AsyncAValBuilder with
-
     member inline BindReturn: value: asyncaval<'T1> * mapping: ('T1 -> 'T2) -> asyncaval<'T2>
 
 module AMapAsync =

src/FsAutoComplete.Core/Commands.fs

@@ -74,17 +74,17 @@ module AsyncResult =
   let recoverCancellation (ar: Async<Result<CoreResponse<'t>, exn>>) =
     recoverCancellationGeneric ar (sprintf "Request cancelled (exn was %A)" >> CoreResponse.InfoRes)
 
-  let recoverCancellationIgnore (ar: Async<Result<unit, exn>>) = AsyncResult.foldResult id ignore ar
+  let recoverCancellationIgnore (ar: Async<Result<unit, exn>>) = ar |> AsyncResult.foldResult id (ignore<exn>)
 
 [<RequireQualifiedAccess>]
 type NotificationEvent =
-  | ParseError of errors: FSharpDiagnostic[] * file: string<LocalPath>
+  | ParseError of errors: FSharpDiagnostic[] * file: string<LocalPath> * version: int
   | Workspace of ProjectSystem.ProjectResponse
-  | AnalyzerMessage of messages: FSharp.Analyzers.SDK.Message[] * file: string<LocalPath>
-  | UnusedOpens of file: string<LocalPath> * opens: Range[]
+  | AnalyzerMessage of messages: FSharp.Analyzers.SDK.Message[] * file: string<LocalPath> * version: int
+  | UnusedOpens of file: string<LocalPath> * opens: Range[] * version: int
   // | Lint of file: string<LocalPath> * warningsWithCodes: Lint.EnrichedLintWarning list
-  | UnusedDeclarations of file: string<LocalPath> * decls: range[]
-  | SimplifyNames of file: string<LocalPath> * names: SimplifyNames.SimplifiableRange[]
+  | UnusedDeclarations of file: string<LocalPath> * decls: range[] * version: int
+  | SimplifyNames of file: string<LocalPath> * names: SimplifyNames.SimplifiableRange[] * version: int
   | Canceled of errorMessage: string
   | FileParsed of string<LocalPath>
   | TestDetected of file: string<LocalPath> * tests: TestAdapter.TestAdapterEntry<range>[]
@@ -1251,7 +1251,7 @@ type Commands
   //Diagnostics handler - Triggered by `CheckCore`
   do
     disposables.Add
-    <| fileChecked.Publish.Subscribe(fun (parseAndCheck, file, _) ->
+    <| fileChecked.Publish.Subscribe(fun (parseAndCheck, file, version) ->
       async {
         try
           NotificationEvent.FileParsed file |> notify.Trigger
@@ -1265,7 +1265,7 @@ type Commands
             |> Array.distinctBy (fun e ->
               e.Severity, e.ErrorNumber, e.StartLine, e.StartColumn, e.EndLine, e.EndColumn, e.Message)
 
-          (errors, file) |> NotificationEvent.ParseError |> notify.Trigger
+          (errors, file, version) |> NotificationEvent.ParseError |> notify.Trigger
         with _ ->
           ()
       }
@@ -1274,7 +1274,7 @@ type Commands
   //Analyzers handler - Triggered by `CheckCore`
   do
     disposables.Add
-    <| fileChecked.Publish.Subscribe(fun (parseAndCheck, file, _) ->
+    <| fileChecked.Publish.Subscribe(fun (parseAndCheck, file, version) ->
       async {
         if hasAnalyzers then
           try
@@ -1298,7 +1298,7 @@ type Commands
                     parseAndCheck.GetAllEntities
                   )
 
-                (res, file) |> NotificationEvent.AnalyzerMessage |> notify.Trigger
+                (res, file, version) |> NotificationEvent.AnalyzerMessage |> notify.Trigger
 
                 Loggers.analyzers.info (
                   Log.setMessage "end analysis of {file}"
@@ -2435,6 +2435,7 @@ type Commands
       let isScript = Utils.isAScript (UMX.untag file)
 
       let! (opts, source) = state.TryGetFileCheckerOptionsWithSource file
+      let version = state.TryGetFileVersion file |> Option.defaultValue 0
 
       let tyResOpt = checker.TryGetRecentCheckResultsForFile(file, opts, source)
 
@@ -2444,13 +2445,14 @@ type Commands
         let! unused = UnusedDeclarations.getUnusedDeclarations (tyRes.GetCheckResults, isScript)
         let unused = unused |> Seq.toArray
 
-        notify.Trigger(NotificationEvent.UnusedDeclarations(file, unused))
+        notify.Trigger(NotificationEvent.UnusedDeclarations(file, unused, version))
     }
     |> Async.Ignore<Result<unit, _>>
 
   member x.CheckSimplifiedNames file : Async<unit> =
     asyncResult {
       let! (opts, source) = state.TryGetFileCheckerOptionsWithLines file
+      let version = state.TryGetFileVersion file |> Option.defaultValue 0
 
       let tyResOpt = checker.TryGetRecentCheckResultsForFile(file, opts, source)
 
@@ -2461,7 +2463,7 @@ type Commands
 
         let! simplified = SimplifyNames.getSimplifiableNames (tyRes.GetCheckResults, getSourceLine)
         let simplified = Array.ofSeq simplified
-        notify.Trigger(NotificationEvent.SimplifyNames(file, simplified))
+        notify.Trigger(NotificationEvent.SimplifyNames(file, simplified, version))
     }
     |> Async.Ignore<Result<unit, _>>
     |> x.AsCancellable file
@@ -2470,14 +2472,15 @@ type Commands
   member x.CheckUnusedOpens file : Async<unit> =
     asyncResult {
       let! (opts, source) = state.TryGetFileCheckerOptionsWithLines file
+      let version = state.TryGetFileVersion file |> Option.defaultValue 0
 
       match checker.TryGetRecentCheckResultsForFile(file, opts, source) with
       | None -> return ()
       | Some tyRes ->
         let! unused =
           UnusedOpens.getUnusedOpens (tyRes.GetCheckResults, (fun i -> (source: ISourceText).GetLineString(i - 1)))
 
-        notify.Trigger(NotificationEvent.UnusedOpens(file, (unused |> List.toArray)))
+        notify.Trigger(NotificationEvent.UnusedOpens(file, (unused |> List.toArray), version))
 
     }
     |> Async.Ignore<Result<unit, _>>

src/FsAutoComplete.Core/FCSPatches.fs

@@ -7,6 +7,7 @@ open FSharp.Compiler.Syntax
 open FSharp.Compiler.Text
 open FsAutoComplete.UntypedAstUtils
 open FSharp.Compiler.CodeAnalysis
+open FSharp.Compiler.EditorServices
 
 module internal SynExprAppLocationsImpl =
   let rec private searchSynArgExpr traverseSynExpr expr ranges =
@@ -350,6 +351,60 @@ type FSharpParseFileResults with
             | _ -> defaultTraverse expr }
     )
 
+  member scope.ClassifyBinding(binding: SynBinding) =
+    match binding with
+    | SynBinding(valData = SynValData(memberFlags = None)) -> FSharpGlyph.Delegate
+    | _ -> FSharpGlyph.Method
+
+  member scope.TryRangeOfNameOfNearestOuterBindingOrMember pos =
+    let tryGetIdentRangeFromBinding binding =
+      let glyph = scope.ClassifyBinding binding
+
+      match binding with
+      | SynBinding(headPat = headPat) ->
+        match headPat with
+        | SynPat.LongIdent(longDotId = longIdentWithDots) ->
+          Some(binding.RangeOfBindingWithRhs, glyph, longIdentWithDots.LongIdent)
+        | SynPat.As(rhsPat = SynPat.Named(ident = SynIdent(ident, _); isThisVal = false))
+        | SynPat.Named(SynIdent(ident, _), false, _, _) -> Some(binding.RangeOfBindingWithRhs, glyph, [ ident ])
+        | _ -> None
+
+    let rec walkBinding expr workingRange =
+      match expr with
+
+      // This lets us dive into subexpressions that may contain the binding we're after
+      | SynExpr.Sequential(_, _, expr1, expr2, _) ->
+        if Range.rangeContainsPos expr1.Range pos then
+          walkBinding expr1 workingRange
+        else
+          walkBinding expr2 workingRange
+
+      | SynExpr.LetOrUse(bindings = bindings; body = bodyExpr) ->
+        let potentialNestedRange =
+          bindings
+          |> List.tryFind (fun binding -> Range.rangeContainsPos binding.RangeOfBindingWithRhs pos)
+          |> Option.bind tryGetIdentRangeFromBinding
+
+        match potentialNestedRange with
+        | Some range -> walkBinding bodyExpr range
+        | None -> walkBinding bodyExpr workingRange
+
+      | _ -> Some workingRange
+
+    let visitor =
+      { new SyntaxVisitorBase<_>() with
+          override _.VisitExpr(_, _, defaultTraverse, expr) = defaultTraverse expr
+
+          override _.VisitBinding(_path, defaultTraverse, binding) =
+            match binding with
+            | SynBinding(expr = expr) as b when Range.rangeContainsPos b.RangeOfBindingWithRhs pos ->
+              match tryGetIdentRangeFromBinding b with
+              | Some range -> walkBinding expr range
+              | None -> None
+            | _ -> defaultTraverse binding }
+
+    SyntaxTraversal.Traverse(pos, scope.ParseTree, visitor)
+
 module SyntaxTreeOps =
   open FSharp.Compiler.Syntax
 

src/FsAutoComplete.Core/FCSPatches.fsi

@@ -6,6 +6,7 @@ open FSharp.Compiler.Syntax
 open FSharp.Compiler.Text
 open FsAutoComplete.UntypedAstUtils
 open FSharp.Compiler.CodeAnalysis
+open FSharp.Compiler.EditorServices
 
 type LanguageFeatureShim =
   new: langFeature: string -> LanguageFeatureShim
@@ -27,3 +28,7 @@ module LanguageVersionShim =
 
 module SyntaxTreeOps =
   val synExprContainsError: SynExpr -> bool
+
+type FSharpParseFileResults with
+
+  member TryRangeOfNameOfNearestOuterBindingOrMember: pos: pos -> option<range * FSharpGlyph * LongIdent>