Omit more parens for wildcard type signature

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

@@ -1561,15 +1561,57 @@ 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
+    -- If we're completing something like ‘foo :: _’ parens can be safely omitted.
+    isToplevelSig   = errorMessageRefersToToplevelHole 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` [('(', ')'), ('[', ']')]
+
+-- | Detect whether user wrote something like @foo :: _@ or @foo :: (_, Int)@.
+-- The former is considered toplevel case for which the function returns 'True',
+-- the latter is not toplevel and the returned value is 'False'.
+--
+-- When type hole is at toplevel then there’s a line starting with
+-- "• In the type signature" which ends with " :: _" like in the
+-- following snippet:
+--
+-- source/library/Language/Haskell/Brittany/Internal.hs:131:13: error:
+--     • Found type wildcard ‘_’ standing for ‘HsDecl GhcPs’
+--       To use the inferred type, enable PartialTypeSignatures
+--     • In the type signature: decl :: _
+--       In an equation for ‘splitAnnots’:
+--           splitAnnots m@HsModule {hsmodAnn, hsmodDecls}
+--             = undefined
+--             where
+--                 ann :: SrcSpanAnnA
+--                 decl :: _
+--                 L ann decl = head hsmodDecls
+--     • Relevant bindings include
+--       [REDACTED]
+--
+-- When type hole is not at toplevel there’s a stack of where
+-- the hole was located ending with "In the type signature":
+--
+-- source/library/Language/Haskell/Brittany/Internal.hs:130:20: error:
+--     • Found type wildcard ‘_’ standing for ‘GhcPs’
+--       To use the inferred type, enable PartialTypeSignatures
+--     • In the first argument of ‘HsDecl’, namely ‘_’
+--       In the type ‘HsDecl _’
+--       In the type signature: decl :: HsDecl _
+--     • Relevant bindings include
+--       [REDACTED]
+errorMessageRefersToToplevelHole :: T.Text -> Bool
+errorMessageRefersToToplevelHole msg =
+  not (T.null prefix) && " :: _" `T.isSuffixOf` T.takeWhile (/= '\n') rest
+  where
+    (prefix, rest) = T.breakOn "• In the type signature:" msg
 
 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..."