haskell/haskell-language-server
1
1
Fork 0
mirror of https://github.com/haskell/haskell-language-server.git synced 2024-11-10 06:46:24 +03:00
Code Issues Projects Releases Wiki Activity

Also suggest importing methods without parent class (#766)

Browse Source 
* Make it possible to choose the code action in extendImportTests

Let the order of the expected code actions dictate which one to execute, i.e.,
the first one. This means we no longer test the *order* of the suggested code
actions. Through this simple change, we can now test the execution of a code
action that doesn't come first in the list of suggested code actions.

* Suggest imports without the parent class

When suggesting to import a method `m` of class `C` from module `M`, in addition
to the suggestions `import M` and `import M (C(m))`, also suggest importing the
method without mentioning the enclosing class: `import M (m)`.

Co-authored-by: Javier Neira <atreyu.bbb@gmail.com>
Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
This commit is contained in:
Thomas Winant 2021-01-05 11:54:49 +01:00 committed by GitHub
parent 840dd3d3cb
commit 8b7090fb94
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 129 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
ghcide/src/Development/IDE/Plugin/CodeAction.hs
View File

@ -48,6 +48,8 @@ import Data.Aeson.Types (toJSON, fromJSON, Value(..), Result(..))
import Data.Char
import Data.Maybe
import Data.List.Extra
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Text.Regex.TDFA (mrAfter, (=~), (=~~))
import Outputable (ppr, showSDocUnsafe)
@ -622,9 +624,13 @@ suggestExtendImport exportsMap contents Diagnostic{_range=_range,..}
in x{_end = (_end x){_character = succ (_character (_end x))}}
_ -> error "bug in srcspan parser",
importLine <- textInRange range c,
Just ident <- lookupExportMap binding mod,
Just result <- addBindingToImportList ident importLine
= [("Add " <> renderIdentInfo ident <> " to the import list of " <> mod, [TextEdit range result])]
Just ident <- lookupExportMap binding mod
= [ ( "Add " <> rendered <> " to the import list of " <> mod
, [TextEdit range result]
)
| importStyle <- NE.toList $ importStyles ident
, let rendered = renderImportStyle importStyle
, result <- maybeToList $ addBindingToImportList importStyle importLine]
| otherwise = []
lookupExportMap binding mod
| Just match <- Map.lookup binding (getExportsMap exportsMap)
@ -933,13 +939,15 @@ constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules =
, suggestion <- renderNewImport identInfo m
]
where
renderNewImport :: IdentInfo -> T.Text -> [T.Text]
renderNewImport identInfo m
| Just q <- qual
, asQ <- if q == m then "" else " as " <> q
= ["import qualified " <> m <> asQ]
| otherwise
= ["import " <> m <> " (" <> renderIdentInfo identInfo <> ")"
,"import " <> m ]
= ["import " <> m <> " (" <> renderImportStyle importStyle <> ")"
| importStyle <- NE.toList $ importStyles identInfo] ++
["import " <> m ]
canUseIdent :: NotInScope -> IdentInfo -> Bool
canUseIdent NotInScopeDataConstructor{} = isDatacon
@ -1080,15 +1088,18 @@ rangesForBinding' _ _ = []
-- import (qualified) A (..) ..
-- Places the new binding first, preserving whitespace.
-- Copes with multi-line import lists
addBindingToImportList :: IdentInfo -> T.Text -> Maybe T.Text
addBindingToImportList IdentInfo {parent = _parent, ..} importLine =
addBindingToImportList :: ImportStyle -> T.Text -> Maybe T.Text
addBindingToImportList importStyle importLine =
case T.breakOn "(" importLine of
(pre, T.uncons -> Just (_, rest)) ->
case _parent of
-- the binding is not a constructor, add it to the head of import list
Nothing -> Just $ T.concat [pre, "(", rendered, addCommaIfNeeds rest]
Just parent -> case T.breakOn parent rest of
-- the binding is a constructor, and current import list contains its parent
case importStyle of
ImportTopLevel rendered ->
-- the binding has no parent, add it to the head of import list
Just $ T.concat [pre, "(", rendered, addCommaIfNeeds rest]
ImportViaParent rendered parent -> case T.breakOn parent rest of
-- the binding has a parent, and the current import list contains the
-- parent
--
-- `rest'` could be 1. `,...)`
-- or 2. `(),...)`
-- or 3. `(ConsA),...)`
@ -1180,7 +1191,43 @@ matchRegExMultipleImports message = do
imps <- regExImports imports
return (binding, imps)
renderIdentInfo :: IdentInfo -> T.Text
renderIdentInfo IdentInfo {parent, rendered}
| Just p <- parent = p <> "(" <> rendered <> ")"
| otherwise = rendered
-- | Possible import styles for an 'IdentInfo'.
--
-- The first 'Text' parameter corresponds to the 'rendered' field of the
-- 'IdentInfo'.
data ImportStyle
= ImportTopLevel T.Text
-- ^ Import a top-level export from a module, e.g., a function, a type, a
-- class.
--
-- > import M (?)
--
-- Some exports that have a parent, like a type-class method or an
-- associated type/data family, can still be imported as a top-level
-- import.
--
-- Note that this is not the case for constructors, they must always be
-- imported as part of their parent data type.
| ImportViaParent T.Text T.Text
-- ^ Import an export (first parameter) through its parent (second
-- parameter).
--
-- import M (P(?))
--
-- @P@ and @?@ can be a data type and a constructor, a class and a method,
-- a class and an associated type/data family, etc.
importStyles :: IdentInfo -> NonEmpty ImportStyle
importStyles IdentInfo {parent, rendered, isDatacon}
| Just p <- parent
-- Constructors always have to be imported via their parent data type, but
-- methods and associated type/data families can also be imported as
-- top-level exports.
= ImportViaParent rendered p :| [ImportTopLevel rendered | not isDatacon]
| otherwise
= ImportTopLevel rendered :| []
renderImportStyle :: ImportStyle -> T.Text
renderImportStyle (ImportTopLevel x) = x
renderImportStyle (ImportViaParent x p) = p <> "(" <> x <> ")"

6
ghcide/src/Development/IDE/Types/Exports.hs
View File

@ -53,15 +53,15 @@ mkIdentInfos (Avail n) =
mkIdentInfos (AvailTC parent (n:nn) flds)
-- Following the GHC convention that parent == n if parent is exported
| n == parent
= [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) (Just $! parentP) True
= [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) (Just $! parentP) (isDataConName n)
| n <- nn ++ map flSelector flds
] ++
[ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing False]
[ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing (isDataConName n)]
where
parentP = pack $ prettyPrint parent
mkIdentInfos (AvailTC _ nn flds)
= [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing True
= [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing (isDataConName n)
| n <- nn ++ map flSelector flds
]

71
ghcide/test/exe/Main.hs
View File

@ -1207,6 +1207,46 @@ extendImportTests = testGroup "extend import actions"
, " )"
, "main = print (stuffA, stuffB)"
])
, testSession "extend single line import with method within class" $ template
[("ModuleA.hs", T.unlines
[ "module ModuleA where"
, "class C a where"
, " m1 :: a -> a"
, " m2 :: a -> a"
])]
("ModuleB.hs", T.unlines
[ "module ModuleB where"
, "import ModuleA (C(m1))"
, "b = m2"
])
(Range (Position 2 5) (Position 2 5))
["Add C(m2) to the import list of ModuleA",
"Add m2 to the import list of ModuleA"]
(T.unlines
[ "module ModuleB where"
, "import ModuleA (C(m2, m1))"
, "b = m2"
])
, testSession "extend single line import with method without class" $ template
[("ModuleA.hs", T.unlines
[ "module ModuleA where"
, "class C a where"
, " m1 :: a -> a"
, " m2 :: a -> a"
])]
("ModuleB.hs", T.unlines
[ "module ModuleB where"
, "import ModuleA (C(m1))"
, "b = m2"
])
(Range (Position 2 5) (Position 2 5))
["Add m2 to the import list of ModuleA",
"Add C(m2) to the import list of ModuleA"]
(T.unlines
[ "module ModuleB where"
, "import ModuleA (m2, C(m1))"
, "b = m2"
])
, testSession "extend import list with multiple choices" $ template
[("ModuleA.hs", T.unlines
-- this is just a dummy module to help the arguments needed for this test
@ -1235,7 +1275,9 @@ extendImportTests = testGroup "extend import actions"
])
]
where
template setUpModules moduleUnderTest range expectedActions expectedContentB = do
codeActionTitle CodeAction{_title=x} = x
template setUpModules moduleUnderTest range expectedTitles expectedContentB = do
sendNotification WorkspaceDidChangeConfiguration
(DidChangeConfigurationParams $ toJSON
def{checkProject = overrideCheckProject})
@ -1245,14 +1287,23 @@ extendImportTests = testGroup "extend import actions"
docB <- createDoc (fst moduleUnderTest) "haskell" (snd moduleUnderTest)
_ <- waitForDiagnostics
void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
codeActions <- filter (\(CACodeAction CodeAction{_title=x}) -> T.isPrefixOf "Add" x)
<$> getCodeActions docB range
let expectedTitles = (\(CACodeAction CodeAction{_title=x}) ->x) <$> codeActions
liftIO $ expectedActions @=? expectedTitles
actionsOrCommands <- getCodeActions docB range
let codeActions =
filter
(T.isPrefixOf "Add" . codeActionTitle)
[ca | CACodeAction ca <- actionsOrCommands]
actualTitles = codeActionTitle <$> codeActions
-- Note that we are not testing the order of the actions, as the
-- order of the expected actions indicates which one we'll execute
-- in this test, i.e., the first one.
liftIO $ sort expectedTitles @=? sort actualTitles
-- Get the first action and execute the first action
let CACodeAction action : _
= sortOn (\(CACodeAction CodeAction{_title=x}) -> x) codeActions
-- Execute the action with the same title as the first expected one.
-- Since we tested that both lists have the same elements (possibly
-- in a different order), this search cannot fail.
let firstTitle:_ = expectedTitles
action = fromJust $
find ((firstTitle ==) . codeActionTitle) codeActions
executeCodeAction action
contentAfterAction <- documentContents docB
liftIO $ expectedContentB @=? contentAfterAction
@ -1285,6 +1336,8 @@ suggestImportTests = testGroup "suggest import actions"
, test False [] "f :: Typeable a => a" ["f = undefined"] "import Data.Typeable.Internal (Typeable)"
-- package not in scope
, test False [] "f = quickCheck" [] "import Test.QuickCheck (quickCheck)"
-- don't omit the parent data type of a constructor
, test False [] "f ExitSuccess = ()" [] "import System.Exit (ExitSuccess)"
]
, testGroup "want suggestion"
[ wantWait [] "f = foo" [] "import Foo (foo)"
@ -1305,6 +1358,7 @@ suggestImportTests = testGroup "suggest import actions"
, test True [] "f :: Alternative f => f ()" ["f = undefined"] "import Control.Applicative (Alternative)"
, test True [] "f :: Alternative f => f ()" ["f = undefined"] "import Control.Applicative"
, test True [] "f = empty" [] "import Control.Applicative (Alternative(empty))"
, test True [] "f = empty" [] "import Control.Applicative (empty)"
, test True [] "f = empty" [] "import Control.Applicative"
, test True [] "f = (&)" [] "import Data.Function ((&))"
, test True [] "f = NE.nonEmpty" [] "import qualified Data.List.NonEmpty as NE"
@ -1315,6 +1369,7 @@ suggestImportTests = testGroup "suggest import actions"
, test True [] "f = [] & id" [] "import Data.Function ((&))"
, test True [] "f = (&) [] id" [] "import Data.Function ((&))"
, test True [] "f = (.|.)" [] "import Data.Bits (Bits((.|.)))"
, test True [] "f = (.|.)" [] "import Data.Bits ((.|.))"
]
]
where