mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-09-17 11:47:09 +03:00
Implement refine imports (#1686)
* Implement refine imports * Implement code action for refine imports * fix stack.yaml * fix stack-*.yaml * fix missing records fields after merge master * fix nix * reduce duplicated functions * [Plugin][RefineImports] add tests and fix overriding issue * add hls-refine-imports-plugin to CI workflow Co-authored-by: Junyoung/Clare Jang <jjc9310@gmail.com>
This commit is contained in:
Ray Shih
GitHub
parent
6bd6cf018f
commit
54737e9e2d
4
.github/workflows/test.yml
vendored
4
.github/workflows/test.yml
vendored
@ -173,3 +173,7 @@ jobs:
|
||||
- if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }}
|
||||
name: Test hls-tactics-plugin test suite
|
||||
run: cabal test hls-tactics-plugin --test-options="-j1 --rerun-update" || cabal test hls-tactics-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-tactics-plugin --test-options="-j1 --rerun"
|
||||
|
||||
- if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }}
|
||||
name: Test hls-refine-imports-plugin test suite
|
||||
run: cabal test hls-refine-imports-plugin --test-options="-j1 --rerun-update" || cabal test hls-refine-imports-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refine-imports-plugin --test-options="-j1 --rerun"
|
||||
|
||||
@ -12,6 +12,7 @@ packages:
|
||||
./plugins/hls-class-plugin
|
||||
./plugins/hls-eval-plugin
|
||||
./plugins/hls-explicit-imports-plugin
|
||||
./plugins/hls-refine-imports-plugin
|
||||
./plugins/hls-hlint-plugin
|
||||
./plugins/hls-retrie-plugin
|
||||
./plugins/hls-haddock-comments-plugin
|
||||
|
||||
@ -29,6 +29,10 @@ import Ide.Plugin.Eval as Eval
|
||||
import Ide.Plugin.ExplicitImports as ExplicitImports
|
||||
#endif
|
||||
|
||||
#if refineImports
|
||||
import Ide.Plugin.RefineImports as RefineImports
|
||||
#endif
|
||||
|
||||
#if retrie
|
||||
import Ide.Plugin.Retrie as Retrie
|
||||
#endif
|
||||
@ -125,6 +129,9 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
|
||||
#if importLens
|
||||
ExplicitImports.descriptor "importLens" :
|
||||
#endif
|
||||
#if refineImports
|
||||
RefineImports.descriptor "refineImports" :
|
||||
#endif
|
||||
#if moduleName
|
||||
ModuleName.descriptor "moduleName" :
|
||||
#endif
|
||||
|
||||
@ -123,6 +123,11 @@ flag importLens
|
||||
default: True
|
||||
manual: True
|
||||
|
||||
flag refineImports
|
||||
description: Enable refineImports plugin
|
||||
default: True
|
||||
manual: True
|
||||
|
||||
flag retrie
|
||||
description: Enable retrie plugin
|
||||
default: True
|
||||
@ -205,6 +210,11 @@ common importLens
|
||||
build-depends: hls-explicit-imports-plugin ^>= 1.0.0.1
|
||||
cpp-options: -DimportLens
|
||||
|
||||
common refineImports
|
||||
if flag(refineImports) || flag(all-plugins)
|
||||
build-depends: hls-refine-imports-plugin
|
||||
cpp-options: -DrefineImports
|
||||
|
||||
common retrie
|
||||
if flag(retrie) || flag(all-plugins)
|
||||
build-depends: hls-retrie-plugin ^>= 1.0.0.1
|
||||
@ -279,6 +289,7 @@ executable haskell-language-server
|
||||
, haddockComments
|
||||
, eval
|
||||
, importLens
|
||||
, refineImports
|
||||
, retrie
|
||||
, tactic
|
||||
, hlint
|
||||
|
||||
@ -36,6 +36,7 @@ let
|
||||
hls-haddock-comments-plugin = gitignoreSource ../plugins/hls-haddock-comments-plugin;
|
||||
hls-eval-plugin = gitignoreSource ../plugins/hls-eval-plugin;
|
||||
hls-explicit-imports-plugin = gitignoreSource ../plugins/hls-explicit-imports-plugin;
|
||||
hls-refine-imports-plugin = gitignoreSource ../plugins/hls-refine-imports-plugin;
|
||||
hls-hlint-plugin = gitignoreSource ../plugins/hls-hlint-plugin;
|
||||
hls-retrie-plugin = gitignoreSource ../plugins/hls-retrie-plugin;
|
||||
hls-splice-plugin = gitignoreSource ../plugins/hls-splice-plugin;
|
||||
|
||||
@ -11,7 +11,11 @@
|
||||
|
||||
#include "ghc-api-version.h"
|
||||
|
||||
module Ide.Plugin.ExplicitImports (descriptor) where
|
||||
module Ide.Plugin.ExplicitImports
|
||||
( descriptor
|
||||
, extractMinimalImports
|
||||
, within
|
||||
) where
|
||||
|
||||
import Control.DeepSeq
|
||||
import Control.Monad.IO.Class
|
||||
@ -210,7 +214,8 @@ extractMinimalImports (Just hsc) (Just TcModuleResult {..}) = do
|
||||
-- call findImportUsage does exactly what we need
|
||||
-- GHC is full of treats like this
|
||||
let usage = findImportUsage imports gblElts
|
||||
(_, minimalImports) <- initTcWithGbl (hscEnv hsc) tcEnv span $ getMinimalImports usage
|
||||
(_, minimalImports) <-
|
||||
initTcWithGbl (hscEnv hsc) tcEnv span $ getMinimalImports usage
|
||||
|
||||
-- return both the original imports and the computed minimal ones
|
||||
return (imports, minimalImports)
|
||||
@ -249,11 +254,11 @@ generateLens pId uri importEdit@TextEdit {_range, _newText} = do
|
||||
-- create and return the code lens
|
||||
return $ Just CodeLens {..}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | A helper to run ide actions
|
||||
runIde :: IdeState -> Action a -> IO a
|
||||
runIde state = runAction "importLens" state
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
runIde = runAction "importLens"
|
||||
|
||||
within :: Range -> SrcSpan -> Bool
|
||||
within (Range start end) span =
|
||||
|
||||
201
plugins/hls-refine-imports-plugin/LICENSE
Normal file
201
plugins/hls-refine-imports-plugin/LICENSE
Normal file
@ -0,0 +1,201 @@
|
||||
Apache License
|
||||
Version 2.0, January 2004
|
||||
http://www.apache.org/licenses/
|
||||
|
||||
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
|
||||
|
||||
1. Definitions.
|
||||
|
||||
"License" shall mean the terms and conditions for use, reproduction,
|
||||
and distribution as defined by Sections 1 through 9 of this document.
|
||||
|
||||
"Licensor" shall mean the copyright owner or entity authorized by
|
||||
the copyright owner that is granting the License.
|
||||
|
||||
"Legal Entity" shall mean the union of the acting entity and all
|
||||
other entities that control, are controlled by, or are under common
|
||||
control with that entity. For the purposes of this definition,
|
||||
"control" means (i) the power, direct or indirect, to cause the
|
||||
direction or management of such entity, whether by contract or
|
||||
otherwise, or (ii) ownership of fifty percent (50%) or more of the
|
||||
outstanding shares, or (iii) beneficial ownership of such entity.
|
||||
|
||||
"You" (or "Your") shall mean an individual or Legal Entity
|
||||
exercising permissions granted by this License.
|
||||
|
||||
"Source" form shall mean the preferred form for making modifications,
|
||||
including but not limited to software source code, documentation
|
||||
source, and configuration files.
|
||||
|
||||
"Object" form shall mean any form resulting from mechanical
|
||||
transformation or translation of a Source form, including but
|
||||
not limited to compiled object code, generated documentation,
|
||||
and conversions to other media types.
|
||||
|
||||
"Work" shall mean the work of authorship, whether in Source or
|
||||
Object form, made available under the License, as indicated by a
|
||||
copyright notice that is included in or attached to the work
|
||||
(an example is provided in the Appendix below).
|
||||
|
||||
"Derivative Works" shall mean any work, whether in Source or Object
|
||||
form, that is based on (or derived from) the Work and for which the
|
||||
editorial revisions, annotations, elaborations, or other modifications
|
||||
represent, as a whole, an original work of authorship. For the purposes
|
||||
of this License, Derivative Works shall not include works that remain
|
||||
separable from, or merely link (or bind by name) to the interfaces of,
|
||||
the Work and Derivative Works thereof.
|
||||
|
||||
"Contribution" shall mean any work of authorship, including
|
||||
the original version of the Work and any modifications or additions
|
||||
to that Work or Derivative Works thereof, that is intentionally
|
||||
submitted to Licensor for inclusion in the Work by the copyright owner
|
||||
or by an individual or Legal Entity authorized to submit on behalf of
|
||||
the copyright owner. For the purposes of this definition, "submitted"
|
||||
means any form of electronic, verbal, or written communication sent
|
||||
to the Licensor or its representatives, including but not limited to
|
||||
communication on electronic mailing lists, source code control systems,
|
||||
and issue tracking systems that are managed by, or on behalf of, the
|
||||
Licensor for the purpose of discussing and improving the Work, but
|
||||
excluding communication that is conspicuously marked or otherwise
|
||||
designated in writing by the copyright owner as "Not a Contribution."
|
||||
|
||||
"Contributor" shall mean Licensor and any individual or Legal Entity
|
||||
on behalf of whom a Contribution has been received by Licensor and
|
||||
subsequently incorporated within the Work.
|
||||
|
||||
2. Grant of Copyright License. Subject to the terms and conditions of
|
||||
this License, each Contributor hereby grants to You a perpetual,
|
||||
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
|
||||
copyright license to reproduce, prepare Derivative Works of,
|
||||
publicly display, publicly perform, sublicense, and distribute the
|
||||
Work and such Derivative Works in Source or Object form.
|
||||
|
||||
3. Grant of Patent License. Subject to the terms and conditions of
|
||||
this License, each Contributor hereby grants to You a perpetual,
|
||||
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
|
||||
(except as stated in this section) patent license to make, have made,
|
||||
use, offer to sell, sell, import, and otherwise transfer the Work,
|
||||
where such license applies only to those patent claims licensable
|
||||
by such Contributor that are necessarily infringed by their
|
||||
Contribution(s) alone or by combination of their Contribution(s)
|
||||
with the Work to which such Contribution(s) was submitted. If You
|
||||
institute patent litigation against any entity (including a
|
||||
cross-claim or counterclaim in a lawsuit) alleging that the Work
|
||||
or a Contribution incorporated within the Work constitutes direct
|
||||
or contributory patent infringement, then any patent licenses
|
||||
granted to You under this License for that Work shall terminate
|
||||
as of the date such litigation is filed.
|
||||
|
||||
4. Redistribution. You may reproduce and distribute copies of the
|
||||
Work or Derivative Works thereof in any medium, with or without
|
||||
modifications, and in Source or Object form, provided that You
|
||||
meet the following conditions:
|
||||
|
||||
(a) You must give any other recipients of the Work or
|
||||
Derivative Works a copy of this License; and
|
||||
|
||||
(b) You must cause any modified files to carry prominent notices
|
||||
stating that You changed the files; and
|
||||
|
||||
(c) You must retain, in the Source form of any Derivative Works
|
||||
that You distribute, all copyright, patent, trademark, and
|
||||
attribution notices from the Source form of the Work,
|
||||
excluding those notices that do not pertain to any part of
|
||||
the Derivative Works; and
|
||||
|
||||
(d) If the Work includes a "NOTICE" text file as part of its
|
||||
distribution, then any Derivative Works that You distribute must
|
||||
include a readable copy of the attribution notices contained
|
||||
within such NOTICE file, excluding those notices that do not
|
||||
pertain to any part of the Derivative Works, in at least one
|
||||
of the following places: within a NOTICE text file distributed
|
||||
as part of the Derivative Works; within the Source form or
|
||||
documentation, if provided along with the Derivative Works; or,
|
||||
within a display generated by the Derivative Works, if and
|
||||
wherever such third-party notices normally appear. The contents
|
||||
of the NOTICE file are for informational purposes only and
|
||||
do not modify the License. You may add Your own attribution
|
||||
notices within Derivative Works that You distribute, alongside
|
||||
or as an addendum to the NOTICE text from the Work, provided
|
||||
that such additional attribution notices cannot be construed
|
||||
as modifying the License.
|
||||
|
||||
You may add Your own copyright statement to Your modifications and
|
||||
may provide additional or different license terms and conditions
|
||||
for use, reproduction, or distribution of Your modifications, or
|
||||
for any such Derivative Works as a whole, provided Your use,
|
||||
reproduction, and distribution of the Work otherwise complies with
|
||||
the conditions stated in this License.
|
||||
|
||||
5. Submission of Contributions. Unless You explicitly state otherwise,
|
||||
any Contribution intentionally submitted for inclusion in the Work
|
||||
by You to the Licensor shall be under the terms and conditions of
|
||||
this License, without any additional terms or conditions.
|
||||
Notwithstanding the above, nothing herein shall supersede or modify
|
||||
the terms of any separate license agreement you may have executed
|
||||
with Licensor regarding such Contributions.
|
||||
|
||||
6. Trademarks. This License does not grant permission to use the trade
|
||||
names, trademarks, service marks, or product names of the Licensor,
|
||||
except as required for reasonable and customary use in describing the
|
||||
origin of the Work and reproducing the content of the NOTICE file.
|
||||
|
||||
7. Disclaimer of Warranty. Unless required by applicable law or
|
||||
agreed to in writing, Licensor provides the Work (and each
|
||||
Contributor provides its Contributions) on an "AS IS" BASIS,
|
||||
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
|
||||
implied, including, without limitation, any warranties or conditions
|
||||
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
|
||||
PARTICULAR PURPOSE. You are solely responsible for determining the
|
||||
appropriateness of using or redistributing the Work and assume any
|
||||
risks associated with Your exercise of permissions under this License.
|
||||
|
||||
8. Limitation of Liability. In no event and under no legal theory,
|
||||
whether in tort (including negligence), contract, or otherwise,
|
||||
unless required by applicable law (such as deliberate and grossly
|
||||
negligent acts) or agreed to in writing, shall any Contributor be
|
||||
liable to You for damages, including any direct, indirect, special,
|
||||
incidental, or consequential damages of any character arising as a
|
||||
result of this License or out of the use or inability to use the
|
||||
Work (including but not limited to damages for loss of goodwill,
|
||||
work stoppage, computer failure or malfunction, or any and all
|
||||
other commercial damages or losses), even if such Contributor
|
||||
has been advised of the possibility of such damages.
|
||||
|
||||
9. Accepting Warranty or Additional Liability. While redistributing
|
||||
the Work or Derivative Works thereof, You may choose to offer,
|
||||
and charge a fee for, acceptance of support, warranty, indemnity,
|
||||
or other liability obligations and/or rights consistent with this
|
||||
License. However, in accepting such obligations, You may act only
|
||||
on Your own behalf and on Your sole responsibility, not on behalf
|
||||
of any other Contributor, and only if You agree to indemnify,
|
||||
defend, and hold each Contributor harmless for any liability
|
||||
incurred by, or claims asserted against, such Contributor by reason
|
||||
of your accepting any such warranty or additional liability.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
APPENDIX: How to apply the Apache License to your work.
|
||||
|
||||
To apply the Apache License to your work, attach the following
|
||||
boilerplate notice, with the fields enclosed by brackets "[]"
|
||||
replaced with your own identifying information. (Don't include
|
||||
the brackets!) The text should be enclosed in the appropriate
|
||||
comment syntax for the file format. We also recommend that a
|
||||
file or class name and description of purpose be included on the
|
||||
same "printed page" as the copyright notice for easier
|
||||
identification within third-party archives.
|
||||
|
||||
Copyright [yyyy] [name of copyright owner]
|
||||
|
||||
Licensed under the Apache License, Version 2.0 (the "License");
|
||||
you may not use this file except in compliance with the License.
|
||||
You may obtain a copy of the License at
|
||||
|
||||
http://www.apache.org/licenses/LICENSE-2.0
|
||||
|
||||
Unless required by applicable law or agreed to in writing, software
|
||||
distributed under the License is distributed on an "AS IS" BASIS,
|
||||
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
See the License for the specific language governing permissions and
|
||||
limitations under the License.
|
||||
@ -0,0 +1,47 @@
|
||||
cabal-version: 2.2
|
||||
name: hls-refine-imports-plugin
|
||||
version: 1.0.0.0
|
||||
synopsis: Refine imports plugin for Haskell Language Server
|
||||
license: Apache-2.0
|
||||
license-file: LICENSE
|
||||
author: rayshih
|
||||
maintainer: mnf.shih@gmail.com
|
||||
category: Development
|
||||
build-type: Simple
|
||||
extra-source-files:
|
||||
LICENSE
|
||||
|
||||
library
|
||||
exposed-modules: Ide.Plugin.RefineImports
|
||||
hs-source-dirs: src
|
||||
build-depends:
|
||||
, aeson
|
||||
, base >=4.12 && <5
|
||||
, containers
|
||||
, deepseq
|
||||
, ghc
|
||||
, ghcide ^>=1.2.0.2
|
||||
, hls-plugin-api ^>=1.1.0.0
|
||||
, lsp
|
||||
, lsp-types
|
||||
, hls-graph
|
||||
, text
|
||||
, unordered-containers
|
||||
, hls-explicit-imports-plugin ^>= 1.0.0.1
|
||||
|
||||
default-language: Haskell2010
|
||||
default-extensions: DataKinds, TypeOperators
|
||||
|
||||
test-suite tests
|
||||
type: exitcode-stdio-1.0
|
||||
default-language: Haskell2010
|
||||
hs-source-dirs: test
|
||||
main-is: Main.hs
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
, base
|
||||
, bytestring
|
||||
, filepath
|
||||
, hls-refine-imports-plugin
|
||||
, hls-test-utils
|
||||
, text
|
||||
@ -0,0 +1,280 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Ide.Plugin.RefineImports (descriptor) where
|
||||
|
||||
import Avail (AvailInfo (Avail),
|
||||
availName, availNames,
|
||||
availNamesWithSelectors)
|
||||
import Control.Arrow (Arrow (second))
|
||||
import Control.DeepSeq (rwhnf)
|
||||
import Control.Monad (join)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Aeson.Types
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.IORef (readIORef)
|
||||
import Data.List (intercalate)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe (catMaybes, fromMaybe)
|
||||
import qualified Data.Text as T
|
||||
import Data.Traversable (forM)
|
||||
import Development.IDE
|
||||
import Development.IDE.Core.PositionMapping
|
||||
import Development.IDE.GHC.Compat (AvailInfo,
|
||||
GenLocated (L), GhcRn,
|
||||
HsModule (hsmodImports),
|
||||
ImportDecl (ImportDecl, ideclHiding, ideclName),
|
||||
LIE, LImportDecl,
|
||||
Module (moduleName),
|
||||
ModuleName,
|
||||
ParsedModule (ParsedModule, pm_parsed_source),
|
||||
SrcSpan (RealSrcSpan),
|
||||
getLoc, ieName, noLoc,
|
||||
tcg_exports, unLoc)
|
||||
import Development.IDE.Graph.Classes
|
||||
import GHC.Generics (Generic)
|
||||
import Ide.Plugin.ExplicitImports (extractMinimalImports,
|
||||
within)
|
||||
import Ide.PluginUtils (mkLspCommand)
|
||||
import Ide.Types
|
||||
import Language.LSP.Server
|
||||
import Language.LSP.Types
|
||||
import PrelNames (pRELUDE)
|
||||
import RnNames (findImportUsage,
|
||||
getMinimalImports)
|
||||
import TcRnMonad (initTcWithGbl,
|
||||
tcg_rn_exports,
|
||||
tcg_used_gres)
|
||||
|
||||
-- | plugin declaration
|
||||
descriptor :: PluginId -> PluginDescriptor IdeState
|
||||
descriptor plId = (defaultPluginDescriptor plId)
|
||||
{ pluginCommands = [refineImportCommand]
|
||||
, pluginRules = refineImportsRule
|
||||
, pluginHandlers = mconcat
|
||||
[ -- This plugin provides code lenses
|
||||
mkPluginHandler STextDocumentCodeLens lensProvider
|
||||
-- This plugin provides code actions
|
||||
, mkPluginHandler STextDocumentCodeAction codeActionProvider
|
||||
]
|
||||
}
|
||||
|
||||
refineImportCommandId :: CommandId
|
||||
refineImportCommandId = "RefineImportLensCommand"
|
||||
|
||||
newtype RefineImportCommandParams = RefineImportCommandParams WorkspaceEdit
|
||||
deriving Generic
|
||||
deriving anyclass (FromJSON, ToJSON)
|
||||
|
||||
-- | The command descriptor
|
||||
refineImportCommand :: PluginCommand IdeState
|
||||
refineImportCommand =
|
||||
PluginCommand
|
||||
{ commandId = refineImportCommandId
|
||||
, commandDesc = "Directly use the imports as oppose to using aggregation module"
|
||||
, commandFunc = runRefineImportCommand
|
||||
}
|
||||
|
||||
-- | The actual command handler
|
||||
runRefineImportCommand :: CommandFunction IdeState RefineImportCommandParams
|
||||
runRefineImportCommand _state (RefineImportCommandParams edit) = do
|
||||
-- This command simply triggers a workspace edit!
|
||||
_ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ())
|
||||
return (Right Null)
|
||||
|
||||
lensProvider :: PluginMethodHandler IdeState TextDocumentCodeLens
|
||||
lensProvider
|
||||
state -- ghcide state
|
||||
pId
|
||||
CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}}
|
||||
-- VSCode uses URIs instead of file paths
|
||||
-- haskell-lsp provides conversion functions
|
||||
| Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri = liftIO $
|
||||
do
|
||||
mbRefinedImports <-
|
||||
runIde state $ useWithStale RefineImports nfp
|
||||
case mbRefinedImports of
|
||||
-- Implement the provider logic:
|
||||
-- for every refined import, generate a code lens
|
||||
Just (RefineImportsResult result, posMapping) -> do
|
||||
commands <-
|
||||
sequence
|
||||
[ generateLens pId _uri edit
|
||||
| (imp, Just refinedImports) <- result
|
||||
, Just edit <- [mkExplicitEdit posMapping imp refinedImports]
|
||||
]
|
||||
return $ Right (List $ catMaybes commands)
|
||||
_ -> return $ Right (List [])
|
||||
| otherwise =
|
||||
return $ Right (List [])
|
||||
|
||||
-- | Provide one code action to refine all imports
|
||||
codeActionProvider :: PluginMethodHandler IdeState TextDocumentCodeAction
|
||||
codeActionProvider 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
|
||||
mbRefinedImports <- runIde ideState $ use RefineImports nfp
|
||||
let edits =
|
||||
[ e
|
||||
| Just (RefineImportsResult result) <- [mbRefinedImports]
|
||||
, (imp, Just refinedImports) <- result
|
||||
, Just e <- [mkExplicitEdit zeroMapping imp refinedImports]
|
||||
]
|
||||
caExplicitImports = InR CodeAction {..}
|
||||
_title = "Refine all imports"
|
||||
_kind = Just $ CodeActionUnknown "quickfix.import.refine"
|
||||
_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 []
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data RefineImports = RefineImports
|
||||
deriving (Show, Generic, Eq, Ord)
|
||||
|
||||
instance Hashable RefineImports
|
||||
instance NFData RefineImports
|
||||
instance Binary RefineImports
|
||||
type instance RuleResult RefineImports = RefineImportsResult
|
||||
|
||||
newtype RefineImportsResult = RefineImportsResult
|
||||
{getMinimalImportsResult :: [(LImportDecl GhcRn, Maybe T.Text)]}
|
||||
|
||||
instance Show RefineImportsResult where show _ = "<refineImportsResult>"
|
||||
instance NFData RefineImportsResult where rnf = rwhnf
|
||||
|
||||
refineImportsRule :: Rules ()
|
||||
refineImportsRule = define $ \RefineImports nfp -> do
|
||||
-- Get the typechecking artifacts from the module
|
||||
tmr <- use TypeCheck nfp
|
||||
-- We also need a GHC session with all the dependencies
|
||||
hsc <- 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
|
||||
forM currIm $ \path -> do
|
||||
-- second layer is from the imports of first layer to their imports
|
||||
ImportMap importIm <- use_ GetImportMap path
|
||||
forM importIm $ \imp_path -> do
|
||||
imp_tmr <- use_ TypeCheck imp_path
|
||||
return $ tcg_exports $ tmrTypechecked imp_tmr
|
||||
|
||||
-- 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
|
||||
|
||||
let filterByImport
|
||||
:: LImportDecl GhcRn
|
||||
-> Map.Map ModuleName [AvailInfo]
|
||||
-> Map.Map ModuleName [AvailInfo]
|
||||
filterByImport (L _ ImportDecl{ideclHiding = Just (_, L _ names)}) avails =
|
||||
let importedNames = map (ieName . unLoc) names
|
||||
in flip Map.filter avails $ \a ->
|
||||
any (`elem` importedNames)
|
||||
$ concatMap availNamesWithSelectors a
|
||||
filterByImport _ _ = mempty
|
||||
let constructImport
|
||||
:: LImportDecl GhcRn
|
||||
-> (ModuleName, [AvailInfo])
|
||||
-> LImportDecl GhcRn
|
||||
constructImport
|
||||
i@(L lim id@ImportDecl
|
||||
{ideclName = L _ mn, ideclHiding = Just (hiding, L _ names)})
|
||||
(newModuleName, avails) = L lim id
|
||||
{ ideclName = noLoc newModuleName
|
||||
, ideclHiding = Just (hiding, noLoc newNames)
|
||||
}
|
||||
where newNames = filter (\n -> any (n `containsAvail`) avails) names
|
||||
constructImport lim _ = lim
|
||||
let res =
|
||||
[ (i, Just
|
||||
. T.intercalate "\n"
|
||||
. map (T.pack . prettyPrint . constructImport i)
|
||||
. Map.toList
|
||||
$ filteredInnerImports)
|
||||
-- for every minimal imports
|
||||
| Just minImports <- [mbMinImports]
|
||||
, i@(L _ ImportDecl{ideclName = L _ mn}) <- minImports
|
||||
-- we check for the inner imports
|
||||
, Just innerImports <- [Map.lookup mn import2Map]
|
||||
-- and only get those symbols used
|
||||
, filteredInnerImports <- [filterByImport i innerImports]
|
||||
-- if no symbols from this modules then don't need to generate new import
|
||||
, not $ null filteredInnerImports
|
||||
]
|
||||
return ([], RefineImportsResult res <$ mbMinImports)
|
||||
|
||||
where
|
||||
-- Check if a name is exposed by AvailInfo (the available information of a module)
|
||||
containsAvail :: LIE GhcRn -> AvailInfo -> Bool
|
||||
containsAvail name avail =
|
||||
any (\an -> prettyPrint an == (prettyPrint . ieName . unLoc $ name))
|
||||
$ availNamesWithSelectors avail
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
mkExplicitEdit :: PositionMapping -> LImportDecl pass -> T.Text -> Maybe TextEdit
|
||||
mkExplicitEdit posMapping (L src imp) explicit
|
||||
| RealSrcSpan l <- src,
|
||||
L _ mn <- ideclName imp,
|
||||
-- (almost) no one wants to see an refine import list for Prelude
|
||||
mn /= moduleName pRELUDE,
|
||||
Just rng <- toCurrentRange posMapping $ realSrcSpanToRange l =
|
||||
Just $ TextEdit rng explicit
|
||||
| otherwise =
|
||||
Nothing
|
||||
|
||||
-- | 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 edits@TextEdit {_range, _newText} = do
|
||||
-- The title of the command is just the minimal explicit import decl
|
||||
let title = "Refine imports to " <> T.intercalate ", " (T.lines _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 [edits])]
|
||||
-- the command argument is simply the edit
|
||||
_arguments = Just [toJSON $ RefineImportCommandParams edit]
|
||||
-- create the command
|
||||
_command = Just $ mkLspCommand pId refineImportCommandId title _arguments
|
||||
-- create and return the code lens
|
||||
return $ Just CodeLens {..}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | A helper to run ide actions
|
||||
runIde :: IdeState -> Action a -> IO a
|
||||
runIde = runAction "RefineImports"
|
||||
89
plugins/hls-refine-imports-plugin/test/Main.hs
Normal file
89
plugins/hls-refine-imports-plugin/test/Main.hs
Normal file
@ -0,0 +1,89 @@
|
||||
{-# LANGUAGE DisambiguateRecordFields #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module Main (main) where
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Data.Foldable (find, forM_)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import qualified Ide.Plugin.RefineImports as RefineImports
|
||||
import System.FilePath ((<.>), (</>))
|
||||
import Test.Hls
|
||||
|
||||
main :: IO ()
|
||||
main = defaultTestRunner $
|
||||
testGroup
|
||||
"Refine Imports"
|
||||
[ codeActionGoldenTest "WithOverride" 3 1
|
||||
, codeLensGoldenTest "UsualCase" 1
|
||||
]
|
||||
|
||||
plugin :: PluginDescriptor IdeState
|
||||
plugin = RefineImports.descriptor "refineImports"
|
||||
|
||||
-- code action tests
|
||||
|
||||
codeActionGoldenTest :: FilePath -> Int -> Int -> TestTree
|
||||
codeActionGoldenTest fp l c = goldenGitDiff (fp <> " (golden)") goldenFilePath $
|
||||
runSessionWithServer plugin testDataDir $ do
|
||||
doc <- openDoc hsFilePath "haskell"
|
||||
actions <- getCodeActions doc (pointRange l c)
|
||||
case find ((== Just "Refine all imports") . caTitle) actions of
|
||||
Just (InR x) -> do
|
||||
executeCodeAction x
|
||||
LBS.fromStrict . encodeUtf8 <$> documentContents doc
|
||||
_ -> liftIO $ assertFailure "Unable to find CodeAction"
|
||||
where
|
||||
hsFilePath = fp <.> "hs"
|
||||
goldenFilePath = testDataDir </> fp <.> "expected" <.> "hs"
|
||||
|
||||
caTitle :: (Command |? CodeAction) -> Maybe Text
|
||||
caTitle (InR CodeAction {_title}) = Just _title
|
||||
caTitle _ = Nothing
|
||||
|
||||
|
||||
-- code lens tests
|
||||
|
||||
codeLensGoldenTest :: FilePath -> Int -> TestTree
|
||||
codeLensGoldenTest fp codeLensIdx = goldenGitDiff (fp <> " (golden)") goldenFilePath $
|
||||
runSessionWithServer plugin testDataDir $ do
|
||||
doc <- openDoc hsFilePath "haskell"
|
||||
codeLens <- (!! codeLensIdx) <$> getCodeLensesBy isRefineImports doc
|
||||
mapM_ executeCmd
|
||||
[c | CodeLens{_command = Just c} <- [codeLens]]
|
||||
LBS.fromStrict . encodeUtf8 <$> documentContents doc
|
||||
where
|
||||
hsFilePath = fp <.> "hs"
|
||||
goldenFilePath = testDataDir </> fp <.> "expected" <.> "hs"
|
||||
|
||||
getCodeLensesBy :: (CodeLens -> Bool) -> TextDocumentIdentifier -> Session [CodeLens]
|
||||
getCodeLensesBy f doc = filter f <$> getCodeLenses doc
|
||||
|
||||
isRefineImports :: CodeLens -> Bool
|
||||
isRefineImports (CodeLens _ (Just (Command _ cmd _)) _)
|
||||
| ":refineImports:" `T.isInfixOf` cmd = True
|
||||
isRefineImports _ = False
|
||||
|
||||
-- Execute command and wait for result
|
||||
executeCmd :: Command -> Session ()
|
||||
executeCmd cmd = do
|
||||
executeCommand cmd
|
||||
_resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit)
|
||||
-- liftIO $ print _resp
|
||||
return ()
|
||||
|
||||
-- helpers
|
||||
|
||||
testDataDir :: String
|
||||
testDataDir = "test" </> "testdata"
|
||||
|
||||
pointRange :: Int -> Int -> Range
|
||||
pointRange
|
||||
(subtract 1 -> line)
|
||||
(subtract 1 -> col) =
|
||||
Range (Position line col) (Position line $ col + 1)
|
||||
7
plugins/hls-refine-imports-plugin/test/testdata/A.hs
vendored
Normal file
7
plugins/hls-refine-imports-plugin/test/testdata/A.hs
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
module A
|
||||
( module B
|
||||
, module C
|
||||
) where
|
||||
|
||||
import B
|
||||
import C
|
||||
7
plugins/hls-refine-imports-plugin/test/testdata/B.hs
vendored
Normal file
7
plugins/hls-refine-imports-plugin/test/testdata/B.hs
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
module B where
|
||||
|
||||
b1 :: String
|
||||
b1 = "b1"
|
||||
|
||||
b2 :: String
|
||||
b2 = "b2"
|
||||
4
plugins/hls-refine-imports-plugin/test/testdata/C.hs
vendored
Normal file
4
plugins/hls-refine-imports-plugin/test/testdata/C.hs
vendored
Normal file
@ -0,0 +1,4 @@
|
||||
module C where
|
||||
|
||||
c1 :: String
|
||||
c1 = "c1"
|
||||
7
plugins/hls-refine-imports-plugin/test/testdata/D.hs
vendored
Normal file
7
plugins/hls-refine-imports-plugin/test/testdata/D.hs
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
module D (module E, module D) where
|
||||
|
||||
import E hiding (e1)
|
||||
import qualified E
|
||||
|
||||
e1 :: String
|
||||
e1 = E.e1 <> " but overrided"
|
||||
7
plugins/hls-refine-imports-plugin/test/testdata/E.hs
vendored
Normal file
7
plugins/hls-refine-imports-plugin/test/testdata/E.hs
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
module E where
|
||||
|
||||
e1 :: String
|
||||
e1 = "e1"
|
||||
|
||||
e2 :: String
|
||||
e2 = "e2"
|
||||
10
plugins/hls-refine-imports-plugin/test/testdata/UsualCase.expected.hs
vendored
Normal file
10
plugins/hls-refine-imports-plugin/test/testdata/UsualCase.expected.hs
vendored
Normal file
@ -0,0 +1,10 @@
|
||||
module Main where
|
||||
|
||||
import A
|
||||
import E ( e2 )
|
||||
import Data.List (intercalate)
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn
|
||||
$ "hello "
|
||||
<> intercalate ", " [b1, c1, e2]
|
||||
10
plugins/hls-refine-imports-plugin/test/testdata/UsualCase.hs
vendored
Normal file
10
plugins/hls-refine-imports-plugin/test/testdata/UsualCase.hs
vendored
Normal file
@ -0,0 +1,10 @@
|
||||
module Main where
|
||||
|
||||
import A
|
||||
import D
|
||||
import Data.List (intercalate)
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn
|
||||
$ "hello "
|
||||
<> intercalate ", " [b1, c1, e2]
|
||||
11
plugins/hls-refine-imports-plugin/test/testdata/WithOverride.expected.hs
vendored
Normal file
11
plugins/hls-refine-imports-plugin/test/testdata/WithOverride.expected.hs
vendored
Normal file
@ -0,0 +1,11 @@
|
||||
module Main where
|
||||
|
||||
import B ( b1 )
|
||||
import C ( c1 )
|
||||
import D
|
||||
import Data.List (intercalate)
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn
|
||||
$ "hello "
|
||||
<> intercalate ", " [b1, c1, e1]
|
||||
10
plugins/hls-refine-imports-plugin/test/testdata/WithOverride.hs
vendored
Normal file
10
plugins/hls-refine-imports-plugin/test/testdata/WithOverride.hs
vendored
Normal file
@ -0,0 +1,10 @@
|
||||
module Main where
|
||||
|
||||
import A
|
||||
import D
|
||||
import Data.List (intercalate)
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn
|
||||
$ "hello "
|
||||
<> intercalate ", " [b1, c1, e1]
|
||||
10
plugins/hls-refine-imports-plugin/test/testdata/hie.yaml
vendored
Normal file
10
plugins/hls-refine-imports-plugin/test/testdata/hie.yaml
vendored
Normal file
@ -0,0 +1,10 @@
|
||||
cradle:
|
||||
direct:
|
||||
arguments:
|
||||
- UsualCase.hs
|
||||
- WithOverride.hs
|
||||
- A.hs
|
||||
- B.hs
|
||||
- C.hs
|
||||
- D.hs
|
||||
- E.hs
|
||||
@ -12,6 +12,7 @@ packages:
|
||||
- ./plugins/hls-haddock-comments-plugin
|
||||
- ./plugins/hls-eval-plugin
|
||||
- ./plugins/hls-explicit-imports-plugin
|
||||
- ./plugins/hls-refine-imports-plugin
|
||||
- ./plugins/hls-hlint-plugin
|
||||
- ./plugins/hls-retrie-plugin
|
||||
- ./plugins/hls-splice-plugin
|
||||
|
||||
@ -12,6 +12,7 @@ packages:
|
||||
- ./plugins/hls-haddock-comments-plugin
|
||||
- ./plugins/hls-eval-plugin
|
||||
- ./plugins/hls-explicit-imports-plugin
|
||||
- ./plugins/hls-refine-imports-plugin
|
||||
- ./plugins/hls-hlint-plugin
|
||||
- ./plugins/hls-retrie-plugin
|
||||
- ./plugins/hls-splice-plugin
|
||||
|
||||
@ -12,6 +12,7 @@ packages:
|
||||
- ./plugins/hls-haddock-comments-plugin
|
||||
- ./plugins/hls-eval-plugin
|
||||
- ./plugins/hls-explicit-imports-plugin
|
||||
- ./plugins/hls-refine-imports-plugin
|
||||
- ./plugins/hls-hlint-plugin
|
||||
- ./plugins/hls-retrie-plugin
|
||||
- ./plugins/hls-splice-plugin
|
||||
|
||||
@ -13,6 +13,7 @@ packages:
|
||||
- ./plugins/hls-haddock-comments-plugin
|
||||
- ./plugins/hls-eval-plugin
|
||||
- ./plugins/hls-explicit-imports-plugin
|
||||
- ./plugins/hls-refine-imports-plugin
|
||||
- ./plugins/hls-hlint-plugin
|
||||
- ./plugins/hls-retrie-plugin
|
||||
- ./plugins/hls-splice-plugin
|
||||
|
||||
@ -12,6 +12,7 @@ packages:
|
||||
- ./plugins/hls-haddock-comments-plugin
|
||||
- ./plugins/hls-eval-plugin
|
||||
- ./plugins/hls-explicit-imports-plugin
|
||||
- ./plugins/hls-refine-imports-plugin
|
||||
- ./plugins/hls-hlint-plugin
|
||||
- ./plugins/hls-retrie-plugin
|
||||
- ./plugins/hls-splice-plugin
|
||||
|
||||
@ -12,6 +12,7 @@ packages:
|
||||
- ./plugins/hls-haddock-comments-plugin
|
||||
- ./plugins/hls-eval-plugin
|
||||
- ./plugins/hls-explicit-imports-plugin
|
||||
- ./plugins/hls-refine-imports-plugin
|
||||
- ./plugins/hls-hlint-plugin
|
||||
- ./plugins/hls-retrie-plugin
|
||||
- ./plugins/hls-splice-plugin
|
||||
|
||||
@ -12,6 +12,7 @@ packages:
|
||||
- ./plugins/hls-haddock-comments-plugin
|
||||
- ./plugins/hls-eval-plugin
|
||||
- ./plugins/hls-explicit-imports-plugin
|
||||
- ./plugins/hls-refine-imports-plugin
|
||||
- ./plugins/hls-hlint-plugin
|
||||
- ./plugins/hls-retrie-plugin
|
||||
- ./plugins/hls-splice-plugin
|
||||
|
||||
@ -12,6 +12,7 @@ packages:
|
||||
- ./plugins/hls-haddock-comments-plugin
|
||||
- ./plugins/hls-eval-plugin
|
||||
- ./plugins/hls-explicit-imports-plugin
|
||||
- ./plugins/hls-refine-imports-plugin
|
||||
- ./plugins/hls-hlint-plugin
|
||||
- ./plugins/hls-retrie-plugin
|
||||
- ./plugins/hls-splice-plugin
|
||||
|
||||
@ -12,6 +12,7 @@ packages:
|
||||
- ./plugins/hls-haddock-comments-plugin
|
||||
- ./plugins/hls-eval-plugin
|
||||
- ./plugins/hls-explicit-imports-plugin
|
||||
- ./plugins/hls-refine-imports-plugin
|
||||
- ./plugins/hls-hlint-plugin
|
||||
- ./plugins/hls-retrie-plugin
|
||||
- ./plugins/hls-splice-plugin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user