hls-explicit-imports-plugin 2.0.0.1 → 2.1.0.0

raw patch · 23 files changed

+606/−252 lines, 23 filesdep +extradep +lensdep +lsp-typesdep ~ghcidedep ~hls-plugin-apiPVP ok

version bump matches the API change (PVP)

Dependencies added: extra, lens, lsp-types, mtl, row-types, transformers

Dependency ranges changed: ghcide, hls-plugin-api

API changes (from Hackage documentation)

Files

• hls-explicit-imports-plugin.cabal +23/−3
• src/Ide/Plugin/ExplicitImports.hs +344/−195
• test/Main.hs +114/−32
• test/testdata/A.hs +0/−7
• test/testdata/ExplicitA.hs +7/−0
• test/testdata/ExplicitB.hs +7/−0
• test/testdata/ExplicitBreakFile.hs +6/−0
• test/testdata/ExplicitExported.hs +6/−0
• test/testdata/ExplicitOnlyThis.hs +7/−0
• test/testdata/ExplicitStaleAction.hs +6/−0
• test/testdata/ExplicitUsualCase.hs +6/−0
• test/testdata/Exported.hs +0/−6
• test/testdata/RefineA.hs +7/−0
• test/testdata/RefineB.hs +7/−0
• test/testdata/RefineC.hs +4/−0
• test/testdata/RefineD.hs +7/−0
• test/testdata/RefineE.hs +7/−0
• test/testdata/RefineF.hs +7/−0
• test/testdata/RefineG.hs +4/−0
• test/testdata/RefineUsualCase.hs +10/−0
• test/testdata/RefineWithOverride.hs +11/−0
• test/testdata/UsualCase.hs +0/−6
• test/testdata/hie.yaml +16/−3

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               hls-explicit-imports-plugin-version:            2.0.0.1+version:            2.1.0.0 synopsis:           Explicit imports plugin for Haskell Language Server description:   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -19,7 +19,16 @@     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@@ -29,11 +38,14 @@     , containers     , deepseq     , ghc-    , ghcide                == 2.0.0.1+    , ghcide                == 2.1.0.0     , hls-graph-    , hls-plugin-api        == 2.0.0.1+    , hls-plugin-api        == 2.1.0.0+    , lens     , lsp+    , mtl     , text+    , transformers     , unordered-containers    default-language:   Haskell2010@@ -41,7 +53,11 @@     DataKinds     TypeOperators +  if flag(pedantic)+    ghc-options: -Werror+ test-suite tests+  import:           warnings   buildable: True   type:             exitcode-stdio-1.0   default-language: Haskell2010@@ -50,7 +66,11 @@   ghc-options:      -threaded -rtsopts -with-rtsopts=-N   build-depends:     , base+    , extra     , filepath     , hls-explicit-imports-plugin     , hls-test-utils+    , lens+    , lsp-types+    , row-types     , text

@@ -1,58 +1,80 @@-{-# LANGUAGE CPP                #-}-{-# LANGUAGE DeriveAnyClass     #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE LambdaCase         #-}-{-# LANGUAGE NamedFieldPuns     #-}-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE RecordWildCards    #-}-{-# LANGUAGE TypeFamilies       #-}-{-# LANGUAGE ViewPatterns       #-}-+{-# LANGUAGE CPP                       #-}+{-# LANGUAGE DeriveAnyClass            #-}+{-# LANGUAGE DeriveGeneric             #-}+{-# LANGUAGE DerivingStrategies        #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE LambdaCase                #-}+{-# LANGUAGE NamedFieldPuns            #-}+{-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE RecordWildCards           #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE ViewPatterns              #-} module Ide.Plugin.ExplicitImports   ( descriptor   , descriptorForModules-  , extractMinimalImports-  , within   , abbreviateImportTitle   , Log(..)   ) where  import           Control.DeepSeq+import           Control.Lens                         ((&), (?~))+import           Control.Monad.Error.Class            (MonadError (throwError)) import           Control.Monad.IO.Class-import           Data.Aeson                           (ToJSON (toJSON),-                                                       Value (Null))+import           Control.Monad.Trans.Class            (lift)+import           Control.Monad.Trans.Except           (ExceptT)+import           Control.Monad.Trans.Maybe+import qualified Data.Aeson                           as A (ToJSON (toJSON)) import           Data.Aeson.Types                     (FromJSON)-import qualified Data.HashMap.Strict                  as HashMap+import qualified Data.IntMap                          as IM (IntMap, elems,+                                                             fromList, (!?)) import           Data.IORef                           (readIORef) import qualified Data.Map.Strict                      as Map-import           Data.Maybe                           (catMaybes, fromMaybe,-                                                       isJust)+import           Data.Maybe                           (mapMaybe)+import qualified Data.Set                             as S import           Data.String                          (fromString) import qualified Data.Text                            as T+import           Data.Traversable                     (for)+import qualified Data.Unique                          as U (hashUnique,+                                                            newUnique) import           Development.IDE                      hiding (pluginHandlers,                                                        pluginRules)+import           Development.IDE.Core.PluginUtils import           Development.IDE.Core.PositionMapping import qualified Development.IDE.Core.Shake           as Shake-import           Development.IDE.GHC.Compat+import           Development.IDE.GHC.Compat           hiding ((<+>)) import           Development.IDE.Graph.Classes-import           Development.IDE.Types.Logger         as Logger (Pretty (pretty)) import           GHC.Generics                         (Generic)-import           Ide.PluginUtils                      (mkLspCommand)+import           Ide.Plugin.Error                     (PluginError (..),+                                                       getNormalizedFilePathE,+                                                       handleMaybe)+import           Ide.Plugin.RangeMap                  (filterByRange)+import qualified Ide.Plugin.RangeMap                  as RM (RangeMap, fromList)+import           Ide.Plugin.Resolve+import           Ide.PluginUtils import           Ide.Types+import qualified Language.LSP.Protocol.Lens           as L+import           Language.LSP.Protocol.Message+import           Language.LSP.Protocol.Types import           Language.LSP.Server-import           Language.LSP.Types +-- This plugin is named explicit-imports for historical reasons. Besides+-- providing code actions and lenses to make imports explicit it also provides+-- code actions and lens to refine imports.+ importCommandId :: CommandId importCommandId = "ImportLensCommand" -newtype Log+data Log   = LogShake Shake.Log-  deriving Show+  | LogWAEResponseError ResponseError+  | forall a. (Pretty a) => LogResolve a + instance Pretty Log where   pretty = \case-    LogShake log -> pretty log+    LogShake logMsg -> pretty logMsg+    LogWAEResponseError rspErr -> "RequestWorkspaceApplyEdit Failed with " <+> viaShow rspErr+    LogResolve msg -> pretty msg  -- | The "main" function of a plugin descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState@@ -66,133 +88,208 @@       -- ^ Predicate to select modules that will be annotated     -> PluginId     -> PluginDescriptor IdeState-descriptorForModules recorder pred plId =-  (defaultPluginDescriptor plId)+descriptorForModules recorder modFilter plId =+  let resolveRecorder = cmapWithPrio LogResolve recorder+      codeActionHandlers = mkCodeActionHandlerWithResolve resolveRecorder (codeActionProvider recorder) (codeActionResolveProvider recorder)+  in (defaultPluginDescriptor plId)     {       -- This plugin provides a command handler-      pluginCommands = [importLensCommand],+      pluginCommands = [PluginCommand importCommandId "Explicit import command" (runImportCommand recorder)],       -- This plugin defines a new rule-      pluginRules = minimalImportsRule recorder,-      pluginHandlers = mconcat-        [ -- This plugin provides code lenses-          mkPluginHandler STextDocumentCodeLens $ lensProvider pred+      pluginRules = minimalImportsRule recorder modFilter,+      pluginHandlers =+         -- This plugin provides code lenses+           mkPluginHandler SMethod_TextDocumentCodeLens (lensProvider recorder)+        <> mkResolveHandler SMethod_CodeLensResolve (lensResolveProvider recorder)           -- This plugin provides code actions-        , mkPluginHandler STextDocumentCodeAction $ codeActionProvider pred-        ]-    }---- | The command descriptor-importLensCommand :: PluginCommand IdeState-importLensCommand =-  PluginCommand importCommandId "Explicit import command" runImportCommand+        <> codeActionHandlers --- | The type of the parameters accepted by our command-newtype ImportCommandParams = ImportCommandParams WorkspaceEdit-  deriving (Generic)-  deriving anyclass (FromJSON, ToJSON)+    }  -- | The actual command handler-runImportCommand :: CommandFunction IdeState ImportCommandParams-runImportCommand _state (ImportCommandParams edit) = do-  -- This command simply triggers a workspace edit!-  _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ())-  return (Right Null)+runImportCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState IAResolveData+runImportCommand recorder ideState eird@(ResolveOne _ _) = do+  wedit <- resolveWTextEdit ideState eird+  _ <- lift $ sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) logErrors+  return $ InR  Null+  where logErrors (Left re@(ResponseError{})) = do+          logWith recorder Error (LogWAEResponseError re)+          pure ()+        logErrors (Right _) = pure ()+runImportCommand _ _ rd = do+  throwError $ PluginInvalidParams (T.pack $ "Unexpected argument for command handler:" <> show rd) --- | For every implicit import statement, return a code lens of the corresponding explicit import--- Example - for the module below:---++-- | We provide two code lenses for imports. The first lens makes imports+-- explicit. For example, for the module below: -- > import Data.List--- > -- > f = intercalate " " . sortBy length--- -- the provider should produce one code lens associated to the import statement:--- -- > import Data.List (intercalate, sortBy)-lensProvider :: (ModuleName -> Bool) -> PluginMethodHandler IdeState TextDocumentCodeLens-lensProvider-  pred-  state -- ghcide state, used to retrieve typechecking artifacts-  pId -- plugin Id-  CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}}-    -- VSCode uses URIs instead of file paths-    -- haskell-lsp provides conversion functions-    | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri = liftIO $-      do-        mbMinImports <- runAction "MinimalImports" state $ useWithStale MinimalImports nfp-        case mbMinImports of-          -- Implement the provider logic:-          -- for every import, if it's lacking a explicit list, generate a code lens-          Just (MinimalImportsResult minImports, posMapping) -> do-            commands <--              sequence-                [ generateLens pId _uri edit-                  | (imp, Just minImport) <- minImports,-                    Just edit <- [mkExplicitEdit pred posMapping imp minImport]-                ]-            return $ Right (List $ catMaybes commands)-          _ ->-            return $ Right (List [])-    | otherwise =-      return $ Right (List [])+--+-- The second one allows us to import functions directly from the original+-- module. For example, for the following import+-- > import Random.ReExporting.Module (liftIO)+-- the provider should produce one code lens associated to the import statement:+-- > Refine imports to import Control.Monad.IO.Class (liftIO)+lensProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens+lensProvider _  state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}} = do+    nfp <- getNormalizedFilePathE _uri+    (ImportActionsResult{forLens}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp+    let lens = [ generateLens _uri newRange int+                | (range, int) <- forLens+                , Just newRange <- [toCurrentRange pm range]]+    pure $ InL lens+  where -- because these are non resolved lenses we only need the range and a+        -- unique id to later resolve them with. These are for both refine+        -- import lenses and for explicit import lenses.+        generateLens :: Uri  -> Range -> Int -> CodeLens+        generateLens uri range int =+          CodeLens { _data_ = Just $ A.toJSON $ ResolveOne uri int+                   , _range = range+                   , _command = Nothing } --- | If there are any implicit imports, provide one code action to turn them all---   into explicit imports.-codeActionProvider :: (ModuleName -> Bool) -> PluginMethodHandler IdeState TextDocumentCodeAction-codeActionProvider pred ideState _pId (CodeActionParams _ _ docId range _context)-  | TextDocumentIdentifier {_uri} <- docId,-    Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri = liftIO $-    do-      pm <- runIde ideState $ use GetParsedModule nfp-      let insideImport = case pm of-            Just ParsedModule {pm_parsed_source}-              | locImports <- hsmodImports (unLoc pm_parsed_source),-                rangesImports <- map getLoc locImports ->-                any (within range) rangesImports-            _ -> False-      if not insideImport-        then return (Right (List []))-        else do-          minImports <- runAction "MinimalImports" ideState $ use MinimalImports nfp-          let edits =-                [ e-                  | (imp, Just explicit) <--                      maybe [] getMinimalImportsResult minImports,-                    Just e <- [mkExplicitEdit pred zeroMapping imp explicit]-                ]-              caExplicitImports = InR CodeAction {..}-              _title = "Make all imports explicit"-              _kind = Just CodeActionQuickFix-              _command = Nothing-              _edit = Just WorkspaceEdit {_changes, _documentChanges, _changeAnnotations}-              _changes = Just $ HashMap.singleton _uri $ List edits-              _documentChanges = Nothing-              _diagnostics = Nothing-              _isPreferred = Nothing-              _disabled = Nothing-              _xdata = Nothing-              _changeAnnotations = Nothing-          return $ Right $ List [caExplicitImports | not (null edits)]-  | otherwise =-    return $ Right $ List []+lensResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState IAResolveData 'Method_CodeLensResolve+lensResolveProvider _ ideState plId cl uri rd@(ResolveOne _ uid) = do+    nfp <- getNormalizedFilePathE uri+    (ImportActionsResult{forResolve}, _) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp+    target <- handleMaybe PluginStaleResolve $ forResolve IM.!? uid+    let updatedCodeLens = cl & L.command ?~  mkCommand plId target+    pure updatedCodeLens+  where mkCommand ::  PluginId -> ImportEdit -> Command+        mkCommand pId (ImportEdit{ieResType, ieText}) =+          let -- The only new thing we need to provide to resolve a lens is the+              -- title, as the unique Id is the same to resolve the lens title+              -- as it is to apply the lens through a command.+              -- The title is written differently depending on what type of lens+              -- it is.+              title ExplicitImport = abbreviateImportTitle ieText+              title RefineImport = "Refine imports to " <> T.intercalate ", " (T.lines ieText)+          in mkLspCommand pId importCommandId (title ieResType) (Just [A.toJSON rd])+lensResolveProvider _ _ _ _ _ rd = do+   throwError $ PluginInvalidParams (T.pack $ "Unexpected argument for lens resolve handler: " <> show rd) +-- |For explicit imports: If there are any implicit imports, provide both one+-- code action per import to make that specific import explicit, and one code+-- action to turn them all into explicit imports. For refine imports: If there+-- are any reexported imports, provide both one code action per import to refine+-- that specific import, and one code action to refine all imports.+codeActionProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction+codeActionProvider _ ideState _pId (CodeActionParams _ _ TextDocumentIdentifier {_uri} range _context) = do+    nfp <- getNormalizedFilePathE _uri+    (ImportActionsResult{forCodeActions}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp+    newRange <- toCurrentRangeE pm range+    let relevantCodeActions = filterByRange newRange forCodeActions+        allExplicit =+          [InR $ mkCodeAction "Make all imports explicit" (Just $ A.toJSON $ ExplicitAll _uri)+          -- We should only provide this code action if there are any code+          -- of this type+          | any (\x -> iaResType x == ExplicitImport) relevantCodeActions]+        allRefine =+          [InR $ mkCodeAction "Refine all imports" (Just $ A.toJSON $ RefineAll _uri)+          -- We should only provide this code action if there are any code+          -- of this type+          | any (\x -> iaResType x == RefineImport) relevantCodeActions]+        -- The only thing different in making the two types of code actions, is+        -- the title. The actual resolve data type, ResolveOne is used by both+        -- of them+        toCodeAction uri (ImportAction _ int ExplicitImport) =+          mkCodeAction "Make this import explicit" (Just $ A.toJSON $ ResolveOne uri int)+        toCodeAction uri (ImportAction _  int RefineImport) =+          mkCodeAction "Refine this import" (Just $ A.toJSON $ ResolveOne uri int)+    pure $ InL ((InR . toCodeAction _uri <$> relevantCodeActions) <> allExplicit <> allRefine)+    where mkCodeAction title data_  =+            CodeAction+            { _title = title+            , _kind = Just CodeActionKind_QuickFix+            , _command = Nothing+            , _edit = Nothing+            , _diagnostics = Nothing+            , _isPreferred = Nothing+            , _disabled = Nothing+            , _data_ = data_}++codeActionResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState IAResolveData 'Method_CodeActionResolve+codeActionResolveProvider _ ideState _ ca _ rd = do+    wedit <- resolveWTextEdit ideState rd+    pure $ ca & L.edit ?~ wedit -------------------------------------------------------------------------------- -data MinimalImports = MinimalImports+resolveWTextEdit :: IdeState -> IAResolveData -> ExceptT PluginError (LspT Config IO) WorkspaceEdit+-- Providing the edit for the command, or the resolve for the code action is+-- completely generic, as all we need is the unique id and the text edit.+resolveWTextEdit ideState (ResolveOne uri int) = do+  nfp <- getNormalizedFilePathE uri+  (ImportActionsResult{forResolve}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp+  iEdit <- handleMaybe PluginStaleResolve $ forResolve IM.!? int+  pure $ mkWorkspaceEdit uri [iEdit] pm+resolveWTextEdit ideState (ExplicitAll uri) = do+  nfp <- getNormalizedFilePathE uri+  (ImportActionsResult{forResolve}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp+  let edits = [ ie | ie@ImportEdit{ieResType = ExplicitImport} <- IM.elems forResolve]+  pure $ mkWorkspaceEdit uri edits pm+resolveWTextEdit ideState (RefineAll uri) = do+  nfp <- getNormalizedFilePathE uri+  (ImportActionsResult{forResolve}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp+  let edits = [ re | re@ImportEdit{ieResType = RefineImport} <- IM.elems forResolve]+  pure $ mkWorkspaceEdit uri edits pm+mkWorkspaceEdit :: Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit+mkWorkspaceEdit uri edits pm =+      WorkspaceEdit {_changes = Just $ Map.fromList [(uri, mapMaybe toWEdit edits)]+                    , _documentChanges = Nothing+                    , _changeAnnotations = Nothing}+  where toWEdit ImportEdit{ieRange, ieText} =+          let newRange = toCurrentRange pm ieRange+          in (\r -> TextEdit r ieText) <$> newRange++data ImportActions = ImportActions   deriving (Show, Generic, Eq, Ord) -instance Hashable MinimalImports+instance Hashable ImportActions -instance NFData MinimalImports+instance NFData ImportActions -type instance RuleResult MinimalImports = MinimalImportsResult+type instance RuleResult ImportActions = ImportActionsResult -newtype MinimalImportsResult = MinimalImportsResult-  {getMinimalImportsResult :: [(LImportDecl GhcRn, Maybe T.Text)]}+data ResultType = ExplicitImport | RefineImport+  deriving Eq -instance Show MinimalImportsResult where show _ = "<minimalImportsResult>"+data ImportActionsResult = ImportActionsResult+  { -- |For providing the code lenses we need to have a range, and a unique id+    -- that is later resolved to the new text for each import. It is stored in+    -- a list, because we always need to provide all the code lens in a file.+    forLens        :: [(Range, Int)]+    -- |For the code actions we have the same data as for the code lenses, but+    -- we store it in a RangeMap, because that allows us to filter on a specific+    -- range with better performance, and code actions are almost always only+    -- requested for a specific range+  , forCodeActions :: RM.RangeMap ImportAction+    -- |For resolve we have an intMap where for every previously provided unique id+    -- we provide a textEdit to allow our code actions or code lens to be resolved+  , forResolve     :: IM.IntMap ImportEdit } -instance NFData MinimalImportsResult where rnf = rwhnf+-- |For resolving code lenses and code actions we need standard text edit stuff,+-- such as range and text, and then we need the result type, because we use this+-- for code lenses which need to create a appropriate title+data ImportEdit = ImportEdit { ieRange :: Range, ieText :: T.Text, ieResType :: ResultType} +-- |The necessary data for providing code actions: the range, a unique ID for+-- later resolving the action, and the type of action for giving a proper name.+data ImportAction = ImportAction { iaRange :: Range, iaUniqueId :: Int, iaResType :: ResultType}++instance Show ImportActionsResult where show _ = "<ImportActionsResult>"++instance NFData ImportActionsResult where rnf = rwhnf++data IAResolveData = ResolveOne+                      { uri      :: Uri+                      , importId :: Int }+                    | ExplicitAll+                      { uri :: Uri }+                    | RefineAll+                      { uri :: Uri }+                    deriving (Generic, Show, A.ToJSON, FromJSON)+ exportedModuleStrings :: ParsedModule -> [String] exportedModuleStrings ParsedModule{pm_parsed_source = L _ HsModule{..}}   | Just export <- hsmodExports,@@ -200,62 +297,99 @@     = map (T.unpack . printOutputable) exports exportedModuleStrings _ = [] -minimalImportsRule :: Recorder (WithPriority Log) -> Rules ()-minimalImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \MinimalImports nfp -> do+minimalImportsRule :: Recorder (WithPriority Log) -> (ModuleName -> Bool) -> Rules ()+minimalImportsRule recorder modFilter = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \ImportActions 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++  -- refine imports: 2 layer map ModuleName -> ModuleName -> [Avails] (exports)+  import2Map <- do+    -- first layer is from current(editing) module to its imports+    ImportMap currIm <- MaybeT $ use GetImportMap nfp+    for currIm $ \path -> do+      -- second layer is from the imports of first layer to their imports+      ImportMap importIm <- MaybeT $ use GetImportMap path+      for importIm $ \imp_path -> do+        imp_hir <- MaybeT $ use GetModIface imp_path+        return $ mi_exports $ hirModIface imp_hir+   -- Use the GHC api to extract the "minimal" imports-  (imports, mbMinImports) <- liftIO $ extractMinimalImports hsc tmr+  (imports, mbMinImports) <- MaybeT $ liftIO $ extractMinimalImports hsc tmr+   let importsMap =         Map.fromList           [ (realSrcSpanStart l, printOutputable i)-            | L (locA -> RealSrcSpan l _) i <- fromMaybe [] mbMinImports-            , not (isImplicitPrelude i)+            | L (locA -> RealSrcSpan l _) i <- mbMinImports           ]-      res =-        [ (i, Map.lookup (realSrcSpanStart l) importsMap)-          | i <- imports-          , RealSrcSpan l _ <- [getLoc i]+      minimalImportsResult =+        [ (range, (minImport, ExplicitImport))+          | imp@(L _ impDecl) <- imports+          , not (isQualifiedImport impDecl)+          , not (isExplicitImport impDecl)+          , let L _ moduleName = ideclName impDecl+          , modFilter moduleName+          , RealSrcSpan location _ <- [getLoc imp]+          , let range = realSrcSpanToRange location+          , Just minImport <- [Map.lookup (realSrcSpanStart location) importsMap]         ]-  return ([], MinimalImportsResult res <$ mbMinImports)-  where-    isImplicitPrelude :: (Outputable a) => a -> Bool-    isImplicitPrelude importDecl =-      T.isPrefixOf implicitPreludeImportPrefix (printOutputable importDecl)---- | This is the prefix of an implicit prelude import which should be ignored,--- when considering the minimal imports rule-implicitPreludeImportPrefix :: T.Text-implicitPreludeImportPrefix = "import (implicit) Prelude"+      refineImportsResult =+        [ (range, (T.intercalate "\n"+                . map (printOutputable . constructImport i)+                . Map.toList+                $ filteredInnerImports, RefineImport))+        -- for every minimal imports+        | minImports <- [mbMinImports]+        , i@(L _ ImportDecl{ideclName = L _ mn}) <- minImports+        -- (almost) no one wants to see an refine import list for Prelude+        , mn /= moduleName pRELUDE+        -- we check for the inner imports+        , Just innerImports <- [Map.lookup mn import2Map]+        -- and only get those symbols used+        , Just filteredInnerImports <- [filterByImport i innerImports]+        -- if no symbols from this modules then don't need to generate new import+        , not $ null filteredInnerImports+        -- get the location+        , RealSrcSpan location _ <- [getLoc i]+        -- and then convert that to a Range+        , let range = realSrcSpanToRange location+        ]+  uniqueAndRangeAndText <- liftIO $ for (minimalImportsResult ++ refineImportsResult) $ \rt -> do+                                u <- U.hashUnique <$> U.newUnique+                                pure (u,  rt)+  let rangeAndUnique =  [ ImportAction r u rt | (u, (r, (_, rt))) <- uniqueAndRangeAndText ]+  pure ImportActionsResult+                      { forLens = (\ImportAction{..} -> (iaRange, iaUniqueId)) <$> rangeAndUnique+                      , forCodeActions = RM.fromList iaRange rangeAndUnique+                      , forResolve =  IM.fromList ((\(u, (r, (te, ty))) -> (u, ImportEdit r te ty)) <$> uniqueAndRangeAndText) }  --------------------------------------------------------------------------------  -- | Use the ghc api to extract a minimal, explicit set of imports for this module extractMinimalImports ::-  Maybe HscEnvEq ->-  Maybe TcModuleResult ->-  IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])-extractMinimalImports (Just hsc) (Just TcModuleResult {..}) = do+  HscEnvEq ->+  TcModuleResult ->+  IO (Maybe ([LImportDecl GhcRn], [LImportDecl GhcRn]))+extractMinimalImports hsc TcModuleResult {..} = runMaybeT $ do   -- extract the original imports and the typechecking environment   let tcEnv = tmrTypechecked       (_, imports, _, _) = tmrRenamed       ParsedModule {pm_parsed_source = L loc _} = tmrParsed       emss = exportedModuleStrings tmrParsed-      span = fromMaybe (error "expected real") $ realSpan loc+  Just srcSpan <- pure $ realSpan loc   -- Don't make suggestions for modules which are also exported, the user probably doesn't want this!   -- See https://github.com/haskell/haskell-language-server/issues/2079   let notExportedImports = filter (notExported emss) imports    -- GHC is secretly full of mutable state-  gblElts <- readIORef (tcg_used_gres tcEnv)+  gblElts <- liftIO $ readIORef (tcg_used_gres tcEnv)    -- call findImportUsage does exactly what we need   -- GHC is full of treats like this   let usage = findImportUsage notExportedImports gblElts-  (_, minimalImports) <--    initTcWithGbl (hscEnv hsc) tcEnv span $ getMinimalImports usage+  (_, Just minimalImports) <- liftIO $+    initTcWithGbl (hscEnv hsc) tcEnv srcSpan $ getMinimalImports usage    -- return both the original imports and the computed minimal ones   return (imports, minimalImports)@@ -264,25 +398,17 @@       notExported []  _ = True       notExported exports (L _ ImportDecl{ideclName = L _ name}) =           not $ any (\e -> ("module " ++ moduleNameString name) == e) exports-extractMinimalImports _ _ = return ([], Nothing)+#if !MIN_VERSION_ghc (9,0,0)+      notExported _ _ = True+#endif -mkExplicitEdit :: (ModuleName -> Bool) -> PositionMapping -> LImportDecl GhcRn -> T.Text -> Maybe TextEdit-mkExplicitEdit pred posMapping (L (locA -> src) imp) explicit-  -- Explicit import list case+isExplicitImport :: ImportDecl GhcRn -> Bool #if MIN_VERSION_ghc (9,5,0)-  | ImportDecl {ideclImportList = Just (Exactly, _)} <- imp =+isExplicitImport ImportDecl {ideclImportList = Just (Exactly, _)} = True #else-  | ImportDecl {ideclHiding = Just (False, _)} <- imp =+isExplicitImport ImportDecl {ideclHiding = Just (False, _)}       = True #endif-    Nothing-  | not (isQualifiedImport imp),-    RealSrcSpan l _ <- src,-    L _ mn <- ideclName imp,-    pred mn,-    Just rng <- toCurrentRange posMapping $ realSrcSpanToRange l =-    Just $ TextEdit rng explicit-  | otherwise =-    Nothing+isExplicitImport _                                                = False  -- This number is somewhat arbitrarily chosen. Ideally the protocol would tell us these things, -- but at the moment I don't believe we know it.@@ -291,23 +417,6 @@ maxColumns :: Int maxColumns = 120 --- | Given an import declaration, generate a code lens unless it has an--- explicit import list or it's qualified-generateLens :: PluginId -> Uri -> TextEdit -> IO (Maybe CodeLens)-generateLens pId uri importEdit@TextEdit {_range, _newText} = do-  let-      title = abbreviateImportTitle _newText-      -- the code lens has no extra data-      _xdata = Nothing-      -- an edit that replaces the whole declaration with the explicit one-      edit = WorkspaceEdit (Just editsMap) Nothing Nothing-      editsMap = HashMap.fromList [(uri, List [importEdit])]-      -- the command argument is simply the edit-      _arguments = Just [toJSON $ ImportCommandParams edit]-  -- create the command-      _command = Just $ mkLspCommand pId importCommandId title _arguments-  -- create and return the code lens-  return $ Just CodeLens {..}  -- | The title of the command is ideally the minimal explicit import decl, but -- we don't want to create a really massive code lens (and the decl can be extremely large!).@@ -331,6 +440,7 @@       numAdditionalItems = T.count "," actualSuffix + 1       -- We want to make text like this: import Foo (AImport, BImport, ... (30 items))       -- We also want it to look sensible if we end up splitting in the module name itself,+      summaryText :: Int -> T.Text       summaryText n = " ... (" <> fromString (show n) <> " items)"       -- so we only add a trailing paren if we've split in the export list       suffixText = summaryText numAdditionalItems <> if T.count "(" prefix > 0 then ")" else ""@@ -343,10 +453,49 @@  -------------------------------------------------------------------------------- --- | A helper to run ide actions-runIde :: IdeState -> Action a -> IO a-runIde = runAction "importLens" -within :: Range -> SrcSpan -> Bool-within (Range start end) span =-  isInsideSrcSpan start span || isInsideSrcSpan end span+filterByImport :: LImportDecl GhcRn -> Map.Map ModuleName [AvailInfo] -> Maybe (Map.Map ModuleName [AvailInfo])+#if MIN_VERSION_ghc(9,5,0)+filterByImport (L _ ImportDecl{ideclImportList = Just (_, L _ names)})+#else+filterByImport (L _ ImportDecl{ideclHiding = Just (_, L _ names)})+#endif+  avails =+      -- if there is a function defined in the current module and is used+      -- i.e. if a function is not reexported but defined in current+      -- module then this import cannot be refined+  if importedNames `S.isSubsetOf` allFilteredAvailsNames+    then Just res+    else Nothing+  where importedNames = S.fromList $ map (ieName . unLoc) names+        res = flip Map.filter avails $ \a ->+                any (`S.member` importedNames)+                  $ concatMap availNamesWithSelectors a+        allFilteredAvailsNames = S.fromList+          $ concatMap availNamesWithSelectors+          $ mconcat+          $ Map.elems res+filterByImport _ _ = Nothing++constructImport :: LImportDecl GhcRn -> (ModuleName, [AvailInfo]) -> LImportDecl GhcRn+#if MIN_VERSION_ghc(9,5,0)+constructImport (L lim imd@ImportDecl {ideclName = L _ _, ideclImportList = Just (hiding, L _ names)})+#else+constructImport (L lim imd@ImportDecl{ideclName = L _ _, ideclHiding = Just (hiding, L _ names)})+#endif+  (newModuleName, avails) = L lim imd+    { ideclName = noLocA newModuleName+#if MIN_VERSION_ghc(9,5,0)+    , ideclImportList = Just (hiding, noLocA newNames)+#else+    , ideclHiding = Just (hiding, noLocA newNames)+#endif+    }+    where newNames = filter (\n -> any (n `containsAvail`) avails) names+          -- Check if a name is exposed by AvailInfo (the available information of a module)+          containsAvail :: LIE GhcRn -> AvailInfo -> Bool+          containsAvail name avail =+            any (\an -> printOutputable an == (printOutputable . ieName . unLoc $ name))+              $ availNamesWithSelectors avail++constructImport lim _ = lim

@@ -1,40 +1,54 @@ {-# LANGUAGE DisambiguateRecordFields #-}+{-# LANGUAGE LambdaCase               #-} {-# LANGUAGE NamedFieldPuns           #-}+{-# LANGUAGE OverloadedLabels         #-} {-# LANGUAGE OverloadedStrings        #-} {-# LANGUAGE TypeOperators            #-} {-# LANGUAGE ViewPatterns             #-}- module Main   ( main   ) where -import           Data.Foldable              (find, forM_)-import           Data.Text                  (Text)-import qualified Data.Text                  as T-import qualified Ide.Plugin.ExplicitImports as ExplicitImports-import           System.FilePath            ((<.>), (</>))+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           Data.Traversable              (for)+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  explicitImportsPlugin :: PluginTestDescriptor ExplicitImports.Log explicitImportsPlugin = mkPluginTestDescriptor ExplicitImports.descriptor "explicitImports" -longModule :: T.Text-longModule = "F" <> T.replicate 80 "o"- main :: IO ()-main = defaultTestRunner $+main = defaultTestRunner $ testGroup "import-actions"+  [testGroup+    "Refine Imports"+    [ codeActionGoldenTest "RefineWithOverride" 3 1+    , codeLensGoldenTest isRefineImports "RefineUsualCase" 1+    ],   testGroup     "Make imports explicit"-    [ codeActionGoldenTest "UsualCase" 3 0-    , codeLensGoldenTest "UsualCase" 0+    [ codeActionAllGoldenTest "ExplicitUsualCase" 3 0+    , codeActionAllResolveGoldenTest "ExplicitUsualCase" 3 0+    , codeActionOnlyGoldenTest "ExplicitOnlyThis" 3 0+    , codeActionOnlyResolveGoldenTest "ExplicitOnlyThis" 3 0+    , codeLensGoldenTest notRefineImports "ExplicitUsualCase" 0+    , codeActionBreakFile "ExplicitBreakFile" 4 0+    , codeActionStaleAction "ExplicitStaleAction" 4 0     , testCase "No CodeAction when exported" $       runSessionWithServer explicitImportsPlugin testDataDir $ do-        doc <- openDoc "Exported.hs" "haskell"+        doc <- openDoc "ExplicitExported.hs" "haskell"         action <- getCodeActions doc (pointRange 3 0)         liftIO $ action @?= []     , testCase "No CodeLens when exported" $       runSessionWithServer explicitImportsPlugin testDataDir $ do-        doc <- openDoc "Exported.hs" "haskell"+        doc <- openDoc "ExplicitExported.hs" "haskell"         lenses <- getCodeLenses doc         liftIO $ lenses @?= []     , testGroup "Title abbreviation"@@ -60,49 +74,102 @@               o = "import " <> T.replicate 80 "F" <> " (Athing, Bthing, ... (3 items))"           in ExplicitImports.abbreviateImportTitle i @?= o       ]-    ]+    ]]  -- 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 = goldenWithImportActions " 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 = goldenWithImportActions " code action" fp codeActionNoResolveCaps $ \doc -> do+  _ <- getCodeLenses doc+  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 29+                                                   .+ #rangeLength .== Nothing+                                                   .+ #text .== "x"++codeActionStaleAction :: FilePath -> Int -> Int -> TestTree+codeActionStaleAction fp l c = goldenWithImportActions " 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 = goldenWithImportActions " 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 = goldenWithImportActions " 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 = goldenWithImportActions " 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++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 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+codeLensGoldenTest :: (CodeLens -> Bool) -> FilePath -> Int -> TestTree+codeLensGoldenTest predicate fp i = goldenWithImportActions " code lens" fp codeActionNoResolveCaps $ \doc -> do+  codeLenses <- getCodeLenses doc+  resolvedCodeLenses <- for codeLenses resolveCodeLens+  (CodeLens {_command = Just c}) <- pure (filter predicate resolvedCodeLenses !! i)+  executeCmd c -isExplicitImports :: CodeLens -> Bool-isExplicitImports (CodeLens _ (Just (Command _ cmd _)) _)-  | ":explicitImports:" `T.isInfixOf` cmd = True-isExplicitImports _ = False+notRefineImports :: CodeLens -> Bool+notRefineImports (CodeLens _ (Just (Command text _ _)) _)+  | "Refine imports to" `T.isPrefixOf` text = False+notRefineImports _ = True  -- Execute command and wait for result executeCmd :: Command -> Session () executeCmd cmd = do     executeCommand cmd-    _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit)+    _resp <- skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit)     -- liftIO $ print _resp     return ()  -- helpers -goldenWithExplicitImports :: FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree-goldenWithExplicitImports fp = goldenWithHaskellDoc explicitImportsPlugin (fp <> " (golden)") testDataDir fp "expected" "hs"+goldenWithImportActions :: String -> FilePath -> ClientCapabilities -> (TextDocumentIdentifier -> Session ()) -> TestTree+goldenWithImportActions title fp caps = goldenWithHaskellAndCaps caps explicitImportsPlugin (fp <> title <> " (golden)") testDataDir fp "expected" "hs"  testDataDir :: String testDataDir = "test" </> "testdata"@@ -112,3 +179,18 @@   (subtract 1 -> fromIntegral -> line)   (subtract 1 -> fromIntegral -> col) =     Range (Position line col) (Position line $ col + 1)++-------------------------------------------------------------------------------+-- code action tests++codeActionGoldenTest :: FilePath -> Int -> Int -> TestTree+codeActionGoldenTest fp l c = goldenWithImportActions "" fp codeActionNoResolveCaps $ \doc -> do+  actions <- getCodeActions doc (pointRange l c)+  case find ((== Just "Refine all imports") . caTitle) actions of+    Just (InR x) -> executeCodeAction x+    _            -> liftIO $ assertFailure "Unable to find CodeAction"++isRefineImports :: CodeLens -> Bool+isRefineImports (CodeLens _ (Just (Command txt _ _)) _)+  | "Refine imports to" `T.isInfixOf` txt = True+isRefineImports _ = False

@@ -1,7 +0,0 @@-module A where--a1 :: String-a1 = "a1"--a2 :: String-a2 = "a2"

@@ -0,0 +1,7 @@+module ExplicitA where++a1 :: String+a1 = "a1"++a2 :: String+a2 = "a2"

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

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

@@ -0,0 +1,6 @@+module ExplicitExported (module ExplicitA) where++import ExplicitA++main :: IO ()+main = putStrLn $ "hello " ++ a1

@@ -0,0 +1,7 @@+module ExplicitOnlyThis where++import ExplicitA+import ExplicitB++main :: IO ()+main = putStrLn $ "hello " ++ a1 ++ b1

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

@@ -0,0 +1,6 @@+module ExplicitUsualCase where++import ExplicitA++main :: IO ()+main = putStrLn $ "hello " ++ a1

@@ -1,6 +0,0 @@-module Exported (module A) where--import A--main :: IO ()-main = putStrLn $ "hello " ++ a1

@@ -0,0 +1,7 @@+module RefineA +  ( module RefineB+  , module RefineC+  ) where++import RefineB+import RefineC

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

@@ -0,0 +1,4 @@+module RefineC where++c1 :: String+c1 = "c1"

@@ -0,0 +1,7 @@+module RefineD (module RefineE, module RefineD) where++import RefineE hiding (e1)+import qualified RefineE++e1 :: String +e1 = RefineE.e1 <> " but overrided"

@@ -0,0 +1,7 @@+module RefineE where++e1 :: String+e1 = "e1"++e2 :: String+e2 = "e2"

@@ -0,0 +1,7 @@+module RefineF (module RefineF, module RefineG) where++import RefineG++f1 :: String +f1 = "f1"+

@@ -0,0 +1,4 @@+module RefineG where++g1 :: String +g1 = "g1"

@@ -0,0 +1,10 @@+module Main where++import RefineA+import RefineD+import Data.List (intercalate)++main :: IO ()+main = putStrLn +     $ "hello " +    <> intercalate ", " [b1, c1, e2]

@@ -0,0 +1,11 @@+module Main where++import RefineA+import RefineD+import RefineF+import Data.List (intercalate)++main :: IO ()+main = putStrLn +     $ "hello " +    <> intercalate ", " [b1, c1, e1, f1, g1]

@@ -1,6 +0,0 @@-module Main where--import A--main :: IO ()-main = putStrLn $ "hello " ++ a1

@@ -1,6 +1,19 @@+ cradle:   direct:     arguments:-    - UsualCase.hs-    - Exported.hs-    - A.hs+    - ExplicitOnlyThis.hs+    - ExplicitStaleAction.hs+    - ExplicitUsualCase.hs+    - ExplicitExported.hs+    - ExplicitA.hs+    - ExplicitB.hs+    - RefineUsualCase.hs+    - RefineWithOverride.hs+    - RefineA.hs+    - RefineB.hs+    - RefineC.hs+    - RefineD.hs+    - RefineE.hs+    - RefineF.hs+    - RefineG.hs