Resolve for explicit-imports

plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal

@@ -32,8 +32,10 @@ library
     , ghcide                == 2.1.0.0
     , hls-graph
     , hls-plugin-api        == 2.1.0.0
+    , lens
     , lsp
     , text
+    , transformers
     , unordered-containers
 
   default-language:   Haskell2010
@@ -53,5 +55,6 @@ test-suite tests
     , filepath
     , hls-explicit-imports-plugin
     , hls-test-utils
+    , lens
     , lsp-types
     , text

plugins/hls-explicit-imports-plugin/test/Main.hs

@@ -8,10 +8,12 @@ module Main
   ( main
   ) where
 
+import           Control.Lens                  ((^.))
 import           Data.Foldable                 (find, forM_)
 import           Data.Text                     (Text)
 import qualified Data.Text                     as T
 import qualified Ide.Plugin.ExplicitImports    as ExplicitImports
+import qualified Language.LSP.Protocol.Lens    as L
 import           Language.LSP.Protocol.Message
 import           System.FilePath               ((<.>), (</>))
 import           Test.Hls
@@ -26,7 +28,10 @@ main :: IO ()
 main = defaultTestRunner $
   testGroup
     "Make imports explicit"
-    [ codeActionGoldenTest "UsualCase" 3 0
+    [ codeActionAllGoldenTest "UsualCase" 3 0
+    , codeActionAllResolveGoldenTest "UsualCase" 3 0
+    , codeActionOnlyGoldenTest "OnlyThis" 3 0
+    , codeActionOnlyResolveGoldenTest "OnlyThis" 3 0
     , codeLensGoldenTest "UsualCase" 0
     , testCase "No CodeAction when exported" $
       runSessionWithServer explicitImportsPlugin testDataDir $ do
@@ -65,24 +70,57 @@ main = defaultTestRunner $
 
 -- code action tests
 
-codeActionGoldenTest :: FilePath -> Int -> Int -> TestTree
-codeActionGoldenTest fp l c = goldenWithExplicitImports fp $ \doc -> do
+codeActionAllGoldenTest :: FilePath -> Int -> Int -> TestTree
+codeActionAllGoldenTest fp l c = goldenWithExplicitImports " code action" fp codeActionNoResolveCaps $ \doc -> do
   actions <- getCodeActions doc (pointRange l c)
   case find ((== Just "Make all imports explicit") . caTitle) actions of
     Just (InR x) -> executeCodeAction x
     _            -> liftIO $ assertFailure "Unable to find CodeAction"
 
+codeActionAllResolveGoldenTest :: FilePath -> Int -> Int -> TestTree
+codeActionAllResolveGoldenTest fp l c = goldenWithExplicitImports " code action resolve" fp codeActionResolveCaps $ \doc -> do
+  actions <- getCodeActions doc (pointRange l c)
+  let Just (InR x) = find ((== Just "Make all imports explicit") . caTitle) actions
+  resolved <- resolveCodeAction x
+  executeCodeAction resolved
+
+codeActionOnlyGoldenTest :: FilePath -> Int -> Int -> TestTree
+codeActionOnlyGoldenTest fp l c = goldenWithExplicitImports " code action" fp codeActionNoResolveCaps $ \doc -> do
+  actions <- getCodeActions doc (pointRange l c)
+  case find ((== Just "Make this import explicit") . caTitle) actions of
+    Just (InR x) -> executeCodeAction x
+    _            -> liftIO $ assertFailure "Unable to find CodeAction"
+
+codeActionOnlyResolveGoldenTest :: FilePath -> Int -> Int -> TestTree
+codeActionOnlyResolveGoldenTest fp l c = goldenWithExplicitImports " code action resolve" fp codeActionResolveCaps $ \doc -> do
+  actions <- getCodeActions doc (pointRange l c)
+  let Just (InR x) = find ((== Just "Make this import explicit") . caTitle) actions
+  resolved <- resolveCodeAction x
+  executeCodeAction resolved
+
+resolveCodeAction :: CodeAction -> Session CodeAction
+resolveCodeAction ca = do
+  resolveResponse <- request SMethod_CodeActionResolve ca
+  let Right resolved = resolveResponse ^. L.result
+  pure resolved
+
 caTitle :: (Command |? CodeAction) -> Maybe Text
 caTitle (InR CodeAction {_title}) = Just _title
 caTitle _                         = Nothing
 
 -- code lens tests
 
 codeLensGoldenTest :: FilePath -> Int -> TestTree
-codeLensGoldenTest fp codeLensIdx = goldenWithExplicitImports fp $ \doc -> do
-  codeLens <- (!! codeLensIdx) <$> getCodeLensesBy isExplicitImports doc
-  mapM_ executeCmd
-    [c | CodeLens{_command = Just c} <- [codeLens]]
+codeLensGoldenTest fp codeLensIdx = goldenWithExplicitImports " code lens" fp codeActionNoResolveCaps $ \doc -> do
+  (codeLens: _) <- getCodeLenses doc
+  CodeLens {_command = Just c} <- resolveCodeLens codeLens
+  executeCmd c
+
+resolveCodeLens :: CodeLens -> Session CodeLens
+resolveCodeLens cl = do
+  resolveResponse <- request SMethod_CodeLensResolve cl
+  let Right resolved = resolveResponse ^. L.result
+  pure resolved
 
 getCodeLensesBy :: (CodeLens -> Bool) -> TextDocumentIdentifier -> Session [CodeLens]
 getCodeLensesBy f doc = filter f <$> getCodeLenses doc
@@ -102,8 +140,8 @@ executeCmd cmd = do
 
 -- helpers
 
-goldenWithExplicitImports :: FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
-goldenWithExplicitImports fp = goldenWithHaskellDoc explicitImportsPlugin (fp <> " (golden)") testDataDir fp "expected" "hs"
+goldenWithExplicitImports :: String -> FilePath -> ClientCapabilities -> (TextDocumentIdentifier -> Session ()) -> TestTree
+goldenWithExplicitImports title fp caps = goldenWithHaskellAndCaps caps explicitImportsPlugin (fp <> title <> " (golden)") testDataDir fp "expected" "hs"
 
 testDataDir :: String
 testDataDir = "test" </> "testdata"

plugins/hls-explicit-imports-plugin/test/testdata/B.hs

@@ -0,0 +1,7 @@
+module B where
+
+b1 :: String
+b1 = "b1"
+
+b2 :: String
+b2 = "b2"

plugins/hls-explicit-imports-plugin/test/testdata/OnlyThis.expected.hs

@@ -0,0 +1,7 @@
+module OnlyThis where
+
+import A ( a1 )
+import B
+
+main :: IO ()
+main = putStrLn $ "hello " ++ a1 ++ b1

plugins/hls-explicit-imports-plugin/test/testdata/OnlyThis.hs

@@ -0,0 +1,7 @@
+module OnlyThis where
+
+import A
+import B
+
+main :: IO ()
+main = putStrLn $ "hello " ++ a1 ++ b1

plugins/hls-explicit-imports-plugin/test/testdata/UsualCase.expected.hs

@@ -1,4 +1,4 @@
-module Main where
+module UsualCase where
 
 import A ( a1 )
 

plugins/hls-explicit-imports-plugin/test/testdata/UsualCase.hs

@@ -1,4 +1,4 @@
-module Main where
+module UsualCase where
 
 import A
 

plugins/hls-explicit-imports-plugin/test/testdata/hie.yaml

@@ -1,6 +1,9 @@
+
 cradle:
   direct:
     arguments:
+    - OnlyThis.hs
     - UsualCase.hs
     - Exported.hs
     - A.hs
+    - B.hs