Skip to content

Commit 548ab88

Browse files
jhrcekjhrcek
committed
Enable pedantic for more components
1 parent 0b0eee3 commit 548ab88

File tree

9 files changed

+70
-83
lines changed

9 files changed

+70
-83
lines changed

Diff for: ‎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,

Diff for: ‎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 (..))

Diff for: ‎haskell-language-server.cabal

+14-16
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,7 +480,7 @@ 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:
@@ -507,7 +505,7 @@ library hls-rename-plugin
507505

508506

509507
test-suite hls-rename-plugin-tests
510-
import: defaults, test-defaults, warnings
508+
import: defaults, pedantic, test-defaults, warnings
511509
type: exitcode-stdio-1.0
512510
hs-source-dirs: plugins/hls-rename-plugin/test
513511
main-is: Main.hs
@@ -593,7 +591,7 @@ common hlint
593591
cpp-options: -Dhls_hlint
594592

595593
library hls-hlint-plugin
596-
import: defaults, warnings, pedantic
594+
import: defaults, pedantic, warnings, pedantic
597595
exposed-modules: Ide.Plugin.Hlint
598596
hs-source-dirs: plugins/hls-hlint-plugin/src
599597
build-depends:
@@ -627,7 +625,7 @@ library hls-hlint-plugin
627625
DataKinds
628626

629627
test-suite hls-hlint-plugin-tests
630-
import: defaults, test-defaults, warnings
628+
import: defaults, pedantic, test-defaults, warnings
631629
type: exitcode-stdio-1.0
632630
hs-source-dirs: plugins/hls-hlint-plugin/test
633631
main-is: Main.hs

Diff for: ‎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

Diff for: ‎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

Diff for: ‎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

Diff for: ‎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

Diff for: ‎plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs

+12-17
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
{-# LANGUAGE OverloadedLabels #-}
55
{-# LANGUAGE OverloadedStrings #-}
66
{-# LANGUAGE RecordWildCards #-}
7+
{-# OPTIONS_GHC -Wno-orphans #-}
78

89
module Ide.Plugin.Rename (descriptor, E.Log) where
910

@@ -61,7 +62,7 @@ descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $ (defaultP
6162
}
6263

6364
renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename
64-
renameProvider state pluginId (RenameParams _prog docId@(TextDocumentIdentifier uri) pos newNameText) = do
65+
renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) pos newNameText) = do
6566
nfp <- getNormalizedFilePathE uri
6667
directOldNames <- getNamesAtPos state nfp pos
6768
directRefs <- concat <$> mapM (refsAtName state nfp) directOldNames
@@ -70,8 +71,8 @@ renameProvider state pluginId (RenameParams _prog docId@(TextDocumentIdentifier
7071
indirect references through punned names. To find the transitive closure, we do a pass of
7172
the direct references to find the references for any punned names.
7273
See the `IndirectPuns` test for an example. -}
73-
indirectOldNames <- concat . filter ((>1) . Prelude.length) <$>
74-
mapM (uncurry (getNamesAtPos state) . locToFilePos) directRefs
74+
indirectOldNames <- concat . filter notNull <$>
75+
mapM (uncurry (getNamesAtPos state)) (mapMaybe locToFilePos directRefs)
7576
let oldNames = filter matchesDirect indirectOldNames ++ directOldNames
7677
matchesDirect n = occNameFS (nameOccName n) `elem` directFS
7778
where
@@ -127,8 +128,8 @@ getSrcEdit state verTxtDocId updatePs = do
127128
nfp <- getNormalizedFilePathE (verTxtDocId ^. L.uri)
128129
annAst <- runActionE "Rename.GetAnnotatedParsedSource" state
129130
(useE GetAnnotatedParsedSource nfp)
130-
let (ps, anns) = (astA annAst, annsA annAst)
131-
let src = T.pack $ exactPrint ps
131+
let ps = astA annAst
132+
src = T.pack $ exactPrint ps
132133
res = T.pack $ exactPrint (updatePs ps)
133134
pure $ diffText ccs (verTxtDocId, src) res IncludeDeletions
134135

@@ -142,7 +143,7 @@ replaceRefs newName refs = everywhere $
142143
-- there has to be a better way...
143144
mkT (replaceLoc @AnnListItem) `extT`
144145
-- replaceLoc @AnnList `extT` -- not needed
145-
-- replaceLoc @AnnParen `extT` -- not needed
146+
-- replaceLoc @AnnParen `extT` -- not needed
146147
-- replaceLoc @AnnPragma `extT` -- not needed
147148
-- replaceLoc @AnnContext `extT` -- not needed
148149
-- replaceLoc @NoEpAnns `extT` -- not needed
@@ -187,8 +188,8 @@ refsAtName state nfp name = do
187188

188189
nameLocs :: Name -> (HieAstResult, PositionMapping) -> [Location]
189190
nameLocs name (HAR _ _ rm _ _, pm) =
190-
mapMaybe (toCurrentLocation pm . realSrcSpanToLocation . fst)
191-
(concat $ M.lookup (Right name) rm)
191+
concatMap (mapMaybe (toCurrentLocation pm . realSrcSpanToLocation . fst))
192+
(M.lookup (Right name) rm)
192193

193194
---------------------------------------------------------------------------------------------------
194195
-- Util
@@ -223,22 +224,16 @@ collectWith f = map (\a -> (f $ head a, HS.fromList a)) . groupOn f . HS.toList
223224
locToUri :: Location -> Uri
224225
locToUri (Location uri _) = uri
225226

226-
nfpToUri :: NormalizedFilePath -> Uri
227-
nfpToUri = filePathToUri . fromNormalizedFilePath
228-
229-
showName :: Name -> String
230-
showName = occNameString . getOccName
231-
232227
unsafeSrcSpanToLoc :: SrcSpan -> Location
233228
unsafeSrcSpanToLoc srcSpan =
234229
case srcSpanToLocation srcSpan of
235230
Nothing -> error "Invalid conversion from UnhelpfulSpan to Location"
236231
Just location -> location
237232

238-
locToFilePos :: Location -> (NormalizedFilePath, Position)
239-
locToFilePos (Location uri (Range pos _)) = (nfp, pos)
233+
locToFilePos :: Location -> Maybe (NormalizedFilePath, Position)
234+
locToFilePos (Location uri (Range pos _)) = (,pos) <$> nfp
240235
where
241-
Just nfp = (uriToNormalizedFilePath . toNormalizedUri) uri
236+
nfp = uriToNormalizedFilePath $ toNormalizedUri uri
242237

243238
replaceModName :: Name -> Maybe ModuleName -> Module
244239
replaceModName name mbModName =

0 commit comments

Comments
 (0)