Context Actions: support named patterns annotation

ReSharper.FSharp/src/FSharp/FSharp.Psi.Daemon/src/Stages/PatternTypeHintsStage.fs

@@ -11,6 +11,7 @@ open JetBrains.ReSharper.Plugins.FSharp.Psi.Daemon.Highlightings.FSharpTypeHints
 open JetBrains.ReSharper.Plugins.FSharp.Psi.Daemon.Utils.VisibleRangeContainer
 open JetBrains.ReSharper.Plugins.FSharp.Psi.Features.Daemon.Highlightings
 open JetBrains.ReSharper.Plugins.FSharp.Psi.Features.Daemon.Stages
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Features.Util.FcsTypeUtil
 open JetBrains.ReSharper.Plugins.FSharp.Psi.Impl
 open JetBrains.ReSharper.Plugins.FSharp.Psi.Tree
 open JetBrains.ReSharper.Plugins.FSharp.Settings
@@ -174,11 +175,9 @@ type private PatternsHighlightingProcess(fsFile, settingsStore: IContextBoundSet
             if isNull symbol then ValueNone else
 
             let fcsType = symbol.FullType
+            let pattern, fcsType = tryGetOuterOptionalParameterAndItsType refPat fcsType
             let range = pattern.GetNavigationRange().EndOffsetRange()
 
-            let isOptional = isNotNull (OptionalValPatNavigator.GetByPattern(refPat))
-            let fcsType = if isOptional && isOption fcsType then fcsType.GenericArguments[0] else fcsType
-
             createTypeHintHighlighting fcsType defaultDisplayContext range pushToHintMode actionsProvider false
             |> ValueSome
 

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

@@ -36,7 +36,7 @@
     <Compile Include="src\Intentions\IfToElifAction.fs" />
     <Compile Include="src\Intentions\NegateConditionActions.fs" />
     <Compile Include="src\Intentions\ToMutableAction.fs" />
-    <Compile Include="src\Intentions\FunctionAnnotationAction.fs" />
+    <Compile Include="src\Intentions\AnnotationActions.fs" />
     <Compile Include="src\Intentions\ToLiteralAction.fs" />
     <Compile Include="src\Intentions\SetNameAction.fs" />
     <Compile Include="src\Intentions\LetToUseAction.fs" />

ReSharper.FSharp/src/FSharp/FSharp.Psi.Intentions/src/Intentions/FunctionAnnotationAction.fs → ReSharper.FSharp/src/FSharp/FSharp.Psi.Intentions/src/Intentions/AnnotationActions.fs

@@ -50,7 +50,12 @@ module SpecifyTypes =
         parenPat.SetPattern(pattern) |> ignore
         parenPat :> IFSharpPattern
 
-    let specifyParameterType displayContext (fcsType: FSharpType) (pattern: IFSharpPattern) =
+    let specifyPatternType displayContext (fcsType: FSharpType) (pattern: IFSharpPattern) =
+        let pattern, fcsType =
+            match pattern with
+            | :? IReferencePat as pattern -> FcsTypeUtil.tryGetOuterOptionalParameterAndItsType pattern fcsType
+            | _ -> pattern, fcsType
+
         let pattern = pattern.IgnoreParentParens()
         let factory = pattern.CreateElementFactory()
 
@@ -61,13 +66,11 @@ module SpecifyTypes =
 
         let typedPat =
             let typeUsage = factory.CreateTypeUsage(fcsType.Format(displayContext), TypeUsageContext.TopLevel)
-            let typedPat = factory.CreateTypedPat(newPattern, typeUsage)
-            if isNull (TuplePatNavigator.GetByPattern(pattern)) then
-                addParens factory typedPat
-            else
-                typedPat :> _
+            factory.CreateTypedPat(newPattern, typeUsage)
 
-        ModificationUtil.ReplaceChild(pattern, typedPat) |> ignore
+        ModificationUtil.ReplaceChild(pattern, typedPat)
+        |> ParenPatUtil.addParensIfNeeded
+        |> ignore
 
     let specifyPropertyType displayContext (fcsType: FSharpType) (decl: IMemberDeclaration) =
         Assertion.Assert(isNull decl.ReturnTypeInfo, "isNull decl.ReturnTypeInfo")
@@ -104,7 +107,7 @@ type FunctionAnnotationAction(dataProvider: FSharpContextActionDataProvider) =
                 | TupleLikePattern pat when isTopLevel ->
                     specifyParameterTypes fcsType.GenericArguments pat.Patterns false
                 | pattern ->
-                    SpecifyTypes.specifyParameterType displayContext fcsType pattern
+                    SpecifyTypes.specifyPatternType displayContext fcsType pattern
 
         specifyParameterTypes types parameters true
 
@@ -153,3 +156,34 @@ type FunctionAnnotationAction(dataProvider: FSharpContextActionDataProvider) =
 
         if isNull binding.ReturnTypeInfo then
             SpecifyTypes.specifyBindingReturnType displayContext mfv binding
+
+
+[<ContextAction(Name = "AnnotatePattern", GroupType = typeof<FSharpContextActions>,
+                Description = "Annotate named parameter/pattern with it is type")>]
+type PatternAnnotationAction(dataProvider: FSharpContextActionDataProvider) =
+    inherit FSharpContextActionBase(dataProvider)
+    override x.Text = "Add type annotation"
+
+    override x.IsAvailable _ =
+        let pattern = dataProvider.GetSelectedElement<IReferencePat>().IgnoreParentParens()
+        let pattern =
+            match OptionalValPatNavigator.GetByPattern(pattern) with
+            | null -> pattern
+            | x -> x
+
+        isNotNull pattern &&
+        isNull (TypedPatNavigator.GetByPattern(pattern)) &&
+        isNull (BindingNavigator.GetByHeadPattern(pattern))
+
+    override x.ExecutePsiTransaction _ =
+        let pattern = dataProvider.GetSelectedElement<IReferencePat>()
+
+        use writeCookie = WriteLockCookie.Create(pattern.IsPhysical())
+        use disableFormatter = new DisableCodeFormatter()
+
+        let symbolUse = pattern.GetFcsSymbolUse()
+
+        let mfv = symbolUse.Symbol :?> FSharpMemberOrFunctionOrValue
+        let displayContext = symbolUse.DisplayContext
+
+        SpecifyTypes.specifyPatternType displayContext mfv.FullType pattern

ReSharper.FSharp/src/FSharp/FSharp.Psi.Intentions/src/QuickFixes/SpecifyParameterBaseTypeFix.fs

@@ -122,7 +122,7 @@ type SpecifyParameterBaseTypeFix(refExpr: IReferenceExpr, typeUsage: ITypeUsage)
         use writeCookie = WriteLockCookie.Create(pat.IsPhysical())
 
         let baseType, displayContext = baseType.Value
-        SpecifyTypes.specifyParameterType displayContext baseType pat
+        SpecifyTypes.specifyPatternType displayContext baseType pat
 
     override this.Execute(solution, textControl) =
         let fcsEntity, displayContext = getFcsEntity typeUsage |> Option.get

ReSharper.FSharp/src/FSharp/FSharp.Psi.Intentions/src/QuickFixes/SpecifyParameterTypeFix.fs

@@ -81,7 +81,7 @@ type SpecifyParameterTypeFix(qualifiedExpr: IQualifiedExpr) =
 
     override this.SpecifyType(decl, mfv, d) =
         let decl = decl :?> ILocalReferencePat
-        SpecifyTypes.specifyParameterType d mfv.FullType decl
+        SpecifyTypes.specifyPatternType d mfv.FullType decl
 
 
 type SpecifyPropertyTypeFix(qualifiedExpr: IQualifiedExpr) =

ReSharper.FSharp/src/FSharp/FSharp.Psi.Services/src/Util/FcsTypeUtil.fs

@@ -1,6 +1,8 @@
 module JetBrains.ReSharper.Plugins.FSharp.Psi.Features.Util.FcsTypeUtil
 
 open FSharp.Compiler.Symbols
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Tree
+open JetBrains.ReSharper.Plugins.FSharp.Util
 
 let getFunctionTypeArgs includeReturnType fcsType =
     let rec loop (fcsType: FSharpType) acc =
@@ -19,3 +21,8 @@ let getFunctionTypeArgs includeReturnType fcsType =
                 acc
 
     loop fcsType [] |> List.rev
+
+let tryGetOuterOptionalParameterAndItsType (pattern: IReferencePat) fcsType =
+    let optionalValPat = OptionalValPatNavigator.GetByPattern(pattern)
+    if isNotNull optionalValPat && isOption fcsType then (optionalValPat : IFSharpPattern), fcsType.GenericArguments[0]
+    else pattern, fcsType

ReSharper.FSharp/src/FSharp/FSharp.Psi.Services/src/Util/ParenPatUtil.fs

@@ -221,22 +221,27 @@ let addParensIfNeeded (pattern: IFSharpPattern) =
 
             let nextSibling = nameNode.NextSibling
             if isInlineSpace nextSibling && nextSibling.NextSibling == pattern && nextSibling.GetTextLength() = 1 then
-                let settingsStore = pattern.GetSettingsStoreWithEditorConfig()
-                let spaceBeforeUppercase =
-                    settingsStore.GetValue(fun (key: FSharpFormatSettingsKey) -> key.SpaceBeforeUppercaseInvocation)
+                ModificationUtil.DeleteChild(nextSibling)
 
-                if not spaceBeforeUppercase then
-                    ModificationUtil.DeleteChild(nextSibling)
+        let settingsStore = parenPattern.GetSettingsStoreWithEditorConfig()
 
         let parametersOwnerPat = ParametersOwnerPatNavigator.GetByParameter(parenPattern)
-        if isNotNull parametersOwnerPat then
+        if isNotNull parametersOwnerPat &&
+           not (settingsStore.GetValue(fun (key: FSharpFormatSettingsKey) -> key.SpaceBeforeUppercaseInvocation)) then
             removeSpace parametersOwnerPat.ReferenceName parenPattern
 
         let patternDeclaration = ParametersPatternDeclarationNavigator.GetByPattern(parenPattern)
         let memberDeclaration = MemberDeclarationNavigator.GetByParametersDeclaration(patternDeclaration)
-        if isNotNull memberDeclaration then
+        if isNotNull memberDeclaration &&
+           not (settingsStore.GetValue(fun (key: FSharpFormatSettingsKey) -> key.SpaceBeforeUppercaseInvocation)) then
             removeSpace memberDeclaration.Identifier patternDeclaration
 
+        let ctorDeclaration = PrimaryConstructorDeclarationNavigator.GetByParametersDeclaration(patternDeclaration)
+        let typeDeclaration = FSharpTypeDeclarationNavigator.GetByPrimaryConstructorDeclaration(ctorDeclaration)
+        if isNotNull typeDeclaration &&
+           not (settingsStore.GetValue(fun (key: FSharpFormatSettingsKey) -> key.SpaceBeforeClassConstructor)) then
+            removeSpace typeDeclaration.Identifier ctorDeclaration
+
         pattern
     else
         pattern

ReSharper.FSharp/test/data/features/daemon/redundantParens/pat/Typed 08 - As.fs

@@ -0,0 +1,3 @@
+module Module
+
+let a as (b: int) = 1

ReSharper.FSharp/test/data/features/daemon/redundantParens/pat/Typed 08 - As.fs.gold

@@ -0,0 +1,5 @@
+module Module
+
+let a as (b: int) = 1
+
+---------------------------------------------------------

ReSharper.FSharp/test/data/features/daemon/redundantParens/pat/Typed 09 - Named field.fs

@@ -0,0 +1,4 @@
+module Module
+
+type R = { A: int }
+let { A = (a: int) } = failwith ""

ReSharper.FSharp/test/data/features/daemon/redundantParens/pat/Typed 09 - Named field.fs.gold

@@ -0,0 +1,6 @@
+module Module
+
+type R = { A: int }
+let { A = (a: int) } = failwith ""
+
+---------------------------------------------------------

ReSharper.FSharp/test/data/features/intentions/specifyTypes/availability/Patterns 01.fs

@@ -0,0 +1,9 @@
+module Module
+
+let x{off} = 1
+let a, b{on} = 1, 1
+
+let f{off} x{on} (So{off}me(y{on})) (z{off}: int) = ()
+
+type A() =
+  member _.M(?x{on}, ?y{off}: int) = x + y

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Ands pat 01.fs

@@ -0,0 +1,5 @@
+module Module
+
+let (|Bool|) (x: int) = true
+
+let f (x{caret} & Bool(_)) = ()

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Ands pat 01.fs.gold

@@ -0,0 +1,5 @@
+module Module
+
+let (|Bool|) (x: int) = true
+
+let f (x: int{caret} & Bool(_)) = ()

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/As pat 01.fs

@@ -0,0 +1,3 @@
+module Module
+
+let f (x, y as z{caret}) = ()

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/As pat 01.fs.gold

@@ -0,0 +1,3 @@
+module Module
+
+let f (x, y as (z: 'a * 'b){caret}) = ()

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Lambda 01.fs

@@ -0,0 +1,3 @@
+module Module
+
+fun x{caret} -> x + 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Lambda 01.fs.gold

@@ -0,0 +1,3 @@
+module Module
+
+fun (x: int){caret} -> x + 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Parameter 01.fs

@@ -0,0 +1,3 @@
+module Module
+
+let f x{caret} = x + 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Parameter 01.fs.gold

@@ -0,0 +1,3 @@
+module Module
+
+let f (x: int){caret} = x + 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Parameter 02 - Optional.fs

@@ -0,0 +1,4 @@
+module Module
+
+type A =
+    member _.M1(?x{caret}) = x.Value + 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Parameter 02 - Optional.fs.gold

@@ -0,0 +1,4 @@
+module Module
+
+type A =
+    member _.M1(?x: int{caret}) = x.Value + 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Record field 01.fs

@@ -0,0 +1,5 @@
+module Module
+
+type R = { A: int }
+
+let f { A = a{caret} } = ()

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Record field 01.fs.gold

@@ -0,0 +1,5 @@
+module Module
+
+type R = { A: int }
+
+let f { A = (a: int){caret} } = ()

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Tuple 01.fs

@@ -0,0 +1,3 @@
+module Module
+
+let f (a{caret}, b) = a + b

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Tuple 01.fs.gold

@@ -0,0 +1,3 @@
+module Module
+
+let f (a: int{caret}, b) = a + b

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Tuple 02 - Top level.fs

@@ -0,0 +1,3 @@
+module Module
+
+let a, b{caret} = 1, 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Tuple 02 - Top level.fs.gold

@@ -0,0 +1,3 @@
+module Module
+
+let a, (b: int){caret} = 1, 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Tuple 03 - As.fs

@@ -0,0 +1,3 @@
+module Module
+
+let f (x{caret}, y as z) = ()

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Tuple 03 - As.fs.gold

@@ -0,0 +1,3 @@
+module Module
+
+let f (x: 'a{caret}, y as z) = ()

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Union case 01.fs

@@ -0,0 +1,3 @@
+module Module
+
+let f (Some(x{caret})) = x + 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Union case 01.fs.gold

@@ -0,0 +1,3 @@
+module Module
+
+let f (Some(x: int{caret})) = x + 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Union case 02 - Named.fs

@@ -0,0 +1,3 @@
+module Module
+
+let f (Some(Value = x{caret})) = x + 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Union case 02 - Named.fs.gold

@@ -0,0 +1,3 @@
+module Module
+
+let f (Some(Value = (x: int){caret})) = x + 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Union case 03 - Parens.fs

@@ -0,0 +1,3 @@
+module Module
+
+let f (Some x{caret}) = x + 1

ReSharper.FSharp/test/data/features/intentions/specifyTypes/patterns/Union case 03 - Parens.fs.gold

@@ -0,0 +1,3 @@
+module Module
+
+let f (Some(x: int){caret}) = x + 1

ReSharper.FSharp/test/src/FSharp.Intentions.Tests/src/Daemon/RedundantParenPatTest.fs

@@ -56,6 +56,10 @@ type RedundantParenPatTest() =
     [<Test>] member x.``Typed 05 - Members param decl``() = x.DoNamedTest()
     [<Test>] member x.``Typed 06 - Tuple``() = x.DoNamedTest()
     [<Test>] member x.``Typed 07 - Match clause``() = x.DoNamedTest()
+    //TODO: remove parens
+    [<Test>] member x.``Typed 08 - As``() = x.DoNamedTest()
+    //TODO: remove parens
+    [<Test>] member x.``Typed 09 - Named field``() = x.DoNamedTest()
 
     [<Test>] member x.``Wild - Function param 01``() = x.DoNamedTest()
     [<Test>] member x.``Wild - Pattern param 01``() = x.DoNamedTest()

ReSharper.FSharp/test/src/FSharp.Intentions.Tests/src/Intentions/SpecifyTypesTest.fs

@@ -5,7 +5,7 @@ open JetBrains.ReSharper.Plugins.FSharp.Services.Formatter
 open JetBrains.ReSharper.TestFramework
 open NUnit.Framework
 
-type SpecifyTypesActionTest() =
+type SpecifyFunctionTypesActionTest() =
     inherit FSharpContextActionExecuteTestBase<FunctionAnnotationAction>()
 
     override x.ExtraPath = "specifyTypes"
@@ -58,6 +58,33 @@ type SpecifyTypesActionTest() =
     [<Test>] member x.``Function - Recursive - Function 04`` () = x.DoNamedTest()
 
 
+type SpecifyPatternTypeActionTest() =
+    inherit FSharpContextActionExecuteTestBase<PatternAnnotationAction>()
+
+    override x.ExtraPath = "specifyTypes/patterns"
+
+    [<Test>] member x.``Parameter 01``() = x.DoNamedTest()
+    [<Test>] member x.``Parameter 02 - Optional``() = x.DoNamedTest()
+
+    [<Test>] member x.``Lambda 01``() = x.DoNamedTest()
+
+    [<Test>] member x.``Tuple 01``() = x.DoNamedTest()
+    [<Test>] member x.``Tuple 02 - Top level``() = x.DoNamedTest()
+    [<Test>] member x.``Tuple 03 - As``() = x.DoNamedTest()
+
+    //TODO: remove parens
+    [<Test>] member x.``Record field 01``() = x.DoNamedTest()
+
+    [<Test>] member x.``Union case 01``() = x.DoNamedTest()
+    //TODO: remove parens
+    [<Test>] member x.``Union case 02 - Named``() = x.DoNamedTest()
+    [<Test>] member x.``Union case 03 - Parens``() = x.DoNamedTest()
+
+    [<Test>] member x.``As pat 01``() = x.DoNamedTest()
+
+    [<Test>] member x.``Ands pat 01``() = x.DoNamedTest()
+
+
 type SpecifyTypesActionAvailabilityTest() =
     inherit FSharpContextActionAvailabilityTestBase<FunctionAnnotationAction>()
 
@@ -71,3 +98,11 @@ type SpecifyTypesActionAvailabilityTest() =
     [<Test>] member x.``LetBang - 01`` () = x.DoNamedTest()
     [<Test>] member x.``UseBang - 01`` () = x.DoNamedTest()
     [<Test>] member x.``AndBang - 01`` () = x.DoNamedTest()
+
+
+type SpecifyPatternTypeActionAvailabilityTest() =
+    inherit FSharpContextActionAvailabilityTestBase<PatternAnnotationAction>()
+
+    override x.ExtraPath = "specifyTypes"
+
+    [<Test>] member x.``Patterns 01``() = x.DoNamedTest()