Extend import suggestions for more than one option (#913)

* Add support for extending import list when multiple options are available

* Add function to module export list to make it available for testing

* Fix typo

* Add doc strings

* Add tests for testing regex used to parse multiple choices for import suggestions.

* Add test group

* Remove trailing spaces

* Hlint suggestions

* Remove not used variable

* Remove temporary code

* Reuse matchRegExUnifySpaces

* Fix test input.

* Use testCase instead of testSession

* Update extend import tests to assert on multiple actions.

* Extend extendImports to use multiple modules for setup

* Hlint changes

Author: gdevanla

src/Development/IDE/Plugin/CodeAction.hs

@@ -19,6 +19,7 @@ module Development.IDE.Plugin.CodeAction
     -- * For testing
     , blockCommandId
     , typeSignatureCommandId
+    , matchRegExMultipleImports
     ) where
 
 import Control.Monad (join, guard)
@@ -381,7 +382,7 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul
     opLetter = ":!#$%&*+./<=>?@\\^|-~"
 
     parenthesizeIfNeeds :: Bool -> T.Text -> T.Text
-    parenthesizeIfNeeds needsTypeKeyword x 
+    parenthesizeIfNeeds needsTypeKeyword x
       | T.head x `elem` opLetter = (if needsTypeKeyword then "type " else "") <> "(" <> x <>")"
       | otherwise = x
 
@@ -649,14 +650,23 @@ suggestExtendImport (Just dflags) contents Diagnostic{_range=_range,..}
       "Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\).$"
     , Just c <- contents
     , POk _ (L _ name) <- runParser dflags (T.unpack binding) parseIdentifier
-    = let range = case [ x | (x,"") <- readSrcSpan (T.unpack srcspan)] of
-            [s] -> let x = realSrcSpanToRange s
-                   in x{_end = (_end x){_character = succ (_character (_end x))}}
-            _ -> error "bug in srcspan parser"
-          importLine = textInRange range c
-        in [("Add " <> binding <> " to the import list of " <> mod
-        , [TextEdit range (addBindingToImportList (T.pack $ printRdrName name) importLine)])]
+    = [suggestions name c binding mod srcspan]
+    | Just (binding, mod_srcspan) <-
+      matchRegExMultipleImports _message
+    , Just c <- contents
+    , POk _ (L _ name) <- runParser dflags (T.unpack binding) parseIdentifier
+    = fmap (\(x, y) -> suggestions name c binding x y) mod_srcspan
     | otherwise = []
+    where
+        suggestions name c binding mod srcspan = let
+            range = case [ x | (x,"") <- readSrcSpan (T.unpack srcspan)] of
+                [s] -> let x = realSrcSpanToRange s
+                   in x{_end = (_end x){_character = succ (_character (_end x))}}
+                _ -> error "bug in srcspan parser"
+            importLine = textInRange range c
+            in
+                ("Add " <> binding <> " to the import list of " <> mod
+                , [TextEdit range (addBindingToImportList (T.pack $ printRdrName name) importLine)])
 suggestExtendImport Nothing _ _ = []
 
 suggestFixConstructorImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
@@ -1135,3 +1145,41 @@ filterNewlines = T.concat  . T.lines
 
 unifySpaces :: T.Text -> T.Text
 unifySpaces    = T.unwords . T.words
+
+-- functions to help parse multiple import suggestions
+
+-- | Returns the first match if found
+regexSingleMatch :: T.Text -> T.Text -> Maybe T.Text
+regexSingleMatch msg regex = case matchRegexUnifySpaces msg regex of
+    Just (h:_) -> Just h
+    _ -> Nothing
+
+-- | Parses tuples like (‘Data.Map’, (app/ModuleB.hs:2:1-18)) and
+-- | return (Data.Map, app/ModuleB.hs:2:1-18)
+regExPair :: (T.Text, T.Text) -> Maybe (T.Text, T.Text)
+regExPair (modname, srcpair) = do
+  x <- regexSingleMatch modname "‘([^’]*)’"
+  y <- regexSingleMatch srcpair "\\((.*)\\)"
+  return (x, y)
+
+-- | Process a list of (module_name, filename:src_span) values
+-- | Eg. [(Data.Map, app/ModuleB.hs:2:1-18), (Data.HashMap.Strict, app/ModuleB.hs:3:1-29)]
+regExImports :: T.Text -> Maybe [(T.Text, T.Text)]
+regExImports msg = result
+  where
+    parts = T.words msg
+    isPrefix = not . T.isPrefixOf "("
+    (mod, srcspan) = partition isPrefix  parts
+    -- check we have matching pairs like (Data.Map, (app/src.hs:1:2-18))
+    result = if length mod == length srcspan then
+               regExPair `traverse` zip mod srcspan
+             else Nothing
+
+matchRegExMultipleImports :: T.Text -> Maybe (T.Text, [(T.Text, T.Text)])
+matchRegExMultipleImports message = do
+  let pat = T.pack "Perhaps you want to add ‘([^’]*)’ to one of these import lists: *(‘.*\\))$"
+  (binding, imports) <- case matchRegexUnifySpaces message pat of
+                            Just [x, xs] -> Just (x, xs)
+                            _ -> Nothing
+  imps <- regExImports imports
+  return (binding, imps)

test/exe/Main.hs

@@ -57,7 +57,7 @@ import Test.Tasty.Ingredients.Rerun
 import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck
 import System.Time.Extra
-import Development.IDE.Plugin.CodeAction (typeSignatureCommandId, blockCommandId)
+import Development.IDE.Plugin.CodeAction (typeSignatureCommandId, blockCommandId, matchRegExMultipleImports)
 import Development.IDE.Plugin.Test (TestRequest(BlockSeconds,GetInterfaceFilesDir))
 
 main :: IO ()
@@ -97,6 +97,8 @@ main = do
     , rootUriTests
     , asyncTests
     , clientSettingsTest
+
+    , codeActionHelperFunctionTests
     ]
 
 initializeResponseTests :: TestTree
@@ -560,6 +562,13 @@ codeActionTests = testGroup "code actions"
   , exportUnusedTests
   ]
 
+codeActionHelperFunctionTests :: TestTree
+codeActionHelperFunctionTests = testGroup "code action helpers"
+    [
+    extendImportTestsRegEx
+    ]
+
+
 codeLensesTests :: TestTree
 codeLensesTests = testGroup "code lenses"
   [ addSigLensesTests
@@ -954,139 +963,186 @@ removeImportTests = testGroup "remove import actions"
 extendImportTests :: TestTree
 extendImportTests = testGroup "extend import actions"
   [ testSession "extend single line import with value" $ template
-      (T.unlines
+      [("ModuleA.hs", T.unlines
             [ "module ModuleA where"
             , "stuffA :: Double"
             , "stuffA = 0.00750"
             , "stuffB :: Integer"
             , "stuffB = 123"
-            ])
-      (T.unlines
+            ])]
+      ("ModuleB.hs", T.unlines
             [ "module ModuleB where"
             , "import ModuleA as A (stuffB)"
             , "main = print (stuffA, stuffB)"
             ])
       (Range (Position 3 17) (Position 3 18))
-      "Add stuffA to the import list of ModuleA"
+      ["Add stuffA to the import list of ModuleA"]
       (T.unlines
             [ "module ModuleB where"
             , "import ModuleA as A (stuffA, stuffB)"
             , "main = print (stuffA, stuffB)"
             ])
   , testSession "extend single line import with operator" $ template
-      (T.unlines
+      [("ModuleA.hs", T.unlines
             [ "module ModuleA where"
             , "(.*) :: Integer -> Integer -> Integer"
             , "x .* y = x * y"
             , "stuffB :: Integer"
             , "stuffB = 123"
-            ])
-      (T.unlines
+            ])]
+      ("ModuleB.hs", T.unlines
             [ "module ModuleB where"
             , "import ModuleA as A (stuffB)"
             , "main = print (stuffB .* stuffB)"
             ])
       (Range (Position 3 17) (Position 3 18))
-      "Add .* to the import list of ModuleA"
+      ["Add .* to the import list of ModuleA"]
       (T.unlines
             [ "module ModuleB where"
             , "import ModuleA as A ((.*), stuffB)"
             , "main = print (stuffB .* stuffB)"
             ])
   , testSession "extend single line import with type" $ template
-      (T.unlines
+      [("ModuleA.hs", T.unlines
             [ "module ModuleA where"
             , "type A = Double"
-            ])
-      (T.unlines
+            ])]
+      ("ModuleB.hs", T.unlines
             [ "module ModuleB where"
             , "import ModuleA ()"
             , "b :: A"
             , "b = 0"
             ])
       (Range (Position 2 5) (Position 2 5))
-      "Add A to the import list of ModuleA"
+      ["Add A to the import list of ModuleA"]
       (T.unlines
             [ "module ModuleB where"
             , "import ModuleA (A)"
             , "b :: A"
             , "b = 0"
             ])
   ,  (`xfail` "known broken") $ testSession "extend single line import with constructor" $ template
-      (T.unlines
+      [("ModuleA.hs", T.unlines
             [ "module ModuleA where"
             , "data A = Constructor"
-            ])
-      (T.unlines
+            ])]
+      ("ModuleB.hs", T.unlines
             [ "module ModuleB where"
             , "import ModuleA (A)"
             , "b :: A"
             , "b = Constructor"
             ])
       (Range (Position 2 5) (Position 2 5))
-      "Add Constructor to the import list of ModuleA"
+      ["Add Constructor to the import list of ModuleA"]
       (T.unlines
             [ "module ModuleB where"
             , "import ModuleA (A(Constructor))"
             , "b :: A"
             , "b = Constructor"
             ])
   , testSession "extend single line qualified import with value" $ template
-      (T.unlines
+      [("ModuleA.hs", T.unlines
             [ "module ModuleA where"
             , "stuffA :: Double"
             , "stuffA = 0.00750"
             , "stuffB :: Integer"
             , "stuffB = 123"
-            ])
-      (T.unlines
+            ])]
+      ("ModuleB.hs", T.unlines
             [ "module ModuleB where"
             , "import qualified ModuleA as A (stuffB)"
             , "main = print (A.stuffA, A.stuffB)"
             ])
       (Range (Position 3 17) (Position 3 18))
-      "Add stuffA to the import list of ModuleA"
+      ["Add stuffA to the import list of ModuleA"]
       (T.unlines
             [ "module ModuleB where"
             , "import qualified ModuleA as A (stuffA, stuffB)"
             , "main = print (A.stuffA, A.stuffB)"
             ])
   , testSession "extend multi line import with value" $ template
-      (T.unlines
+      [("ModuleA.hs", T.unlines
             [ "module ModuleA where"
             , "stuffA :: Double"
             , "stuffA = 0.00750"
             , "stuffB :: Integer"
             , "stuffB = 123"
-            ])
-      (T.unlines
+            ])]
+      ("ModuleB.hs", T.unlines
             [ "module ModuleB where"
             , "import ModuleA (stuffB"
             , "               )"
             , "main = print (stuffA, stuffB)"
             ])
       (Range (Position 3 17) (Position 3 18))
-      "Add stuffA to the import list of ModuleA"
+      ["Add stuffA to the import list of ModuleA"]
       (T.unlines
             [ "module ModuleB where"
             , "import ModuleA (stuffA, stuffB"
             , "               )"
             , "main = print (stuffA, stuffB)"
             ])
+  , 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
+            [  "module ModuleA (bar) where"
+             , "bar = 10"
+               ]),
+      ("ModuleB.hs", T.unlines
+            --  this is just a dummy module to help the arguments needed for this test
+            [  "module ModuleB (bar) where"
+             , "bar = 10"
+               ])]
+      ("ModuleC.hs", T.unlines
+            [ "module ModuleC where"
+            , "import ModuleB ()"
+            , "import ModuleA ()"
+            , "foo = bar"
+            ])
+      (Range (Position 3 17) (Position 3 18))
+      ["Add bar to the import list of ModuleA",
+       "Add bar to the import list of ModuleB"]
+      (T.unlines
+            [ "module ModuleC where"
+            , "import ModuleB ()"
+            , "import ModuleA (bar)"
+            , "foo = bar"
+            ])
   ]
   where
-    template contentA contentB range expectedAction expectedContentB = do
-      _docA <- createDoc "ModuleA.hs" "haskell" contentA
-      docB <- createDoc "ModuleB.hs" "haskell" contentB
-      _ <- waitForDiagnostics
-      CACodeAction action@CodeAction { _title = actionTitle } : _
-                  <- sortOn (\(CACodeAction CodeAction{_title=x}) -> x) <$>
-                     getCodeActions docB range
-      liftIO $ expectedAction @=? actionTitle
+    template setUpModules moduleUnderTest range expectedActions expectedContentB = do
+      mapM_ (\x -> createDoc (fst x) "haskell" (snd x)) setUpModules
+      docB <- createDoc (fst moduleUnderTest) "haskell" (snd moduleUnderTest)
+      _  <- waitForDiagnostics
+      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
       executeCodeAction action
       contentAfterAction <- documentContents docB
       liftIO $ expectedContentB @=? contentAfterAction
 
+extendImportTestsRegEx :: TestTree
+extendImportTestsRegEx = testGroup "regex parsing"
+    [
+      testCase "parse invalid multiple imports" $ template "foo bar foo" Nothing
+    , testCase "parse malformed import list" $ template
+                  "\n\8226 Perhaps you want to add \8216fromList\8217 to one of these import lists:\n    \8216Data.Map\8217)"
+                  Nothing
+    , testCase "parse multiple imports" $ template
+                 "\n\8226 Perhaps you want to add \8216fromList\8217 to one of these import lists:\n    \8216Data.Map\8217 (app/testlsp.hs:7:1-18)\n    \8216Data.HashMap.Strict\8217 (app/testlsp.hs:8:1-29)"
+                 $ Just ("fromList",[("Data.Map","app/testlsp.hs:7:1-18"),("Data.HashMap.Strict","app/testlsp.hs:8:1-29")])
+    ]
+    where
+        template message expected = do
+            liftIO $ matchRegExMultipleImports message @=? expected
+
+
+
 suggestImportTests :: TestTree
 suggestImportTests = testGroup "suggest import actions"
   [ testGroup "Dont want suggestion"