Skip to content

Commit ef3520b

Browse files
committed
Initial implementation of AddFunctionToSignatureFileAction.
1 parent ce989d6 commit ef3520b

5 files changed

Lines changed: 195 additions & 2 deletions

File tree

ReSharper.FSharp/src/FSharp.Psi.Features/src/LanguageService/FSharpElementFactory.fs

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -98,6 +98,31 @@ type FSharpElementFactory(languageService: IFSharpLanguageService, sourceFile: I
9898
let expr = createLetExpr (sprintf "(a: %s)" usage)
9999
expr.Bindings[0].HeadPattern.As<IParenPat>().Pattern.As<ITypedPat>().TypeUsage
100100

101+
let createBindingSignature () =
102+
let source = "module V\nval a: obj"
103+
let moduleMember = getModuleMember source
104+
moduleMember :?> IBindingSignature
105+
106+
let createTypeUsageForSignature usage: ITypeUsage =
107+
let source = $"module V\nval a: {usage}"
108+
let moduleMember = getModuleMember source
109+
let bindingSignature = moduleMember :?> IBindingSignature
110+
bindingSignature.ReturnTypeInfo.ReturnType
111+
112+
let createParameterSignatureTypeUsageForSignature name typeUsage: ITypeUsage =
113+
let source = "module V\nval a: b: obj -> obj"
114+
let moduleMember = getModuleMember source
115+
let bindingSignature = moduleMember :?> IBindingSignature
116+
match bindingSignature.ReturnTypeInfo.ReturnType with
117+
| :? IFunctionTypeUsage as ft ->
118+
match ft.ArgumentTypeUsage with
119+
| :? IParameterSignatureTypeUsage as pstu ->
120+
pstu.SetIdentifier(name) |> ignore
121+
pstu.SetTypeUsage(typeUsage) |> ignore
122+
pstu
123+
| _ -> failwith "Could not get IParameterSignatureTypeUsage in ArgumentTypeUsage"
124+
| _ -> failwith "Could not get IFunctionTypeUsage in IBindingSignature.ReturnTypeInfo.ReturnType"
125+
101126
interface IFSharpElementFactory with
102127
member x.CreateOpenStatement(ns) =
103128
// todo: mangle ns
@@ -314,6 +339,28 @@ type FSharpElementFactory(languageService: IFSharpLanguageService, sourceFile: I
314339
member x.CreateTypeUsage(typeUsage: string) : ITypeUsage =
315340
createTypeUsage typeUsage
316341

342+
member x.CreateTypeUsageForSignature(typeUsage: string): ITypeUsage =
343+
createTypeUsageForSignature typeUsage
344+
345+
member x.CreateParameterSignatureTypeUsage(name: IFSharpIdentifier, typeUsage:ITypeUsage) =
346+
createParameterSignatureTypeUsageForSignature name typeUsage
347+
348+
member x.CreateBindingSignature(bindingName: IFSharpPattern, returnType: ITypeUsage) =
349+
let signature = createBindingSignature ()
350+
signature.SetHeadPattern(bindingName) |> ignore
351+
replace signature.ReturnTypeInfo.ReturnType returnType
352+
signature
353+
354+
member x.WrapParenAroundTypeUsageForSignature(typeUsage:ITypeUsage) =
355+
match createTypeUsageForSignature "(obj)" with
356+
| :? IParameterSignatureTypeUsage as pstu ->
357+
match pstu.TypeUsage with
358+
| :? IParenTypeUsage as ptu ->
359+
ptu.SetInnerTypeUsage(typeUsage) |> ignore
360+
ptu
361+
| _ -> failwith "Could not get IParenTypeUsage in IParameterSignatureTypeUsage"
362+
| _ -> failwith "Could not IParameterSignatureTypeUsage"
363+
317364
member x.CreateSetExpr(left: IFSharpExpression, right: IFSharpExpression) =
318365
let source = "() <- ()"
319366
let expr = getExpression source

ReSharper.FSharp/src/FSharp.Psi.Features/src/Parsing/FSharpParser.fs

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ open FSharp.Compiler.Syntax
55
open JetBrains.Annotations
66
open JetBrains.DocumentModel
77
open JetBrains.Lifetimes
8+
open JetBrains.ReSharper.Plugins.FSharp
89
open JetBrains.ReSharper.Plugins.FSharp.Checker
910
open JetBrains.ReSharper.Plugins.FSharp.Psi
1011
open JetBrains.ReSharper.Plugins.FSharp.Psi.Impl.Tree
@@ -13,6 +14,7 @@ open JetBrains.ReSharper.Plugins.FSharp.Psi.Resolve
1314
open JetBrains.ReSharper.Plugins.FSharp.Psi.Tree
1415
open JetBrains.ReSharper.Psi
1516
open JetBrains.ReSharper.Psi.Parsing
17+
open type JetBrains.ProjectModel.ProjectFileTypeEx
1618

1719
type FSharpParser(lexer: ILexer, document: IDocument, path: VirtualFileSystemPath, sourceFile: IPsiSourceFile,
1820
checkerService: FcsCheckerService, symbolsCache: IFcsResolvedSymbolsCache) =
@@ -62,10 +64,17 @@ type FSharpParser(lexer: ILexer, document: IDocument, path: VirtualFileSystemPat
6264
let path = if isNotNull sourceFile then sourceFile.GetLocation() else null
6365
FSharpParser(lexer, document, path, sourceFile, checkerService, symbolsCache)
6466

65-
new (lexer, document, sourceFile, checkerService, symbolsCache) =
66-
FSharpParser(lexer, document, FSharpParser.SandBoxPath, sourceFile, checkerService, symbolsCache)
67+
new (lexer, document, sourceFile: IPsiSourceFile, checkerService, symbolsCache) =
68+
let path =
69+
if sourceFile.LanguageType.Is<FSharpSignatureProjectFileType>() then
70+
FSharpParser.SandBoxSignaturePath
71+
else
72+
FSharpParser.SandBoxPath
73+
74+
FSharpParser(lexer, document, path, sourceFile, checkerService, symbolsCache)
6775

6876
static member val SandBoxPath = VirtualFileSystemPath.Parse("Sandbox.fs", InteractionContext.SolutionContext)
77+
static member val SandBoxSignaturePath = VirtualFileSystemPath.Parse("Sandbox.fsi", InteractionContext.SolutionContext)
6978

7079
interface IFSharpParser with
7180
member this.ParseFSharpFile(noCache) = parseFile noCache

ReSharper.FSharp/src/FSharp.Psi.Intentions/FSharp.Psi.Intentions.fsproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@
2525
<Compile Include="src\Intentions\SetNameAction.fs" />
2626
<Compile Include="src\Intentions\LetToUseAction.fs" />
2727
<Compile Include="src\Intentions\RenameFileToMatchTypeNameAction.fs" />
28+
<Compile Include="src\Intentions\AddFunctionToSignatureFileAction.fs" />
2829
<Compile Include="src\QuickFixes\FSharpQuickFixBase.fs" />
2930
<Compile Include="src\QuickFixes\RemoveUnusedOpensFix.fs" />
3031
<Compile Include="src\QuickFixes\ReplaceUseWithLetFix.fs" />
Lines changed: 131 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,131 @@
1+
namespace JetBrains.ReSharper.Plugins.FSharp.Psi.Intentions.Intentions
2+
3+
open FSharp.Compiler.Text
4+
open FSharp.Compiler.Symbols
5+
open JetBrains.ReSharper.Feature.Services.ContextActions
6+
open JetBrains.ReSharper.Plugins.FSharp.Psi.Features.Intentions
7+
open JetBrains.ReSharper.Plugins.FSharp.Psi.Tree
8+
open JetBrains.ReSharper.Plugins.FSharp.Psi
9+
open JetBrains.ReSharper.Plugins.FSharp.Psi.Impl
10+
open JetBrains.ReSharper.Psi.ExtensionsAPI
11+
open JetBrains.ReSharper.Resources.Shell
12+
open JetBrains.ReSharper.Plugins.FSharp.Psi.Impl.Tree
13+
open JetBrains.ReSharper.Psi.Tree
14+
15+
[<ContextAction(Name = "AddFunctionToSignatureFile", Group = "F#", Description = "Add function to signature file")>]
16+
type AddFunctionToSignatureFileAction(dataProvider: FSharpContextActionDataProvider) =
17+
inherit FSharpContextActionBase(dataProvider)
18+
19+
let (|ValFromImpl|_|) (symbol:FSharpSymbol) =
20+
match symbol with
21+
| :? FSharpMemberOrFunctionOrValue as valSymbol ->
22+
valSymbol.SignatureLocation
23+
|> Option.bind (fun range -> if range.FileName.EndsWith(".fs") then Some valSymbol else None)
24+
| _ -> None
25+
26+
let rec tryFindParameterName (p: IFSharpPattern) =
27+
match p.IgnoreInnerParens() with
28+
| :? ITypedPat as tp -> tryFindParameterName tp.Pattern
29+
| :? ILocalReferencePat as rp -> Some rp.Identifier
30+
| _ -> None
31+
32+
let implBindingAndDecl =
33+
let currentFSharpFile = dataProvider.PsiFile
34+
if isNull currentFSharpFile then None else
35+
// Don't show context action in signature file.
36+
if currentFSharpFile.IsFSharpSigFile() then None else
37+
38+
let fcsService = currentFSharpFile.FcsCheckerService
39+
if isNull fcsService || isNull fcsService.FcsProjectProvider then None else
40+
41+
let hasSignature = fcsService.FcsProjectProvider.HasPairFile dataProvider.SourceFile
42+
if not hasSignature then None else
43+
44+
let letBindings = dataProvider.GetSelectedElement<ILetBindingsDeclaration>()
45+
if isNull letBindings then None else
46+
// Currently excluding recursive bindings
47+
if letBindings.Bindings.Count <> 1 then None else
48+
let binding = letBindings.Bindings |> Seq.exactlyOne
49+
let refPat = binding.HeadPattern.As<IReferencePat>()
50+
if isNull refPat || isNull refPat.Reference then None else
51+
52+
let moduleOrNamespaceDecl = QualifiableModuleLikeDeclarationNavigator.GetByMember(letBindings)
53+
if isNull moduleOrNamespaceDecl then None else
54+
let moduleOrNamespaceDeclaredElement = moduleOrNamespaceDecl.DeclaredElement
55+
if isNull moduleOrNamespaceDeclaredElement then None else
56+
57+
let signatureCounterPart =
58+
moduleOrNamespaceDeclaredElement.GetDeclarations()
59+
|> Seq.tryPick (fun d -> if d.IsFSharpSigFile() then Some d else None)
60+
61+
match signatureCounterPart with
62+
| None -> None
63+
| Some signatureCounterPart ->
64+
65+
let symbolUse = refPat.GetFcsSymbolUse()
66+
match symbolUse.Symbol with
67+
| ValFromImpl valSymbol ->
68+
let text =
69+
valSymbol.FormatLayout(symbolUse.DisplayContext)
70+
|> Array.choose (fun (t : TaggedText) ->
71+
match t.Tag with
72+
| TextTag.UnknownEntity -> None
73+
| _ -> Some t.Text)
74+
|> String.concat ""
75+
76+
Some (refPat, binding, text, signatureCounterPart)
77+
| _ -> None
78+
79+
override this.IsAvailable _ = Option.isSome implBindingAndDecl
80+
81+
override this.ExecutePsiTransaction(_solution, _progress) =
82+
match implBindingAndDecl with
83+
| None -> null
84+
| Some (refPat, binding, text, signatureModuleOrNamespaceDecl) ->
85+
86+
use writeCookie = WriteLockCookie.Create(binding.IsPhysical())
87+
use disableFormatter = new DisableCodeFormatter()
88+
89+
let factory = signatureModuleOrNamespaceDecl.CreateElementFactory()
90+
let typeInfo = factory.CreateTypeUsageForSignature(text)
91+
92+
// Enrich the type info with the found parameters from binding.
93+
let rec visit (index:int) (t: ITypeUsage) =
94+
if index = binding.ParameterPatterns.Count then
95+
match t with
96+
| :? IFunctionTypeUsage ->
97+
// If the return type is a function itself, the safest thing to do is to wrap it in parentheses.
98+
// Example: `let g _ = (*) 3`
99+
// `val g: 'a -> int -> int` is not valid, `val g: 'a -> (int -> int)` is.
100+
replace t (factory.WrapParenAroundTypeUsageForSignature(t))
101+
| _ -> ()
102+
else
103+
// TODO: take tuples into account.
104+
let parameterAtIndex = tryFindParameterName (binding.ParameterPatterns.Item(index))
105+
106+
match t, parameterAtIndex with
107+
| :? IFunctionTypeUsage as ft, Some parameterName ->
108+
match ft.ArgumentTypeUsage with
109+
| :? IParameterSignatureTypeUsage as pstu ->
110+
// Update the parameter name if it was found in the implementation file
111+
// calling SetIdentifier on pstu does not add a ':' token.
112+
let namedTypeUsage = factory.CreateParameterSignatureTypeUsage(parameterName, pstu.TypeUsage)
113+
replace ft.ArgumentTypeUsage namedTypeUsage
114+
| _ -> ()
115+
116+
visit (index + 1) ft.ReturnTypeUsage
117+
| :? IFunctionTypeUsage as ft, None ->
118+
visit (index + 1) ft.ReturnTypeUsage
119+
| _ ->
120+
()
121+
122+
if not binding.ParameterPatterns.IsEmpty then
123+
visit 0 typeInfo
124+
125+
let valSig = factory.CreateBindingSignature(refPat, typeInfo)
126+
let newlineNode = NewLine(signatureModuleOrNamespaceDecl.GetLineEnding()) :> ITreeNode
127+
addNodesAfter signatureModuleOrNamespaceDecl.LastChild [| newlineNode; valSig; newlineNode |] |> ignore
128+
129+
null
130+
131+
override this.Text = "Add function to signature file"

ReSharper.FSharp/src/FSharp.Psi/src/IFSharpElementFactory.cs

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,11 @@ public interface IFSharpElementFactory
3535

3636
ITypeUsage CreateTypeUsage(string typeUsage);
3737

38+
ITypeUsage CreateTypeUsageForSignature(string typeUsage);
39+
ITypeUsage CreateParameterSignatureTypeUsage(IFSharpIdentifier name, ITypeUsage typeUsage);
40+
IBindingSignature CreateBindingSignature(IFSharpPattern bindingName, ITypeUsage returnType);
41+
ITypeUsage WrapParenAroundTypeUsageForSignature(ITypeUsage typeUsage);
42+
3843
IReturnTypeInfo CreateReturnTypeInfo(ITypeUsage typeSignature);
3944

4045
IMatchExpr CreateMatchExpr(IFSharpExpression expr);

0 commit comments

Comments
 (0)