Skip to content

Avoid extra parens for wildcard type signature #2764

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Mar 9, 2022
Merged

Avoid extra parens for wildcard type signature #2764

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
22 changes: 15 additions & 7 deletions ghcide/src/Development/IDE/Plugin/CodeAction.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1529,14 +1529,22 @@ mkRenameEdit contents range name =
curr <- textInRange range <$> contents
pure $ "`" `T.isPrefixOf` curr && "`" `T.isSuffixOf` curr


-- | Extract the type and surround it in parentheses except in obviously safe cases.
--
-- Inferring when parentheses are actually needed around the type signature would
-- 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 =
-- inferring when parens are actually needed around the type signature would
-- require understanding both the precedence of the context of the _ and of
-- the signature itself. Inserting them unconditionally is ugly but safe.
("(" `T.append`) . (`T.append` ")") .
T.takeWhile (/='’') . T.dropWhile (=='‘') . T.dropWhile (/='‘') .
snd . T.breakOnEnd "standing for "
extractWildCardTypeSignature msg = (if enclosed || not application then id else bracket) signature
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` ")")

extractRenamableTerms :: T.Text -> [T.Text]
extractRenamableTerms msg
Expand Down
130 changes: 64 additions & 66 deletions ghcide/test/exe/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1188,73 +1188,71 @@ renameActionTests = testGroup "rename actions"

typeWildCardActionTests :: TestTree
typeWildCardActionTests = testGroup "type wildcard actions"
[ testSession "global signature" $ do
let content = T.unlines
[ "module Testing where"
, "func :: _"
, "func x = x"
]
doc <- createDoc "Testing.hs" "haskell" content
_ <- waitForDiagnostics
actionsOrCommands <- getAllCodeActions doc
let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands
, "Use type signature" `T.isInfixOf` actionTitle
]
executeCodeAction addSignature
contentAfterAction <- documentContents doc
let expectedContentAfterAction = T.unlines
[ "module Testing where"
, "func :: (p -> p)"
, "func x = x"
]
liftIO $ expectedContentAfterAction @=? contentAfterAction
, testSession "multi-line message" $ do
let content = T.unlines
[ "module Testing where"
, "func :: _"
, "func x y = x + y"
]
doc <- createDoc "Testing.hs" "haskell" content
_ <- waitForDiagnostics
actionsOrCommands <- getAllCodeActions doc
let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands
, "Use type signature" `T.isInfixOf` actionTitle
]
executeCodeAction addSignature
contentAfterAction <- documentContents doc
let expectedContentAfterAction = T.unlines
[ "module Testing where"
, "func :: (Integer -> Integer -> Integer)"
, "func x y = x + y"
]
liftIO $ expectedContentAfterAction @=? contentAfterAction
, testSession "local signature" $ do
let content = T.unlines
[ "module Testing where"
, "func :: Int -> Int"
, "func x ="
, " let y :: _"
, " y = x * 2"
, " in y"
]
doc <- createDoc "Testing.hs" "haskell" content
_ <- waitForDiagnostics
actionsOrCommands <- getAllCodeActions doc
let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands
, "Use type signature" `T.isInfixOf` actionTitle
]
executeCodeAction addSignature
contentAfterAction <- documentContents doc
let expectedContentAfterAction = T.unlines
[ "module Testing where"
, "func :: Int -> Int"
, "func x ="
, " let y :: (Int)"
, " y = x * 2"
, " in y"
]
liftIO $ expectedContentAfterAction @=? contentAfterAction
[ testUseTypeSignature "global signature"
[ "func :: _"
, "func x = x"
]
[ "func :: (p -> p)"
, "func x = x"
]
, testUseTypeSignature "local signature"
[ "func :: Int -> Int"
, "func x ="
, " let y :: _"
, " y = x * 2"
, " in y"
]
[ "func :: Int -> Int"
, "func x ="
, " let y :: Int"
, " y = x * 2"
, " in y"
]
, testUseTypeSignature "multi-line message"
[ "func :: _"
, "func x y = x + y"
]
[ "func :: (Integer -> Integer -> Integer)"
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hmmm, I guess it's not easy to tell if the hole is the entirety of the type signature? That seems like the remaining slightly bad case, and also probably a relatively common one...

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Anyway, that can be future work.

, "func x y = x + y"
]
, testUseTypeSignature "type in parentheses"
[ "func :: a -> _"
, "func x = (x, const x)"
]
[ "func :: a -> (a, b -> a)"
, "func x = (x, const x)"
]
, testUseTypeSignature "type in brackets"
[ "func :: _ -> Maybe a"
, "func xs = head xs"
]
[ "func :: [Maybe a] -> Maybe a"
, "func xs = head xs"
]
, testUseTypeSignature "unit type"
[ "func :: IO _"
, "func = putChar 'H'"
]
[ "func :: IO ()"
, "func = putChar 'H'"
]
]
where
-- | Test session of given name, checking action "Use type signature..."
-- on a test file with given content and comparing to expected result.
testUseTypeSignature name textIn textOut = testSession name $ do
let fileStart = "module Testing where"
content = T.unlines $ fileStart : textIn
expectedContentAfterAction = T.unlines $ fileStart : textOut
doc <- createDoc "Testing.hs" "haskell" content
_ <- waitForDiagnostics
actionsOrCommands <- getAllCodeActions doc
let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands
, "Use type signature" `T.isInfixOf` actionTitle
]
executeCodeAction addSignature
contentAfterAction <- documentContents doc
liftIO $ expectedContentAfterAction @=? contentAfterAction

{-# HLINT ignore "Use nubOrd" #-}
removeImportTests :: TestTree
Expand Down