Enable pedantic for more components

.hlint.yaml

@@ -107,7 +107,6 @@
  - Ide.Plugin.Eval.Util
  - Ide.Plugin.Floskell
  - Ide.Plugin.ModuleName
- - Ide.Plugin.Rename
  - Ide.Plugin.Class.ExactPrint
  - TExpectedActual
  - TRigidType

cabal.project

@@ -19,7 +19,7 @@ benchmarks: True
 write-ghc-environment-files: never
 
 -- Many of our tests only work single-threaded, and the only way to
--- ensure tasty runs everything purely single-threaded is to pass 
+-- ensure tasty runs everything purely single-threaded is to pass
 -- this at the top-level
 test-options: -j1
 
@@ -72,5 +72,3 @@ if impl(ghc >= 9.7)
  -- this is okay
  allow-newer:
  ekg-core:text,
- -- https:/haskell-primitive/primitive-unlifted/issues/39
- primitive-unlifted:bytestring,

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

@@ -95,10 +95,10 @@ foiReferencesAtPoint file pos (FOIReferences asts) =
  adjustedLocs = HM.foldr go [] asts
  go (HAR _ _ rf tr _, goMapping) xs = refs ++ typerefs ++ xs
  where
- refs = mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation . fst)
- $ concat $ mapMaybe (\n -> M.lookup (Right n) rf) names
- typerefs = mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation)
- $ concat $ mapMaybe (`M.lookup` tr) names
+ refs = concatMap (mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation . fst))
+  (mapMaybe (\n -> M.lookup (Right n) rf) names)
+ typerefs = concatMap (mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation))
+  (mapMaybe (`M.lookup` tr) names)
  in (names, adjustedLocs,map fromNormalizedFilePath $ HM.keys asts)
 
 getNamesAtPoint :: HieASTs a -> Position -> PositionMapping -> [Name]

ghcide/test/exe/DiagnosticTests.hs

@@ -31,7 +31,7 @@ import Language.LSP.Test
 import System.Directory
 import System.FilePath
 import System.IO.Extra hiding (withTempDir)
--- import Test.QuickCheck.Instances ()
+
 import Control.Lens ((^.))
 import Control.Monad.Extra (whenJust)
 import Development.IDE.Plugin.Test (WaitForIdeRuleResult (..))

ghcide/test/exe/TestUtils.hs

@@ -290,7 +290,7 @@ checkDefs (defToLocation -> defs) mkExpectations = traverse_ check =<< mkExpecta
 
  assertOneDefinitionFound :: [Location] -> Session Location
  assertOneDefinitionFound [def] = pure def
- assertOneDefinitionFound _ = liftIO $ assertFailure "Expecting exactly one definition"
+ assertOneDefinitionFound xs = liftIO . assertFailure $ "Expecting exactly one definition, got " <> show (length xs)
 
  assertRangeCorrect Location{_range = foundRange} expectedRange =
  liftIO $ expectedRange @=? foundRange

haskell-language-server.cabal

@@ -105,7 +105,7 @@ flag isolateCabalfmtTests
  manual: True
 
 library hls-cabal-fmt-plugin
- import: defaults, warnings
+ import: defaults, pedantic, warnings
  exposed-modules: Ide.Plugin.CabalFmt
  hs-source-dirs: plugins/hls-cabal-fmt-plugin/src
  build-depends:
@@ -121,7 +121,7 @@ library hls-cabal-fmt-plugin
  , text
 
 test-suite hls-cabal-fmt-plugin-tests
- import: defaults, test-defaults, warnings
+ import: defaults, pedantic, test-defaults, warnings
  type: exitcode-stdio-1.0
  hs-source-dirs: plugins/hls-cabal-fmt-plugin/test
  main-is: Main.hs
@@ -150,7 +150,7 @@ common cabal
  cpp-options: -Dhls_cabal
 
 library hls-cabal-plugin
- import: defaults, warnings
+ import: defaults, pedantic, warnings
  exposed-modules:
  Ide.Plugin.Cabal
  Ide.Plugin.Cabal.Diagnostics
@@ -193,7 +193,7 @@ library hls-cabal-plugin
  hs-source-dirs: plugins/hls-cabal-plugin/src
 
 test-suite hls-cabal-plugin-tests
- import: defaults, test-defaults, warnings
+ import: defaults, pedantic, test-defaults, warnings
  type: exitcode-stdio-1.0
  hs-source-dirs: plugins/hls-cabal-plugin/test
  main-is: Main.hs
@@ -210,7 +210,6 @@ test-suite hls-cabal-plugin-tests
  , haskell-language-server:hls-cabal-plugin
  , hls-test-utils == 2.6.0.0
  , lens
- , lsp
  , lsp-types
  , text
  , text-rope
@@ -232,7 +231,7 @@ common class
  cpp-options: -Dhls_class
 
 library hls-class-plugin
- import: defaults, warnings
+ import: defaults, pedantic, warnings
  exposed-modules: Ide.Plugin.Class
  other-modules: Ide.Plugin.Class.CodeAction
  , Ide.Plugin.Class.CodeLens
@@ -262,14 +261,13 @@ library hls-class-plugin
  OverloadedStrings
 
 test-suite hls-class-plugin-tests
- import: defaults, test-defaults, warnings
+ import: defaults, pedantic, test-defaults, warnings
  type: exitcode-stdio-1.0
  hs-source-dirs: plugins/hls-class-plugin/test
  main-is: Main.hs
  build-depends:
  , base
  , filepath
- , ghcide
  , haskell-language-server:hls-class-plugin
  , hls-test-utils == 2.6.0.0
  , lens
@@ -292,7 +290,7 @@ common callHierarchy
  cpp-options: -Dhls_callHierarchy
 
 library hls-call-hierarchy-plugin
- import: defaults, warnings
+ import: defaults, pedantic, warnings
  buildable: True
  exposed-modules: Ide.Plugin.CallHierarchy
  other-modules:
@@ -317,7 +315,7 @@ library hls-call-hierarchy-plugin
  default-extensions: DataKinds
 
 test-suite hls-call-hierarchy-plugin-tests
- import: defaults, test-defaults, warnings
+ import: defaults, pedantic, test-defaults, warnings
  type: exitcode-stdio-1.0
  hs-source-dirs: plugins/hls-call-hierarchy-plugin/test
  main-is: Main.hs
@@ -350,7 +348,7 @@ common eval
  cpp-options: -Dhls_eval
 
 library hls-eval-plugin
- import: defaults, warnings, pedantic
+ import: defaults, pedantic, warnings
  exposed-modules:
  Ide.Plugin.Eval
  Ide.Plugin.Eval.Types
@@ -396,7 +394,7 @@ library hls-eval-plugin
  DataKinds
 
 test-suite hls-eval-plugin-tests
- import: defaults, test-defaults, warnings
+ import: defaults, pedantic, test-defaults, warnings
  type: exitcode-stdio-1.0
  hs-source-dirs: plugins/hls-eval-plugin/test
  main-is: Main.hs
@@ -482,13 +480,12 @@ common rename
  cpp-options: -Dhls_rename
 
 library hls-rename-plugin
- import: defaults, warnings
+ import: defaults, pedantic, warnings
  exposed-modules: Ide.Plugin.Rename
  hs-source-dirs: plugins/hls-rename-plugin/src
  build-depends:
  , base >=4.12 && <5
  , containers
- , extra
  , ghcide == 2.6.0.0
  , hashable
  , hiedb
@@ -507,7 +504,7 @@ library hls-rename-plugin
 
 
 test-suite hls-rename-plugin-tests
- import: defaults, test-defaults, warnings
+ import: defaults, pedantic, test-defaults, warnings
  type: exitcode-stdio-1.0
  hs-source-dirs: plugins/hls-rename-plugin/test
  main-is: Main.hs
@@ -593,7 +590,7 @@ common hlint
  cpp-options: -Dhls_hlint
 
 library hls-hlint-plugin
- import: defaults, warnings, pedantic
+ import: defaults, pedantic, warnings, pedantic
  exposed-modules: Ide.Plugin.Hlint
  hs-source-dirs: plugins/hls-hlint-plugin/src
  build-depends:
@@ -627,7 +624,7 @@ library hls-hlint-plugin
  DataKinds
 
 test-suite hls-hlint-plugin-tests
- import: defaults, test-defaults, warnings
+ import: defaults, pedantic, test-defaults, warnings
  type: exitcode-stdio-1.0
  hs-source-dirs: plugins/hls-hlint-plugin/test
  main-is: Main.hs

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

@@ -101,7 +101,7 @@ data SomePropertyKeyWithMetaData
  SomePropertyKeyWithMetaData (SPropertyKey k) (MetaData t)
 
 -- | 'Properties' is a partial implementation of json schema, without supporting union types and validation.
--- In hls, it defines a set of properties which used in dedicated configuration of a plugin.
+-- In hls, it defines a set of properties used in dedicated configuration of a plugin.
 -- A property is an immediate child of the json object in each plugin's "config" section.
 -- It was designed to be compatible with vscode's settings UI.
 -- Use 'emptyProperties' and 'useProperty' to create and consume 'Properties'.

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

@@ -14,7 +14,6 @@ import qualified Data.Text.Utf16.Lines as Rope (Position
 import Data.Text.Utf16.Rope.Mixed (Rope)
 import qualified Data.Text.Utf16.Rope.Mixed as Rope
 import Development.IDE as D
-import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
 import qualified Development.IDE.Plugin.Completions.Types as Ghcide
 import Ide.Plugin.Cabal.Completion.Completer.Simple
 import Ide.Plugin.Cabal.Completion.Completer.Snippet

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

@@ -165,10 +165,6 @@ mkSymbol = \case
 -------------- Incoming calls and outgoing calls ---------------------
 ----------------------------------------------------------------------
 
-#if !MIN_VERSION_aeson(1,5,2)
-deriving instance Ord Value
-#endif
-
 -- | Render incoming calls request.
 incomingCalls :: PluginMethodHandler IdeState Method_CallHierarchyIncomingCalls
 incomingCalls state _pluginId param = do

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

@@ -2,8 +2,6 @@
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -Wall #-}
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 module Main
  ( main
@@ -13,10 +11,10 @@ import Control.Exception (catch)
 import Control.Lens (Prism', prism', view, (^.),
  (^..), (^?))
 import Control.Monad (void)
+import Data.Foldable (find)
 import Data.Maybe
 import Data.Row ((.==))
 import qualified Data.Text as T
-import Development.IDE.Core.Compile (sourceTypecheck)
 import qualified Ide.Plugin.Class as Class
 import qualified Language.LSP.Protocol.Lens as L
 import Language.LSP.Protocol.Message
@@ -47,35 +45,35 @@ codeActionTests = testGroup
  , "Add placeholders for all missing methods"
  , "Add placeholders for all missing methods with signature(s)"
  ]
- , goldenWithClass "Creates a placeholder for '=='" "T1" "eq" $ \(eqAction:_) -> do
- executeCodeAction eqAction
- , goldenWithClass "Creates a placeholder for '/='" "T1" "ne" $ \(_:_:neAction:_) -> do
- executeCodeAction neAction
- , goldenWithClass "Creates a placeholder for both '==' and '/='" "T1" "all" $ \(_:_:_:_:allMethodsAction:_) -> do
- executeCodeAction allMethodsAction
- , goldenWithClass "Creates a placeholder for 'fmap'" "T2" "fmap" $ \(_:_:_:_:_:_:fmapAction:_) -> do
- executeCodeAction fmapAction
- , goldenWithClass "Creates a placeholder for multiple methods 1" "T3" "1" $ \(mmAction:_) -> do
- executeCodeAction mmAction
- , goldenWithClass "Creates a placeholder for multiple methods 2" "T3" "2" $ \(_:_:mmAction:_) -> do
- executeCodeAction mmAction
- , goldenWithClass "Creates a placeholder for a method starting with '_'" "T4" "" $ \(_fAction:_) -> do
- executeCodeAction _fAction
- , goldenWithClass "Creates a placeholder for '==' with extra lines" "T5" "" $ \(eqAction:_) -> do
- executeCodeAction eqAction
- , goldenWithClass "Creates a placeholder for only the unimplemented methods of multiple methods" "T6" "1" $ \(gAction:_) -> do
- executeCodeAction gAction
- , goldenWithClass "Creates a placeholder for other two methods" "T6" "2" $ \(_:_:ghAction:_) -> do
- executeCodeAction ghAction
+ , goldenWithClass "Creates a placeholder for '=='" "T1" "eq" $
+ getActionByTitle "Add placeholders for '=='"
+ , goldenWithClass "Creates a placeholder for '/='" "T1" "ne" $
+ getActionByTitle "Add placeholders for '/='"
+ , goldenWithClass "Creates a placeholder for both '==' and '/='" "T1" "all" $
+ getActionByTitle "Add placeholders for all missing methods"
+ , goldenWithClass "Creates a placeholder for 'fmap'" "T2" "fmap" $
+ getActionByTitle "Add placeholders for 'fmap'"
+ , goldenWithClass "Creates a placeholder for multiple methods 1" "T3" "1" $
+ getActionByTitle "Add placeholders for 'f','g'"
+ , goldenWithClass "Creates a placeholder for multiple methods 2" "T3" "2" $
+ getActionByTitle "Add placeholders for 'g','h'"
+ , goldenWithClass "Creates a placeholder for a method starting with '_'" "T4" "" $
+ getActionByTitle "Add placeholders for '_f'"
+ , goldenWithClass "Creates a placeholder for '==' with extra lines" "T5" "" $
+ getActionByTitle "Add placeholders for '=='"
+ , goldenWithClass "Creates a placeholder for only the unimplemented methods of multiple methods" "T6" "1" $
+ getActionByTitle "Add placeholders for 'g'"
+ , goldenWithClass "Creates a placeholder for other two methods" "T6" "2" $
+ getActionByTitle "Add placeholders for 'g','h'"
  , onlyRunForGhcVersions [GHC92, GHC94] "Only ghc-9.2+ enabled GHC2021 implicitly" $
- goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $ \(_:eqWithSig:_) -> do
- executeCodeAction eqWithSig
- , goldenWithClass "Insert pragma if not exist" "InsertWithoutPragma" "" $ \(_:eqWithSig:_) -> do
- executeCodeAction eqWithSig
- , goldenWithClass "Don't insert pragma if exist" "InsertWithPragma" "" $ \(_:eqWithSig:_) -> do
- executeCodeAction eqWithSig
- , goldenWithClass "Only insert pragma once" "InsertPragmaOnce" "" $ \(_:multi:_) -> do
- executeCodeAction multi
+ goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $
+ getActionByTitle "Add placeholders for '==' with signature(s)"
+ , goldenWithClass "Insert pragma if not exist" "InsertWithoutPragma" "" $
+ getActionByTitle "Add placeholders for '==' with signature(s)"
+ , goldenWithClass "Don't insert pragma if exist" "InsertWithPragma" "" $
+ getActionByTitle "Add placeholders for '==' with signature(s)"
+ , goldenWithClass "Only insert pragma once" "InsertPragmaOnce" "" $
+ getActionByTitle "Add placeholders for 'pure','<*>' with signature(s)"
  , expectCodeActionsAvailable "No code action available when minimal requirements meet" "MinimalDefinitionMeet" []
  , expectCodeActionsAvailable "Add placeholders for all missing methods is unavailable when all methods are required" "AllMethodsRequired"
  [ "Add placeholders for 'f','g'"
@@ -162,14 +160,20 @@ goldenCodeLens title path idx =
  executeCommand $ fromJust $ (lens !! idx) ^. L.command
  void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit)
 
-goldenWithClass ::TestName -> FilePath -> FilePath -> ([CodeAction] -> Session ()) -> TestTree
-goldenWithClass title path desc act =
+goldenWithClass ::TestName -> FilePath -> FilePath -> ([CodeAction] -> Session CodeAction) -> TestTree
+goldenWithClass title path desc findAction =
  goldenWithHaskellDoc def classPlugin title testDataDir path (desc <.> "expected") "hs" $ \doc -> do
  _ <- waitForDiagnosticsFrom doc
  actions <- concatMap (^.. _CACodeAction) <$> getAllCodeActions doc
- act actions
+ action <- findAction actions
+ executeCodeAction action
  void $ skipManyTill anyMessage (getDocumentEdit doc)
 
+getActionByTitle :: T.Text -> [CodeAction] -> Session CodeAction
+getActionByTitle title actions = case find (\a -> a ^. L.title == title) actions of
+ Just a -> pure a
+ Nothing -> liftIO $ assertFailure $ "Action " <> show title <> " not found in " <> show [a ^. L.title | a <- actions]
+
 expectCodeActionsAvailable :: TestName -> FilePath -> [T.Text] -> TestTree
 expectCodeActionsAvailable title path actionTitles =
  testCase title $ do

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

@@ -38,9 +38,6 @@ makePoint line column
  | line >= 1 && column >= 1 = Point line column
  | otherwise = error "Line or column is less than 1."
 
-isNotEmpty :: Foldable f => f a -> Bool
-isNotEmpty = not . isEmpty
-
 isEmpty :: Foldable f => f a -> Bool
 isEmpty = null