Also suggest importing methods without parent class (#766)

* 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>

Author: 3 people

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

@@ -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 <> ")"

ghcide/src/Development/IDE/Types/Exports.hs

@@ -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
       ]
 

ghcide/test/exe/Main.hs

@@ -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
-
-            -- 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
@@ -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