Skip to content

Commit ea3402a

Browse files
AilrunAilrun
committed
Clean up pragmas plugin
1 parent 5f7bf68 commit ea3402a

File tree

3 files changed

+33
-58
lines changed

3 files changed

+33
-58
lines changed

‎plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -18,20 +18,21 @@ extra-source-files:
1818
test/testdata/*.yaml
1919

2020
library
21-
exposed-modules: Ide.Plugin.Pragmas
22-
hs-source-dirs: src
21+
exposed-modules: Ide.Plugin.Pragmas
22+
hs-source-dirs: src
2323
build-depends:
24-
base >=4.12 && <5
24+
, base >=4.12 && <5
2525
, extra
2626
, fuzzy
27-
, ghcide >=1.2 && <1.4
27+
, ghcide >=1.2 && <1.4
2828
, hls-plugin-api ^>=1.1
2929
, lens
3030
, lsp
3131
, text
3232
, transformers
3333
, unordered-containers
34-
default-language: Haskell2010
34+
35+
default-language: Haskell2010
3536

3637
test-suite tests
3738
type: exitcode-stdio-1.0
@@ -43,8 +44,6 @@ test-suite tests
4344
, base
4445
, filepath
4546
, hls-pragmas-plugin
46-
, hls-test-utils ^>=1.0
47+
, hls-test-utils ^>=1.0
4748
, lens
48-
, lsp-test
4949
, lsp-types
50-
, text

‎plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,9 @@
66
{-# LANGUAGE ViewPatterns #-}
77

88
-- | Provides code actions to add missing pragmas (whenever GHC suggests to)
9-
module Ide.Plugin.Pragmas (descriptor) where
9+
module Ide.Plugin.Pragmas
10+
( descriptor
11+
) where
1012

1113
import Control.Applicative ((<|>))
1214
import Control.Lens hiding (List)

‎plugins/hls-pragmas-plugin/test/Main.hs

Lines changed: 23 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,9 @@
1-
{-# LANGUAGE DuplicateRecordFields #-}
2-
{-# LANGUAGE OverloadedStrings #-}
3-
{-# LANGUAGE ScopedTypeVariables #-}
4-
module Main (
5-
main,
6-
) where
1+
{-# LANGUAGE OverloadedStrings #-}
2+
module Main
3+
( main
4+
) where
75

86
import Control.Lens ((^.))
9-
import qualified Data.Text as T
10-
import qualified Data.Text.IO as T
11-
import qualified Data.Text.Lazy as TL
12-
import qualified Data.Text.Lazy.Encoding as TL
137
import qualified Ide.Plugin.Pragmas as Pragmas
148
import qualified Language.LSP.Types.Lens as L
159
import System.FilePath
@@ -31,78 +25,62 @@ tests =
3125
codeActionTests :: TestTree
3226
codeActionTests =
3327
testGroup "code actions"
34-
[ pragmasGolden "adds TypeSynonymInstances pragma" "NeedsPragmas" $ \path -> do
35-
doc <- openDoc path "haskell"
28+
[ goldenWithPragmas "adds TypeSynonymInstances pragma" "NeedsPragmas" $ \doc -> do
3629
_ <- waitForDiagnosticsFromSource doc "typecheck"
3730
cas <- map fromAction <$> getAllCodeActions doc
3831
liftIO $ "Add \"TypeSynonymInstances\"" `elem` map (^. L.title) cas @? "Contains TypeSynonymInstances code action"
3932
liftIO $ "Add \"FlexibleInstances\"" `elem` map (^. L.title) cas @? "Contains FlexibleInstances code action"
4033
executeCodeAction $ head cas
41-
documentContents doc
4234

43-
, pragmasGolden "adds TypeApplications pragma" "TypeApplications" $ \path -> do
44-
doc <- openDoc path "haskell"
35+
, goldenWithPragmas "adds TypeApplications pragma" "TypeApplications" $ \doc -> do
4536
_ <- waitForDiagnosticsFrom doc
4637
cas <- map fromAction <$> getAllCodeActions doc
4738
liftIO $ "Add \"TypeApplications\"" `elem` map (^. L.title) cas @? "Contains TypeApplications code action"
4839
executeCodeAction $ head cas
49-
documentContents doc
5040

51-
, pragmasGolden "no duplication" "NamedFieldPuns" $ \path -> do
52-
doc <- openDoc path "haskell"
41+
, goldenWithPragmas "no duplication" "NamedFieldPuns" $ \doc -> do
5342
_ <- waitForDiagnosticsFrom doc
5443
cas <- map fromAction <$> getCodeActions doc (Range (Position 8 9) (Position 8 9))
5544
liftIO $ length cas == 1 @? "Expected one code action, but got: " <> show cas
5645
let ca = head cas
5746
liftIO $ (ca ^. L.title == "Add \"NamedFieldPuns\"") @? "NamedFieldPuns code action"
5847
executeCodeAction ca
59-
documentContents doc
6048

61-
, pragmasGolden "after shebang" "AfterShebang" $ \path -> do
62-
doc <- openDoc path "haskell"
49+
, goldenWithPragmas "after shebang" "AfterShebang" $ \doc -> do
6350
_ <- waitForDiagnosticsFrom doc
6451
cas <- map fromAction <$> getAllCodeActions doc
6552
liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action"
6653
executeCodeAction $ head cas
67-
documentContents doc
6854

69-
, pragmasGolden "append to existing pragmas" "AppendToExisting" $ \path -> do
70-
doc <- openDoc path "haskell"
55+
, goldenWithPragmas "append to existing pragmas" "AppendToExisting" $ \doc -> do
7156
_ <- waitForDiagnosticsFrom doc
7257
cas <- map fromAction <$> getAllCodeActions doc
7358
liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action"
7459
executeCodeAction $ head cas
75-
documentContents doc
7660

77-
, pragmasGolden "before doc comments" "BeforeDocComment" $ \path -> do
78-
doc <- openDoc path "haskell"
61+
, goldenWithPragmas "before doc comments" "BeforeDocComment" $ \doc -> do
7962
_ <- waitForDiagnosticsFrom doc
8063
cas <- map fromAction <$> getAllCodeActions doc
8164
liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action"
8265
executeCodeAction $ head cas
83-
documentContents doc
8466

85-
, pragmasGolden "before doc comments" "MissingSignatures" $ \path -> do
86-
doc <- openDoc path "haskell"
67+
, goldenWithPragmas "before doc comments" "MissingSignatures" $ \doc -> do
8768
_ <- waitForDiagnosticsFrom doc
8869
cas <- map fromAction <$> getAllCodeActions doc
8970
liftIO $ "Disable \"missing-signatures\" warnings" `elem` map (^. L.title) cas @? "Contains missing-signatures code action"
9071
executeCodeAction $ head cas
91-
documentContents doc
9272

93-
, pragmasGolden "before doc comments" "UnusedImports" $ \path -> do
94-
doc <- openDoc path "haskell"
73+
, goldenWithPragmas "before doc comments" "UnusedImports" $ \doc -> do
9574
_ <- waitForDiagnosticsFrom doc
9675
cas <- map fromAction <$> getAllCodeActions doc
9776
liftIO $ "Disable \"unused-imports\" warnings" `elem` map (^. L.title) cas @? "Contains unused-imports code action"
9877
executeCodeAction $ head cas
99-
documentContents doc
10078
]
10179

10280
completionTests :: TestTree
10381
completionTests =
10482
testGroup "completions"
105-
[ testCase "completes pragmas" $ runSessionWithServer pragmasPlugin testDirectory $ do
83+
[ testCase "completes pragmas" $ runSessionWithServer pragmasPlugin testDataDir $ do
10684
doc <- openDoc "Completion.hs" "haskell"
10785
_ <- waitForDiagnostics
10886
let te = TextEdit (Range (Position 0 4) (Position 0 34)) ""
@@ -115,7 +93,7 @@ completionTests =
11593
item ^. L.insertTextFormat @?= Just Snippet
11694
item ^. L.insertText @?= Just "LANGUAGE ${1:extension} #-}"
11795

118-
, testCase "completes pragmas no close" $ runSessionWithServer pragmasPlugin testDirectory $ do
96+
, testCase "completes pragmas no close" $ runSessionWithServer pragmasPlugin testDataDir $ do
11997
doc <- openDoc "Completion.hs" "haskell"
12098
let te = TextEdit (Range (Position 0 4) (Position 0 24)) ""
12199
_ <- applyEdit doc te
@@ -127,7 +105,7 @@ completionTests =
127105
item ^. L.insertTextFormat @?= Just Snippet
128106
item ^. L.insertText @?= Just "LANGUAGE ${1:extension}"
129107

130-
, testCase "completes options pragma" $ runSessionWithServer pragmasPlugin testDirectory $ do
108+
, testCase "completes options pragma" $ runSessionWithServer pragmasPlugin testDataDir $ do
131109
doc <- openDoc "Completion.hs" "haskell"
132110
_ <- waitForDiagnostics
133111
let te = TextEdit (Range (Position 0 4) (Position 0 34)) "OPTIONS"
@@ -140,7 +118,7 @@ completionTests =
140118
item ^. L.insertTextFormat @?= Just Snippet
141119
item ^. L.insertText @?= Just "OPTIONS_GHC -${1:option} #-}"
142120

143-
, testCase "completes ghc options pragma values" $ runSessionWithServer pragmasPlugin testDirectory $ do
121+
, testCase "completes ghc options pragma values" $ runSessionWithServer pragmasPlugin testDataDir $ do
144122
doc <- openDoc "Completion.hs" "haskell"
145123
let te = TextEdit (Range (Position 0 0) (Position 0 0)) "{-# OPTIONS_GHC -Wno-red #-}\n"
146124
_ <- applyEdit doc te
@@ -152,7 +130,7 @@ completionTests =
152130
item ^. L.insertTextFormat @?= Nothing
153131
item ^. L.insertText @?= Nothing
154132

155-
, testCase "completes language extensions" $ runSessionWithServer pragmasPlugin testDirectory $ do
133+
, testCase "completes language extensions" $ runSessionWithServer pragmasPlugin testDataDir $ do
156134
doc <- openDoc "Completion.hs" "haskell"
157135
_ <- waitForDiagnostics
158136
let te = TextEdit (Range (Position 0 24) (Position 0 31)) ""
@@ -163,7 +141,7 @@ completionTests =
163141
item ^. L.label @?= "OverloadedStrings"
164142
item ^. L.kind @?= Just CiKeyword
165143

166-
, testCase "completes the Strict language extension" $ runSessionWithServer pragmasPlugin testDirectory $ do
144+
, testCase "completes the Strict language extension" $ runSessionWithServer pragmasPlugin testDataDir $ do
167145
doc <- openDoc "Completion.hs" "haskell"
168146
_ <- waitForDiagnostics
169147
let te = TextEdit (Range (Position 0 13) (Position 0 31)) "Str"
@@ -174,7 +152,7 @@ completionTests =
174152
item ^. L.label @?= "Strict"
175153
item ^. L.kind @?= Just CiKeyword
176154

177-
, testCase "completes No- language extensions" $ runSessionWithServer pragmasPlugin testDirectory $ do
155+
, testCase "completes No- language extensions" $ runSessionWithServer pragmasPlugin testDataDir $ do
178156
doc <- openDoc "Completion.hs" "haskell"
179157
_ <- waitForDiagnostics
180158
let te = TextEdit (Range (Position 0 13) (Position 0 31)) "NoOverload"
@@ -186,12 +164,8 @@ completionTests =
186164
item ^. L.kind @?= Just CiKeyword
187165
]
188166

189-
pragmasGolden :: TestName -> FilePath -> (FilePath -> Session T.Text) -> TestTree
190-
pragmasGolden title path action =
191-
goldenGitDiff title (testDirectory </> path <.> "expected.hs")
192-
$ runSessionWithServer pragmasPlugin testDirectory
193-
$ TL.encodeUtf8 . TL.fromStrict
194-
<$> action (path <.> "hs")
167+
goldenWithPragmas :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
168+
goldenWithPragmas title path = goldenWithHaskellDoc pragmasPlugin title testDataDir path "expected" "hs"
195169

196-
testDirectory :: FilePath
197-
testDirectory = "test" </> "testdata"
170+
testDataDir :: FilePath
171+
testDataDir = "test" </> "testdata"

0 commit comments

Comments
 (0)