Resolve for explicit-imports

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

@@ -19,7 +19,16 @@ source-repository head
     type:     git
     location: https://github.com/haskell/haskell-language-server.git
 
+flag pedantic
+  description: Enable -Werror
+  default:     False
+  manual:      True
+
+common warnings
+    ghc-options: -Wall
+
 library
+  import:           warnings
   buildable: True
   exposed-modules:    Ide.Plugin.ExplicitImports
   hs-source-dirs:     src
@@ -32,16 +41,22 @@ library
     , ghcide                == 2.1.0.0
     , hls-graph
     , hls-plugin-api        == 2.1.0.0
+    , lens
     , lsp
     , text
+    , transformers
     , unordered-containers
 
   default-language:   Haskell2010
   default-extensions:
     DataKinds
     TypeOperators
 
+  if flag(pedantic)
+    ghc-options: -Werror
+
 test-suite tests
+  import:           warnings
   buildable: True
   type:             exitcode-stdio-1.0
   default-language: Haskell2010
@@ -50,8 +65,11 @@ test-suite tests
   ghc-options:      -threaded -rtsopts -with-rtsopts=-N
   build-depends:
     , base
+    , extra
     , filepath
     , hls-explicit-imports-plugin
     , hls-test-utils
+    , lens
     , lsp-types
-    , text
+    , row-types
+    , text

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

@@ -1,33 +1,40 @@
 {-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE LambdaCase               #-}
 {-# LANGUAGE NamedFieldPuns           #-}
+{-# LANGUAGE OverloadedLabels         #-}
 {-# LANGUAGE OverloadedStrings        #-}
 {-# LANGUAGE TypeOperators            #-}
 {-# LANGUAGE ViewPatterns             #-}
-
 module Main
   ( main
   ) where
 
-import           Data.Foldable                 (find, forM_)
+import           Control.Lens                  ((^.))
+import           Data.Either.Extra
+import           Data.Foldable                 (find)
+import           Data.Row                      ((.+), (.==))
 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           System.FilePath               ((</>))
 import           Test.Hls
 
 explicitImportsPlugin :: PluginTestDescriptor ExplicitImports.Log
 explicitImportsPlugin = mkPluginTestDescriptor ExplicitImports.descriptor "explicitImports"
 
-longModule :: T.Text
-longModule = "F" <> T.replicate 80 "o"
-
 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
+    , codeActionBreakFile "BreakFile" 4 0
+    , codeActionStaleAction "StaleAction" 4 0
     , testCase "No CodeAction when exported" $
       runSessionWithServer explicitImportsPlugin testDataDir $ do
         doc <- openDoc "Exported.hs" "haskell"
@@ -65,12 +72,74 @@ 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"
+
+codeActionBreakFile :: FilePath -> Int -> Int -> TestTree
+codeActionBreakFile fp l c = goldenWithExplicitImports " code action" fp codeActionNoResolveCaps $ \doc -> do
+  _ <- waitForDiagnostics
+  changeDoc doc [edit]
   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"
+  where edit = TextDocumentContentChangeEvent $ InL $ #range .== pointRange 2 21
+                                                   .+ #rangeLength .== Nothing
+                                                   .+ #text .== "x"
+
+codeActionStaleAction :: FilePath -> Int -> Int -> TestTree
+codeActionStaleAction fp l c = goldenWithExplicitImports " code action" fp codeActionResolveCaps $ \doc -> do
+  _ <- waitForDiagnostics
+  actions <- getCodeActions doc (pointRange l c)
+  changeDoc doc [edit]
+  _ <- waitForDiagnostics
+  case find ((== Just "Make this import explicit") . caTitle) actions of
+    Just (InR x) ->
+      maybeResolveCodeAction x >>=
+        \case Just _ -> liftIO $ assertFailure "Code action still valid"
+              Nothing -> pure ()
+    _            -> liftIO $ assertFailure "Unable to find CodeAction"
+  where edit = TextDocumentContentChangeEvent $ InL $ #range .== Range (Position 6 0) (Position 6 0)
+                                                   .+ #rangeLength .== Nothing
+                                                   .+ #text .== "\ntesting = undefined"
+
+codeActionAllResolveGoldenTest :: FilePath -> Int -> Int -> TestTree
+codeActionAllResolveGoldenTest fp l c = goldenWithExplicitImports " code action resolve" fp codeActionResolveCaps $ \doc -> do
+  actions <- getCodeActions doc (pointRange l c)
+  Just (InR x) <- pure $ 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)
+  Just (InR x) <- pure $ find ((== Just "Make this import explicit") . caTitle) actions
+  resolved <- resolveCodeAction x
+  executeCodeAction resolved
+
+-- TODO: use the one from lsp-test once that's released
+resolveCodeAction :: CodeAction -> Session CodeAction
+resolveCodeAction ca = do
+  resolveResponse <- request SMethod_CodeActionResolve ca
+  Right resolved <- pure $ resolveResponse ^. L.result
+  pure resolved
+
+maybeResolveCodeAction :: CodeAction -> Session (Maybe CodeAction)
+maybeResolveCodeAction ca = do
+  resolveResponse <- request SMethod_CodeActionResolve ca
+  let resolved = resolveResponse ^. L.result
+  pure $ eitherToMaybe resolved
 
 caTitle :: (Command |? CodeAction) -> Maybe Text
 caTitle (InR CodeAction {_title}) = Just _title
@@ -79,18 +148,17 @@ 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]]
-
-getCodeLensesBy :: (CodeLens -> Bool) -> TextDocumentIdentifier -> Session [CodeLens]
-getCodeLensesBy f doc = filter f <$> getCodeLenses doc
-
-isExplicitImports :: CodeLens -> Bool
-isExplicitImports (CodeLens _ (Just (Command _ cmd _)) _)
-  | ":explicitImports:" `T.isInfixOf` cmd = True
-isExplicitImports _ = False
+codeLensGoldenTest fp _ = goldenWithExplicitImports " code lens" fp codeActionNoResolveCaps $ \doc -> do
+  (codeLens: _) <- getCodeLenses doc
+  CodeLens {_command = Just c} <- resolveCodeLens codeLens
+  executeCmd c
+
+-- TODO: use the one from lsp-test once that's released
+resolveCodeLens :: CodeLens -> Session CodeLens
+resolveCodeLens cl = do
+  resolveResponse <- request SMethod_CodeLensResolve cl
+  Right resolved <- pure $ resolveResponse ^. L.result
+  pure resolved
 
 -- Execute command and wait for result
 executeCmd :: Command -> Session ()
@@ -102,8 +170,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/BreakFile.expected.hs

@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC -Wall #-}
+module BreakFile whexe
+
+import A ( a1 )
+
+main = putStrLn $ "hello " ++ a1

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

@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC -Wall #-}
+module BreakFile where
+
+import A
+
+main = putStrLn $ "hello " ++ a1

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/StaleAction.expected.hs

@@ -0,0 +1,8 @@
+{-# OPTIONS_GHC -Wall #-}
+module StaleAction where
+
+import A
+
+main = putStrLn $ "hello " ++ a1
+
+testing = undefined

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

@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC -Wall #-}
+module StaleAction where
+
+import A
+
+main = putStrLn $ "hello " ++ a1

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,10 @@
+
 cradle:
   direct:
     arguments:
+    - OnlyThis.hs
+    - StaleAction.hs
     - UsualCase.hs
     - Exported.hs
     - A.hs
+    - B.hs

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

@@ -35,6 +35,7 @@ library
     , hls-plugin-api               == 2.1.0.0
     , lsp
     , text
+    , transformers
     , unordered-containers
 
   default-language:   Haskell2010

plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs

@@ -15,6 +15,9 @@ import           Control.Arrow                        (Arrow (second))
 import           Control.DeepSeq                      (rwhnf)
 import           Control.Monad                        (join)
 import           Control.Monad.IO.Class               (liftIO)
+import           Control.Monad.Trans.Class            (lift)
+import           Control.Monad.Trans.Maybe            (MaybeT (MaybeT),
+                                                       runMaybeT)
 import           Data.Aeson.Types                     hiding (Null)
 import           Data.IORef                           (readIORef)
 import           Data.List                            (intercalate)
@@ -184,28 +187,28 @@ instance Show RefineImportsResult where show _ = "<refineImportsResult>"
 instance NFData RefineImportsResult where rnf = rwhnf
 
 refineImportsRule :: Recorder (WithPriority Log) -> Rules ()
-refineImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \RefineImports nfp -> do
+refineImportsRule recorder = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \RefineImports nfp -> runMaybeT $ do
   -- Get the typechecking artifacts from the module
-  tmr <- use TypeCheck nfp
+  tmr <- MaybeT $ use TypeCheck nfp
   -- We also need a GHC session with all the dependencies
-  hsc <- use GhcSessionDeps nfp
+  hsc <- MaybeT $ use GhcSessionDeps nfp
 
   -- 2 layer map ModuleName -> ModuleName -> [Avails] (exports)
   import2Map <- do
     -- first layer is from current(editing) module to its imports
-    ImportMap currIm <- use_ GetImportMap nfp
+    ImportMap currIm <- lift $ use_ GetImportMap nfp
     forM currIm $ \path -> do
       -- second layer is from the imports of first layer to their imports
-      ImportMap importIm <- use_ GetImportMap path
+      ImportMap importIm <- lift $ use_ GetImportMap path
       forM importIm $ \imp_path -> do
-        imp_hir <- use_ GetModIface imp_path
+        imp_hir <- lift $ use_ GetModIface imp_path
         return $ mi_exports $ hirModIface imp_hir
 
   -- Use the GHC api to extract the "minimal" imports
   -- We shouldn't blindly refine imports
   -- instead we should generate imports statements
   -- for modules/symbols actually got used
-  (imports, mbMinImports) <- liftIO $ extractMinimalImports hsc tmr
+  (imports, mbMinImports) <- MaybeT $ liftIO $ extractMinimalImports hsc tmr
 
   let filterByImport
         :: LImportDecl GhcRn
@@ -259,7 +262,7 @@ refineImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \RefineIm
                 . Map.toList
                 $ filteredInnerImports)
         -- for every minimal imports
-        | Just minImports <- [mbMinImports]
+        | minImports <- [mbMinImports]
         , i@(L _ ImportDecl{ideclName = L _ mn}) <- minImports
         -- we check for the inner imports
         , Just innerImports <- [Map.lookup mn import2Map]
@@ -268,7 +271,7 @@ refineImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \RefineIm
         -- if no symbols from this modules then don't need to generate new import
         , not $ null filteredInnerImports
         ]
-  return ([], RefineImportsResult res <$ mbMinImports)
+  pure $ RefineImportsResult res
 
   where
     -- Check if a name is exposed by AvailInfo (the available information of a module)