Skip to content

Commit

Permalink
Also suggest importing methods without parent class (haskell#766)
Browse files Browse the repository at this point in the history 
* 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 <[email protected]>
Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
  • Loading branch information
@mrBliss @jneira
@mergify @pepeiborra
3 people authored and pepeiborra committed Jan 9, 2021
1 parent 47a4971 commit aa66cb2
Show file tree
Hide file tree
Showing 3 changed files with 130 additions and 28 deletions.
79 changes: 63 additions & 16 deletions ghcide/src/Development/IDE/Plugin/CodeAction.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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),...)`
Expand Down Expand Up @@ -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 changes: 3 additions & 3 deletions ghcide/src/Development/IDE/Types/Exports.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
]

Expand Down
73 changes: 64 additions & 9 deletions ghcide/test/exe/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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})
Expand All @@ -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

-- Get the first action and execute the first action
let CACodeAction action : _
= sortOn (\(CACodeAction CodeAction{_title=x}) -> x) codeActions
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

-- 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
Expand Down Expand Up @@ -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)"
Expand All @@ -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"
Expand All @@ -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
Expand Down

0 comments on commit aa66cb2

Please sign in to comment.