Omit more parens for wildcard type signature (#2929)

This is a followup to #2764.

Author: sergv

ghcide/src/Development/IDE/Plugin/CodeAction.hs

@@ -1561,15 +1561,19 @@ mkRenameEdit contents range name =
 -- require understanding both the precedence of the context of the hole and of
 -- the signature itself. Inserting them (almost) unconditionally is ugly but safe.
 extractWildCardTypeSignature :: T.Text -> T.Text
-extractWildCardTypeSignature msg = (if enclosed || not application then id else bracket) signature
+extractWildCardTypeSignature msg
+  | enclosed || not isApp || isToplevelSig = sig
+  | otherwise                              = "(" <> sig <> ")"
   where
-    msgSigPart = snd $ T.breakOnEnd "standing for " msg
-    signature = T.takeWhile (/='’') . T.dropWhile (=='‘') . T.dropWhile (/='‘') $ msgSigPart
-    -- parenthesize type applications, e.g. (Maybe Char)
-    application = any isSpace . T.unpack $ signature
-    -- do not add extra parentheses to lists, tuples and already parenthesized types
-    enclosed = not (T.null signature) && (T.head signature, T.last signature) `elem` [('(',')'), ('[',']')]
-    bracket = ("(" `T.append`) . (`T.append` ")")
+    msgSigPart      = snd $ T.breakOnEnd "standing for " msg
+    (sig, rest)     = T.span (/='’') . T.dropWhile (=='‘') . T.dropWhile (/='‘') $ msgSigPart
+    (prefix, rest') = T.breakOn "• In the type signature:" rest
+    -- If we're completing something like ‘foo :: _’ parens can be safely omitted.
+    isToplevelSig   = not (T.null prefix) && " :: _" `T.isSuffixOf` T.takeWhile (/= '\n') rest'
+    -- Parenthesize type applications, e.g. (Maybe Char).
+    isApp           = T.any isSpace sig
+    -- Do not add extra parentheses to lists, tuples and already parenthesized types.
+    enclosed        = not (T.null sig) && (T.head sig, T.last sig) `elem` [('(', ')'), ('[', ']')]
 
 extractRenamableTerms :: T.Text -> [T.Text]
 extractRenamableTerms msg

ghcide/test/exe/Main.hs

@@ -1196,7 +1196,7 @@ typeWildCardActionTests = testGroup "type wildcard actions"
         [ "func :: _"
         , "func x = x"
         ]
-        [ "func :: (p -> p)"
+        [ "func :: p -> p"
         , "func x = x"
         ]
   , testUseTypeSignature "local signature"
@@ -1212,11 +1212,11 @@ typeWildCardActionTests = testGroup "type wildcard actions"
         , "      y = x * 2"
         , "  in y"
         ]
-  , testUseTypeSignature "multi-line message"
+  , testUseTypeSignature "multi-line message 1"
         [ "func :: _"
         , "func x y = x + y"
         ]
-        [ "func :: (Integer -> Integer -> Integer)"
+        [ "func :: Integer -> Integer -> Integer"
         , "func x y = x + y"
         ]
   , testUseTypeSignature "type in parentheses"
@@ -1240,6 +1240,43 @@ typeWildCardActionTests = testGroup "type wildcard actions"
         [ "func :: IO ()"
         , "func = putChar 'H'"
         ]
+  , testUseTypeSignature "no spaces around '::'"
+        [ "func::_"
+        , "func x y = x + y"
+        ]
+        [ "func::Integer -> Integer -> Integer"
+        , "func x y = x + y"
+        ]
+  , testGroup "add parens if hole is part of bigger type"
+    [ testUseTypeSignature "subtype 1"
+          [ "func :: _ -> Integer -> Integer"
+          , "func x y = x + y"
+          ]
+          [ "func :: Integer -> Integer -> Integer"
+          , "func x y = x + y"
+          ]
+    , testUseTypeSignature "subtype 2"
+          [ "func :: Integer -> _ -> Integer"
+          , "func x y = x + y"
+          ]
+          [ "func :: Integer -> Integer -> Integer"
+          , "func x y = x + y"
+          ]
+    , testUseTypeSignature "subtype 3"
+          [ "func :: Integer -> Integer -> _"
+          , "func x y = x + y"
+          ]
+          [ "func :: Integer -> Integer -> Integer"
+          , "func x y = x + y"
+          ]
+    , testUseTypeSignature "subtype 4"
+          [ "func :: Integer -> _"
+          , "func x y = x + y"
+          ]
+          [ "func :: Integer -> (Integer -> Integer)"
+          , "func x y = x + y"
+          ]
+    ]
   ]
   where
     -- | Test session of given name, checking action "Use type signature..."