Skip to content

Commit 27f46d7

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

File tree

15 files changed

+385
-202
lines changed

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

0 commit comments

Comments
 (0)