Skip to content

Commit e37ec7d

Browse files
jhrcekjhrcek
authored
Enable pedantic for more components (#4061)
1 parent b115dc3 commit e37ec7d

File tree

13 files changed

+80
-96
lines changed

13 files changed

+80
-96
lines changed

‎.hlint.yaml

-1
Original file line numberDiff line numberDiff line change
@@ -107,7 +107,6 @@
107107
- Ide.Plugin.Eval.Util
108108
- Ide.Plugin.Floskell
109109
- Ide.Plugin.ModuleName
110-
- Ide.Plugin.Rename
111110
- Ide.Plugin.Class.ExactPrint
112111
- TExpectedActual
113112
- TRigidType

‎cabal.project

+1-3
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ benchmarks: True
1919
write-ghc-environment-files: never
2020

2121
-- Many of our tests only work single-threaded, and the only way to
22-
-- ensure tasty runs everything purely single-threaded is to pass
22+
-- ensure tasty runs everything purely single-threaded is to pass
2323
-- this at the top-level
2424
test-options: -j1
2525

@@ -72,5 +72,3 @@ if impl(ghc >= 9.7)
7272
-- this is okay
7373
allow-newer:
7474
ekg-core:text,
75-
-- https://github.com/haskell-primitive/primitive-unlifted/issues/39
76-
primitive-unlifted:bytestring,

‎ghcide/src/Development/IDE/Spans/AtPoint.hs

+4-4
Original file line numberDiff line numberDiff line change
@@ -95,10 +95,10 @@ foiReferencesAtPoint file pos (FOIReferences asts) =
9595
adjustedLocs = HM.foldr go [] asts
9696
go (HAR _ _ rf tr _, goMapping) xs = refs ++ typerefs ++ xs
9797
where
98-
refs = mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation . fst)
99-
$ concat $ mapMaybe (\n -> M.lookup (Right n) rf) names
100-
typerefs = mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation)
101-
$ concat $ mapMaybe (`M.lookup` tr) names
98+
refs = concatMap (mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation . fst))
99+
(mapMaybe (\n -> M.lookup (Right n) rf) names)
100+
typerefs = concatMap (mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation))
101+
(mapMaybe (`M.lookup` tr) names)
102102
in (names, adjustedLocs,map fromNormalizedFilePath $ HM.keys asts)
103103

104104
getNamesAtPoint :: HieASTs a -> Position -> PositionMapping -> [Name]

‎ghcide/test/exe/DiagnosticTests.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ import Language.LSP.Test
3131
import System.Directory
3232
import System.FilePath
3333
import System.IO.Extra hiding (withTempDir)
34-
-- import Test.QuickCheck.Instances ()
34+
3535
import Control.Lens ((^.))
3636
import Control.Monad.Extra (whenJust)
3737
import Development.IDE.Plugin.Test (WaitForIdeRuleResult (..))

‎ghcide/test/exe/TestUtils.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -290,7 +290,7 @@ checkDefs (defToLocation -> defs) mkExpectations = traverse_ check =<< mkExpecta
290290

291291
assertOneDefinitionFound :: [Location] -> Session Location
292292
assertOneDefinitionFound [def] = pure def
293-
assertOneDefinitionFound _ = liftIO $ assertFailure "Expecting exactly one definition"
293+
assertOneDefinitionFound xs = liftIO . assertFailure $ "Expecting exactly one definition, got " <> show (length xs)
294294

295295
assertRangeCorrect Location{_range = foundRange} expectedRange =
296296
liftIO $ expectedRange @=? foundRange

‎haskell-language-server.cabal

+14-17
Original file line numberDiff line numberDiff line change
@@ -105,7 +105,7 @@ flag isolateCabalfmtTests
105105
manual: True
106106

107107
library hls-cabal-fmt-plugin
108-
import: defaults, warnings
108+
import: defaults, pedantic, warnings
109109
exposed-modules: Ide.Plugin.CabalFmt
110110
hs-source-dirs: plugins/hls-cabal-fmt-plugin/src
111111
build-depends:
@@ -121,7 +121,7 @@ library hls-cabal-fmt-plugin
121121
, text
122122

123123
test-suite hls-cabal-fmt-plugin-tests
124-
import: defaults, test-defaults, warnings
124+
import: defaults, pedantic, test-defaults, warnings
125125
type: exitcode-stdio-1.0
126126
hs-source-dirs: plugins/hls-cabal-fmt-plugin/test
127127
main-is: Main.hs
@@ -150,7 +150,7 @@ common cabal
150150
cpp-options: -Dhls_cabal
151151

152152
library hls-cabal-plugin
153-
import: defaults, warnings
153+
import: defaults, pedantic, warnings
154154
exposed-modules:
155155
Ide.Plugin.Cabal
156156
Ide.Plugin.Cabal.Diagnostics
@@ -193,7 +193,7 @@ library hls-cabal-plugin
193193
hs-source-dirs: plugins/hls-cabal-plugin/src
194194

195195
test-suite hls-cabal-plugin-tests
196-
import: defaults, test-defaults, warnings
196+
import: defaults, pedantic, test-defaults, warnings
197197
type: exitcode-stdio-1.0
198198
hs-source-dirs: plugins/hls-cabal-plugin/test
199199
main-is: Main.hs
@@ -210,7 +210,6 @@ test-suite hls-cabal-plugin-tests
210210
, haskell-language-server:hls-cabal-plugin
211211
, hls-test-utils == 2.6.0.0
212212
, lens
213-
, lsp
214213
, lsp-types
215214
, text
216215
, text-rope
@@ -232,7 +231,7 @@ common class
232231
cpp-options: -Dhls_class
233232

234233
library hls-class-plugin
235-
import: defaults, warnings
234+
import: defaults, pedantic, warnings
236235
exposed-modules: Ide.Plugin.Class
237236
other-modules: Ide.Plugin.Class.CodeAction
238237
, Ide.Plugin.Class.CodeLens
@@ -262,14 +261,13 @@ library hls-class-plugin
262261
OverloadedStrings
263262

264263
test-suite hls-class-plugin-tests
265-
import: defaults, test-defaults, warnings
264+
import: defaults, pedantic, test-defaults, warnings
266265
type: exitcode-stdio-1.0
267266
hs-source-dirs: plugins/hls-class-plugin/test
268267
main-is: Main.hs
269268
build-depends:
270269
, base
271270
, filepath
272-
, ghcide
273271
, haskell-language-server:hls-class-plugin
274272
, hls-test-utils == 2.6.0.0
275273
, lens
@@ -292,7 +290,7 @@ common callHierarchy
292290
cpp-options: -Dhls_callHierarchy
293291

294292
library hls-call-hierarchy-plugin
295-
import: defaults, warnings
293+
import: defaults, pedantic, warnings
296294
buildable: True
297295
exposed-modules: Ide.Plugin.CallHierarchy
298296
other-modules:
@@ -317,7 +315,7 @@ library hls-call-hierarchy-plugin
317315
default-extensions: DataKinds
318316

319317
test-suite hls-call-hierarchy-plugin-tests
320-
import: defaults, test-defaults, warnings
318+
import: defaults, pedantic, test-defaults, warnings
321319
type: exitcode-stdio-1.0
322320
hs-source-dirs: plugins/hls-call-hierarchy-plugin/test
323321
main-is: Main.hs
@@ -350,7 +348,7 @@ common eval
350348
cpp-options: -Dhls_eval
351349

352350
library hls-eval-plugin
353-
import: defaults, warnings, pedantic
351+
import: defaults, pedantic, warnings
354352
exposed-modules:
355353
Ide.Plugin.Eval
356354
Ide.Plugin.Eval.Types
@@ -396,7 +394,7 @@ library hls-eval-plugin
396394
DataKinds
397395

398396
test-suite hls-eval-plugin-tests
399-
import: defaults, test-defaults, warnings
397+
import: defaults, pedantic, test-defaults, warnings
400398
type: exitcode-stdio-1.0
401399
hs-source-dirs: plugins/hls-eval-plugin/test
402400
main-is: Main.hs
@@ -482,13 +480,12 @@ common rename
482480
cpp-options: -Dhls_rename
483481

484482
library hls-rename-plugin
485-
import: defaults, warnings
483+
import: defaults, pedantic, warnings
486484
exposed-modules: Ide.Plugin.Rename
487485
hs-source-dirs: plugins/hls-rename-plugin/src
488486
build-depends:
489487
, base >=4.12 && <5
490488
, containers
491-
, extra
492489
, ghcide == 2.6.0.0
493490
, hashable
494491
, hiedb
@@ -507,7 +504,7 @@ library hls-rename-plugin
507504

508505

509506
test-suite hls-rename-plugin-tests
510-
import: defaults, test-defaults, warnings
507+
import: defaults, pedantic, test-defaults, warnings
511508
type: exitcode-stdio-1.0
512509
hs-source-dirs: plugins/hls-rename-plugin/test
513510
main-is: Main.hs
@@ -593,7 +590,7 @@ common hlint
593590
cpp-options: -Dhls_hlint
594591

595592
library hls-hlint-plugin
596-
import: defaults, warnings, pedantic
593+
import: defaults, pedantic, warnings, pedantic
597594
exposed-modules: Ide.Plugin.Hlint
598595
hs-source-dirs: plugins/hls-hlint-plugin/src
599596
build-depends:
@@ -627,7 +624,7 @@ library hls-hlint-plugin
627624
DataKinds
628625

629626
test-suite hls-hlint-plugin-tests
630-
import: defaults, test-defaults, warnings
627+
import: defaults, pedantic, test-defaults, warnings
631628
type: exitcode-stdio-1.0
632629
hs-source-dirs: plugins/hls-hlint-plugin/test
633630
main-is: Main.hs

‎hls-plugin-api/src/Ide/Plugin/Properties.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,7 @@ data SomePropertyKeyWithMetaData
101101
SomePropertyKeyWithMetaData (SPropertyKey k) (MetaData t)
102102

103103
-- | 'Properties' is a partial implementation of json schema, without supporting union types and validation.
104-
-- In hls, it defines a set of properties which used in dedicated configuration of a plugin.
104+
-- In hls, it defines a set of properties used in dedicated configuration of a plugin.
105105
-- A property is an immediate child of the json object in each plugin's "config" section.
106106
-- It was designed to be compatible with vscode's settings UI.
107107
-- Use 'emptyProperties' and 'useProperty' to create and consume 'Properties'.

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs

-1
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,6 @@ import qualified Data.Text.Utf16.Lines as Rope (Position
1414
import Data.Text.Utf16.Rope.Mixed (Rope)
1515
import qualified Data.Text.Utf16.Rope.Mixed as Rope
1616
import Development.IDE as D
17-
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
1817
import qualified Development.IDE.Plugin.Completions.Types as Ghcide
1918
import Ide.Plugin.Cabal.Completion.Completer.Simple
2019
import Ide.Plugin.Cabal.Completion.Completer.Snippet

‎plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs

-4
Original file line numberDiff line numberDiff line change
@@ -165,10 +165,6 @@ mkSymbol = \case
165165
-------------- Incoming calls and outgoing calls ---------------------
166166
----------------------------------------------------------------------
167167

168-
#if !MIN_VERSION_aeson(1,5,2)
169-
deriving instance Ord Value
170-
#endif
171-
172168
-- | Render incoming calls request.
173169
incomingCalls :: PluginMethodHandler IdeState Method_CallHierarchyIncomingCalls
174170
incomingCalls state _pluginId param = do

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

+38-34
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,6 @@
22
{-# LANGUAGE OverloadedLabels #-}
33
{-# LANGUAGE OverloadedLists #-}
44
{-# LANGUAGE OverloadedStrings #-}
5-
{-# OPTIONS_GHC -Wall #-}
6-
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
75

86
module Main
97
( main
@@ -13,10 +11,10 @@ import Control.Exception (catch)
1311
import Control.Lens (Prism', prism', view, (^.),
1412
(^..), (^?))
1513
import Control.Monad (void)
14+
import Data.Foldable (find)
1615
import Data.Maybe
1716
import Data.Row ((.==))
1817
import qualified Data.Text as T
19-
import Development.IDE.Core.Compile (sourceTypecheck)
2018
import qualified Ide.Plugin.Class as Class
2119
import qualified Language.LSP.Protocol.Lens as L
2220
import Language.LSP.Protocol.Message
@@ -47,35 +45,35 @@ codeActionTests = testGroup
4745
, "Add placeholders for all missing methods"
4846
, "Add placeholders for all missing methods with signature(s)"
4947
]
50-
, goldenWithClass "Creates a placeholder for '=='" "T1" "eq" $ \(eqAction:_) -> do
51-
executeCodeAction eqAction
52-
, goldenWithClass "Creates a placeholder for '/='" "T1" "ne" $ \(_:_:neAction:_) -> do
53-
executeCodeAction neAction
54-
, goldenWithClass "Creates a placeholder for both '==' and '/='" "T1" "all" $ \(_:_:_:_:allMethodsAction:_) -> do
55-
executeCodeAction allMethodsAction
56-
, goldenWithClass "Creates a placeholder for 'fmap'" "T2" "fmap" $ \(_:_:_:_:_:_:fmapAction:_) -> do
57-
executeCodeAction fmapAction
58-
, goldenWithClass "Creates a placeholder for multiple methods 1" "T3" "1" $ \(mmAction:_) -> do
59-
executeCodeAction mmAction
60-
, goldenWithClass "Creates a placeholder for multiple methods 2" "T3" "2" $ \(_:_:mmAction:_) -> do
61-
executeCodeAction mmAction
62-
, goldenWithClass "Creates a placeholder for a method starting with '_'" "T4" "" $ \(_fAction:_) -> do
63-
executeCodeAction _fAction
64-
, goldenWithClass "Creates a placeholder for '==' with extra lines" "T5" "" $ \(eqAction:_) -> do
65-
executeCodeAction eqAction
66-
, goldenWithClass "Creates a placeholder for only the unimplemented methods of multiple methods" "T6" "1" $ \(gAction:_) -> do
67-
executeCodeAction gAction
68-
, goldenWithClass "Creates a placeholder for other two methods" "T6" "2" $ \(_:_:ghAction:_) -> do
69-
executeCodeAction ghAction
48+
, goldenWithClass "Creates a placeholder for '=='" "T1" "eq" $
49+
getActionByTitle "Add placeholders for '=='"
50+
, goldenWithClass "Creates a placeholder for '/='" "T1" "ne" $
51+
getActionByTitle "Add placeholders for '/='"
52+
, goldenWithClass "Creates a placeholder for both '==' and '/='" "T1" "all" $
53+
getActionByTitle "Add placeholders for all missing methods"
54+
, goldenWithClass "Creates a placeholder for 'fmap'" "T2" "fmap" $
55+
getActionByTitle "Add placeholders for 'fmap'"
56+
, goldenWithClass "Creates a placeholder for multiple methods 1" "T3" "1" $
57+
getActionByTitle "Add placeholders for 'f','g'"
58+
, goldenWithClass "Creates a placeholder for multiple methods 2" "T3" "2" $
59+
getActionByTitle "Add placeholders for 'g','h'"
60+
, goldenWithClass "Creates a placeholder for a method starting with '_'" "T4" "" $
61+
getActionByTitle "Add placeholders for '_f'"
62+
, goldenWithClass "Creates a placeholder for '==' with extra lines" "T5" "" $
63+
getActionByTitle "Add placeholders for '=='"
64+
, goldenWithClass "Creates a placeholder for only the unimplemented methods of multiple methods" "T6" "1" $
65+
getActionByTitle "Add placeholders for 'g'"
66+
, goldenWithClass "Creates a placeholder for other two methods" "T6" "2" $
67+
getActionByTitle "Add placeholders for 'g','h'"
7068
, onlyRunForGhcVersions [GHC92, GHC94] "Only ghc-9.2+ enabled GHC2021 implicitly" $
71-
goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $ \(_:eqWithSig:_) -> do
72-
executeCodeAction eqWithSig
73-
, goldenWithClass "Insert pragma if not exist" "InsertWithoutPragma" "" $ \(_:eqWithSig:_) -> do
74-
executeCodeAction eqWithSig
75-
, goldenWithClass "Don't insert pragma if exist" "InsertWithPragma" "" $ \(_:eqWithSig:_) -> do
76-
executeCodeAction eqWithSig
77-
, goldenWithClass "Only insert pragma once" "InsertPragmaOnce" "" $ \(_:multi:_) -> do
78-
executeCodeAction multi
69+
goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $
70+
getActionByTitle "Add placeholders for '==' with signature(s)"
71+
, goldenWithClass "Insert pragma if not exist" "InsertWithoutPragma" "" $
72+
getActionByTitle "Add placeholders for '==' with signature(s)"
73+
, goldenWithClass "Don't insert pragma if exist" "InsertWithPragma" "" $
74+
getActionByTitle "Add placeholders for '==' with signature(s)"
75+
, goldenWithClass "Only insert pragma once" "InsertPragmaOnce" "" $
76+
getActionByTitle "Add placeholders for 'pure','<*>' with signature(s)"
7977
, expectCodeActionsAvailable "No code action available when minimal requirements meet" "MinimalDefinitionMeet" []
8078
, expectCodeActionsAvailable "Add placeholders for all missing methods is unavailable when all methods are required" "AllMethodsRequired"
8179
[ "Add placeholders for 'f','g'"
@@ -162,14 +160,20 @@ goldenCodeLens title path idx =
162160
executeCommand $ fromJust $ (lens !! idx) ^. L.command
163161
void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit)
164162

165-
goldenWithClass ::TestName -> FilePath -> FilePath -> ([CodeAction] -> Session ()) -> TestTree
166-
goldenWithClass title path desc act =
163+
goldenWithClass ::TestName -> FilePath -> FilePath -> ([CodeAction] -> Session CodeAction) -> TestTree
164+
goldenWithClass title path desc findAction =
167165
goldenWithHaskellDoc def classPlugin title testDataDir path (desc <.> "expected") "hs" $ \doc -> do
168166
_ <- waitForDiagnosticsFrom doc
169167
actions <- concatMap (^.. _CACodeAction) <$> getAllCodeActions doc
170-
act actions
168+
action <- findAction actions
169+
executeCodeAction action
171170
void $ skipManyTill anyMessage (getDocumentEdit doc)
172171

172+
getActionByTitle :: T.Text -> [CodeAction] -> Session CodeAction
173+
getActionByTitle title actions = case find (\a -> a ^. L.title == title) actions of
174+
Just a -> pure a
175+
Nothing -> liftIO $ assertFailure $ "Action " <> show title <> " not found in " <> show [a ^. L.title | a <- actions]
176+
173177
expectCodeActionsAvailable :: TestName -> FilePath -> [T.Text] -> TestTree
174178
expectCodeActionsAvailable title path actionTitles =
175179
testCase title $ do

‎plugins/hls-qualify-imported-names-plugin/test/Main.hs

-3
Original file line numberDiff line numberDiff line change
@@ -38,9 +38,6 @@ makePoint line column
3838
| line >= 1 && column >= 1 = Point line column
3939
| otherwise = error "Line or column is less than 1."
4040

41-
isNotEmpty :: Foldable f => f a -> Bool
42-
isNotEmpty = not . isEmpty
43-
4441
isEmpty :: Foldable f => f a -> Bool
4542
isEmpty = null
4643

0 commit comments

Comments
 (0)