diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 29372cfc59..267c51c398 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/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 diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index f13c4e183c..b91af99c74 100644 --- a/ghcide/test/exe/Main.hs +++ b/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..."