Skip to content

Commit 27f46d7

Browse files
joyfulmantisjoyfulmantis
authored
Resolve for explicit-imports (#3682)
1 parent e9cc4e0 commit 27f46d7

15 files changed

+385
-202
lines changed

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

Lines changed: 19 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,16 @@ source-repository head
1919
type: git
2020
location: https://github.com/haskell/haskell-language-server.git
2121

22+
flag pedantic
23+
description: Enable -Werror
24+
default: False
25+
manual: True
26+
27+
common warnings
28+
ghc-options: -Wall
29+
2230
library
31+
import: warnings
2332
buildable: True
2433
exposed-modules: Ide.Plugin.ExplicitImports
2534
hs-source-dirs: src
@@ -32,16 +41,22 @@ library
3241
, ghcide == 2.1.0.0
3342
, hls-graph
3443
, hls-plugin-api == 2.1.0.0
44+
, lens
3545
, lsp
3646
, text
47+
, transformers
3748
, unordered-containers
3849

3950
default-language: Haskell2010
4051
default-extensions:
4152
DataKinds
4253
TypeOperators
4354

55+
if flag(pedantic)
56+
ghc-options: -Werror
57+
4458
test-suite tests
59+
import: warnings
4560
buildable: True
4661
type: exitcode-stdio-1.0
4762
default-language: Haskell2010
@@ -50,8 +65,11 @@ test-suite tests
5065
ghc-options: -threaded -rtsopts -with-rtsopts=-N
5166
build-depends:
5267
, base
68+
, extra
5369
, filepath
5470
, hls-explicit-imports-plugin
5571
, hls-test-utils
72+
, lens
5673
, lsp-types
57-
, text
74+
, row-types
75+
, text

‎plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs

Lines changed: 209 additions & 167 deletions
Large diffs are not rendered by default.

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

Lines changed: 91 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,33 +1,40 @@
11
{-# LANGUAGE DisambiguateRecordFields #-}
2+
{-# LANGUAGE LambdaCase #-}
23
{-# LANGUAGE NamedFieldPuns #-}
4+
{-# LANGUAGE OverloadedLabels #-}
35
{-# LANGUAGE OverloadedStrings #-}
46
{-# LANGUAGE TypeOperators #-}
57
{-# LANGUAGE ViewPatterns #-}
6-
78
module Main
89
( main
910
) where
1011

11-
import Data.Foldable (find, forM_)
12+
import Control.Lens ((^.))
13+
import Data.Either.Extra
14+
import Data.Foldable (find)
15+
import Data.Row ((.+), (.==))
1216
import Data.Text (Text)
1317
import qualified Data.Text as T
1418
import qualified Ide.Plugin.ExplicitImports as ExplicitImports
19+
import qualified Language.LSP.Protocol.Lens as L
1520
import Language.LSP.Protocol.Message
16-
import System.FilePath ((<.>), (</>))
21+
import System.FilePath ((</>))
1722
import Test.Hls
1823

1924
explicitImportsPlugin :: PluginTestDescriptor ExplicitImports.Log
2025
explicitImportsPlugin = mkPluginTestDescriptor ExplicitImports.descriptor "explicitImports"
2126

22-
longModule :: T.Text
23-
longModule = "F" <> T.replicate 80 "o"
24-
2527
main :: IO ()
2628
main = defaultTestRunner $
2729
testGroup
2830
"Make imports explicit"
29-
[ codeActionGoldenTest "UsualCase" 3 0
31+
[ codeActionAllGoldenTest "UsualCase" 3 0
32+
, codeActionAllResolveGoldenTest "UsualCase" 3 0
33+
, codeActionOnlyGoldenTest "OnlyThis" 3 0
34+
, codeActionOnlyResolveGoldenTest "OnlyThis" 3 0
3035
, codeLensGoldenTest "UsualCase" 0
36+
, codeActionBreakFile "BreakFile" 4 0
37+
, codeActionStaleAction "StaleAction" 4 0
3138
, testCase "No CodeAction when exported" $
3239
runSessionWithServer explicitImportsPlugin testDataDir $ do
3340
doc <- openDoc "Exported.hs" "haskell"
@@ -65,12 +72,74 @@ main = defaultTestRunner $
6572

6673
-- code action tests
6774

68-
codeActionGoldenTest :: FilePath -> Int -> Int -> TestTree
69-
codeActionGoldenTest fp l c = goldenWithExplicitImports fp $ \doc -> do
75+
codeActionAllGoldenTest :: FilePath -> Int -> Int -> TestTree
76+
codeActionAllGoldenTest fp l c = goldenWithExplicitImports " code action" fp codeActionNoResolveCaps $ \doc -> do
77+
actions <- getCodeActions doc (pointRange l c)
78+
case find ((== Just "Make all imports explicit") . caTitle) actions of
79+
Just (InR x) -> executeCodeAction x
80+
_ -> liftIO $ assertFailure "Unable to find CodeAction"
81+
82+
codeActionBreakFile :: FilePath -> Int -> Int -> TestTree
83+
codeActionBreakFile fp l c = goldenWithExplicitImports " code action" fp codeActionNoResolveCaps $ \doc -> do
84+
_ <- waitForDiagnostics
85+
changeDoc doc [edit]
7086
actions <- getCodeActions doc (pointRange l c)
7187
case find ((== Just "Make all imports explicit") . caTitle) actions of
7288
Just (InR x) -> executeCodeAction x
7389
_ -> liftIO $ assertFailure "Unable to find CodeAction"
90+
where edit = TextDocumentContentChangeEvent $ InL $ #range .== pointRange 2 21
91+
.+ #rangeLength .== Nothing
92+
.+ #text .== "x"
93+
94+
codeActionStaleAction :: FilePath -> Int -> Int -> TestTree
95+
codeActionStaleAction fp l c = goldenWithExplicitImports " code action" fp codeActionResolveCaps $ \doc -> do
96+
_ <- waitForDiagnostics
97+
actions <- getCodeActions doc (pointRange l c)
98+
changeDoc doc [edit]
99+
_ <- waitForDiagnostics
100+
case find ((== Just "Make this import explicit") . caTitle) actions of
101+
Just (InR x) ->
102+
maybeResolveCodeAction x >>=
103+
\case Just _ -> liftIO $ assertFailure "Code action still valid"
104+
Nothing -> pure ()
105+
_ -> liftIO $ assertFailure "Unable to find CodeAction"
106+
where edit = TextDocumentContentChangeEvent $ InL $ #range .== Range (Position 6 0) (Position 6 0)
107+
.+ #rangeLength .== Nothing
108+
.+ #text .== "\ntesting = undefined"
109+
110+
codeActionAllResolveGoldenTest :: FilePath -> Int -> Int -> TestTree
111+
codeActionAllResolveGoldenTest fp l c = goldenWithExplicitImports " code action resolve" fp codeActionResolveCaps $ \doc -> do
112+
actions <- getCodeActions doc (pointRange l c)
113+
Just (InR x) <- pure $ find ((== Just "Make all imports explicit") . caTitle) actions
114+
resolved <- resolveCodeAction x
115+
executeCodeAction resolved
116+
117+
codeActionOnlyGoldenTest :: FilePath -> Int -> Int -> TestTree
118+
codeActionOnlyGoldenTest fp l c = goldenWithExplicitImports " code action" fp codeActionNoResolveCaps $ \doc -> do
119+
actions <- getCodeActions doc (pointRange l c)
120+
case find ((== Just "Make this import explicit") . caTitle) actions of
121+
Just (InR x) -> executeCodeAction x
122+
_ -> liftIO $ assertFailure "Unable to find CodeAction"
123+
124+
codeActionOnlyResolveGoldenTest :: FilePath -> Int -> Int -> TestTree
125+
codeActionOnlyResolveGoldenTest fp l c = goldenWithExplicitImports " code action resolve" fp codeActionResolveCaps $ \doc -> do
126+
actions <- getCodeActions doc (pointRange l c)
127+
Just (InR x) <- pure $ find ((== Just "Make this import explicit") . caTitle) actions
128+
resolved <- resolveCodeAction x
129+
executeCodeAction resolved
130+
131+
-- TODO: use the one from lsp-test once that's released
132+
resolveCodeAction :: CodeAction -> Session CodeAction
133+
resolveCodeAction ca = do
134+
resolveResponse <- request SMethod_CodeActionResolve ca
135+
Right resolved <- pure $ resolveResponse ^. L.result
136+
pure resolved
137+
138+
maybeResolveCodeAction :: CodeAction -> Session (Maybe CodeAction)
139+
maybeResolveCodeAction ca = do
140+
resolveResponse <- request SMethod_CodeActionResolve ca
141+
let resolved = resolveResponse ^. L.result
142+
pure $ eitherToMaybe resolved
74143

75144
caTitle :: (Command |? CodeAction) -> Maybe Text
76145
caTitle (InR CodeAction {_title}) = Just _title
@@ -79,18 +148,17 @@ caTitle _ = Nothing
79148
-- code lens tests
80149

81150
codeLensGoldenTest :: FilePath -> Int -> TestTree
82-
codeLensGoldenTest fp codeLensIdx = goldenWithExplicitImports fp $ \doc -> do
83-
codeLens <- (!! codeLensIdx) <$> getCodeLensesBy isExplicitImports doc
84-
mapM_ executeCmd
85-
[c | CodeLens{_command = Just c} <- [codeLens]]
86-
87-
getCodeLensesBy :: (CodeLens -> Bool) -> TextDocumentIdentifier -> Session [CodeLens]
88-
getCodeLensesBy f doc = filter f <$> getCodeLenses doc
89-
90-
isExplicitImports :: CodeLens -> Bool
91-
isExplicitImports (CodeLens _ (Just (Command _ cmd _)) _)
92-
| ":explicitImports:" `T.isInfixOf` cmd = True
93-
isExplicitImports _ = False
151+
codeLensGoldenTest fp _ = goldenWithExplicitImports " code lens" fp codeActionNoResolveCaps $ \doc -> do
152+
(codeLens: _) <- getCodeLenses doc
153+
CodeLens {_command = Just c} <- resolveCodeLens codeLens
154+
executeCmd c
155+
156+
-- TODO: use the one from lsp-test once that's released
157+
resolveCodeLens :: CodeLens -> Session CodeLens
158+
resolveCodeLens cl = do
159+
resolveResponse <- request SMethod_CodeLensResolve cl
160+
Right resolved <- pure $ resolveResponse ^. L.result
161+
pure resolved
94162

95163
-- Execute command and wait for result
96164
executeCmd :: Command -> Session ()
@@ -102,8 +170,8 @@ executeCmd cmd = do
102170

103171
-- helpers
104172

105-
goldenWithExplicitImports :: FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
106-
goldenWithExplicitImports fp = goldenWithHaskellDoc explicitImportsPlugin (fp <> " (golden)") testDataDir fp "expected" "hs"
173+
goldenWithExplicitImports :: String -> FilePath -> ClientCapabilities -> (TextDocumentIdentifier -> Session ()) -> TestTree
174+
goldenWithExplicitImports title fp caps = goldenWithHaskellAndCaps caps explicitImportsPlugin (fp <> title <> " (golden)") testDataDir fp "expected" "hs"
107175

108176
testDataDir :: String
109177
testDataDir = "test" </> "testdata"

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

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
module B where
2+
3+
b1 :: String
4+
b1 = "b1"
5+
6+
b2 :: String
7+
b2 = "b2"

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

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
{-# OPTIONS_GHC -Wall #-}
2+
module BreakFile whexe
3+
4+
import A ( a1 )
5+
6+
main = putStrLn $ "hello " ++ a1

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

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
{-# OPTIONS_GHC -Wall #-}
2+
module BreakFile where
3+
4+
import A
5+
6+
main = putStrLn $ "hello " ++ a1

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

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
module OnlyThis where
2+
3+
import A ( a1 )
4+
import B
5+
6+
main :: IO ()
7+
main = putStrLn $ "hello " ++ a1 ++ b1

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

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
module OnlyThis where
2+
3+
import A
4+
import B
5+
6+
main :: IO ()
7+
main = putStrLn $ "hello " ++ a1 ++ b1

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

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
{-# OPTIONS_GHC -Wall #-}
2+
module StaleAction where
3+
4+
import A
5+
6+
main = putStrLn $ "hello " ++ a1
7+
8+
testing = undefined

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

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
{-# OPTIONS_GHC -Wall #-}
2+
module StaleAction where
3+
4+
import A
5+
6+
main = putStrLn $ "hello " ++ a1

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module Main where
1+
module UsualCase where
22

33
import A ( a1 )
44

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module Main where
1+
module UsualCase where
22

33
import A
44

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

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,10 @@
1+
12
cradle:
23
direct:
34
arguments:
5+
- OnlyThis.hs
6+
- StaleAction.hs
47
- UsualCase.hs
58
- Exported.hs
69
- A.hs
10+
- B.hs

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ library
3535
, hls-plugin-api == 2.1.0.0
3636
, lsp
3737
, text
38+
, transformers
3839
, unordered-containers
3940

4041
default-language: Haskell2010

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

Lines changed: 12 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,9 @@ import Control.Arrow (Arrow (second))
1515
import Control.DeepSeq (rwhnf)
1616
import Control.Monad (join)
1717
import Control.Monad.IO.Class (liftIO)
18+
import Control.Monad.Trans.Class (lift)
19+
import Control.Monad.Trans.Maybe (MaybeT (MaybeT),
20+
runMaybeT)
1821
import Data.Aeson.Types hiding (Null)
1922
import Data.IORef (readIORef)
2023
import Data.List (intercalate)
@@ -184,28 +187,28 @@ instance Show RefineImportsResult where show _ = "<refineImportsResult>"
184187
instance NFData RefineImportsResult where rnf = rwhnf
185188

186189
refineImportsRule :: Recorder (WithPriority Log) -> Rules ()
187-
refineImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \RefineImports nfp -> do
190+
refineImportsRule recorder = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \RefineImports nfp -> runMaybeT $ do
188191
-- Get the typechecking artifacts from the module
189-
tmr <- use TypeCheck nfp
192+
tmr <- MaybeT $ use TypeCheck nfp
190193
-- We also need a GHC session with all the dependencies
191-
hsc <- use GhcSessionDeps nfp
194+
hsc <- MaybeT $ use GhcSessionDeps nfp
192195

193196
-- 2 layer map ModuleName -> ModuleName -> [Avails] (exports)
194197
import2Map <- do
195198
-- first layer is from current(editing) module to its imports
196-
ImportMap currIm <- use_ GetImportMap nfp
199+
ImportMap currIm <- lift $ use_ GetImportMap nfp
197200
forM currIm $ \path -> do
198201
-- second layer is from the imports of first layer to their imports
199-
ImportMap importIm <- use_ GetImportMap path
202+
ImportMap importIm <- lift $ use_ GetImportMap path
200203
forM importIm $ \imp_path -> do
201-
imp_hir <- use_ GetModIface imp_path
204+
imp_hir <- lift $ use_ GetModIface imp_path
202205
return $ mi_exports $ hirModIface imp_hir
203206

204207
-- Use the GHC api to extract the "minimal" imports
205208
-- We shouldn't blindly refine imports
206209
-- instead we should generate imports statements
207210
-- for modules/symbols actually got used
208-
(imports, mbMinImports) <- liftIO $ extractMinimalImports hsc tmr
211+
(imports, mbMinImports) <- MaybeT $ liftIO $ extractMinimalImports hsc tmr
209212

210213
let filterByImport
211214
:: LImportDecl GhcRn
@@ -259,7 +262,7 @@ refineImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \RefineIm
259262
. Map.toList
260263
$ filteredInnerImports)
261264
-- for every minimal imports
262-
| Just minImports <- [mbMinImports]
265+
| minImports <- [mbMinImports]
263266
, i@(L _ ImportDecl{ideclName = L _ mn}) <- minImports
264267
-- we check for the inner imports
265268
, Just innerImports <- [Map.lookup mn import2Map]
@@ -268,7 +271,7 @@ refineImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \RefineIm
268271
-- if no symbols from this modules then don't need to generate new import
269272
, not $ null filteredInnerImports
270273
]
271-
return ([], RefineImportsResult res <$ mbMinImports)
274+
pure $ RefineImportsResult res
272275

273276
where
274277
-- Check if a name is exposed by AvailInfo (the available information of a module)

0 commit comments

Comments
 (0)