Fix -Wall in refactor plugin

ghcide/test/exe/InitializeResponseTests.hs

@@ -77,13 +77,13 @@ tests = withResource acquire release tests where
         testCase title $ getInitializeResponse >>= \ir -> expected @=? (getActual . innerCaps) ir
 
       che :: TestName -> (ServerCapabilities -> Maybe ExecuteCommandOptions) -> [T.Text] -> TestTree
-      che title getActual expected = testCase title doTest
-        where
-            doTest = do
-                ir <- getInitializeResponse
-                let Just ExecuteCommandOptions {_commands = commands} = getActual $ innerCaps ir
-                    commandNames = (!! 2) . T.splitOn ":" <$> commands
-                zipWithM_ (\e o -> T.isSuffixOf e o @? show (e,o)) (sort expected) (sort commandNames)
+      che title getActual expected = testCase title $ do
+        ir <- getInitializeResponse
+        ExecuteCommandOptions {_commands = commands} <- case getActual $ innerCaps ir of
+          Just eco -> pure eco
+          Nothing -> assertFailure "Was expecting Just ExecuteCommandOptions, got Nothing"
+        let commandNames = (!! 2) . T.splitOn ":" <$> commands
+        zipWithM_ (\e o -> T.isSuffixOf e o @? show (e,o)) (sort expected) (sort commandNames)
 
   innerCaps :: TResponseMessage Method_Initialize -> ServerCapabilities
   innerCaps (TResponseMessage _ _ (Right (InitializeResult c _))) = c
@@ -93,5 +93,5 @@ tests = withResource acquire release tests where
   acquire = run initializeResponse
 
   release :: TResponseMessage Method_Initialize -> IO ()
-  release = const $ pure ()
+  release = mempty
 

haskell-language-server.cabal

@@ -1439,7 +1439,7 @@ common refactor
     cpp-options: -Dhls_refactor
 
 library hls-refactor-plugin
-  import:           defaults, warnings
+  import:           defaults, pedantic, warnings
   exposed-modules:  Development.IDE.GHC.ExactPrint
                     Development.IDE.GHC.Compat.ExactPrint
                     Development.IDE.Plugin.CodeAction
@@ -1473,7 +1473,6 @@ library hls-refactor-plugin
     , bytestring
     , ghc-boot
     , regex-tdfa
-    , text-rope
     , ghcide                == 2.6.0.0
     , hls-plugin-api        == 2.6.0.0
     , lsp
@@ -1497,7 +1496,7 @@ library hls-refactor-plugin
     , parser-combinators
 
 test-suite hls-refactor-plugin-tests
-  import:           defaults, test-defaults, warnings
+  import:           defaults, pedantic, test-defaults, warnings
   type:             exitcode-stdio-1.0
   hs-source-dirs:   plugins/hls-refactor-plugin/test
   main-is:          Main.hs

plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs

@@ -42,7 +42,7 @@ showAstDataHtml a0 = html $
     pre = tag "pre"
     showAstDataHtml' :: Data a => a -> SDoc
     showAstDataHtml' =
-      (generic
+      generic
               `ext1Q` list
               `extQ` string `extQ` fastString `extQ` srcSpan `extQ` realSrcSpan
               `extQ` annotation
@@ -73,7 +73,6 @@ showAstDataHtml a0 = html $
               `extQ` srcSpanAnnP
               `extQ` srcSpanAnnC
               `extQ` srcSpanAnnN
-              )
 
       where generic :: Data a => a -> SDoc
             generic t = nested (text $ showConstr (toConstr t))
@@ -157,15 +156,15 @@ showAstDataHtml a0 = html $
 
             srcSpan :: SrcSpan -> SDoc
             srcSpan ss = char ' ' <>
-                             (hang (ppr ss) 1
+                             hang (ppr ss) 1
                                    -- TODO: show annotations here
-                                   (text ""))
+                                   (text "")
 
             realSrcSpan :: RealSrcSpan -> SDoc
             realSrcSpan ss = braces $ char ' ' <>
-                             (hang (ppr ss) 1
+                             hang (ppr ss) 1
                                    -- TODO: show annotations here
-                                   (text ""))
+                                   (text "")
 
             addEpAnn :: AddEpAnn -> SDoc
             addEpAnn (AddEpAnn a s) = text "AddEpAnn" <+> ppr a <+> epaAnchor s
@@ -202,7 +201,7 @@ showAstDataHtml a0 = html $
 
             located :: (Data a, Data b) => GenLocated a b -> SDoc
             located (L ss a)
-              = nested "L" $ (li (showAstDataHtml' ss) $$ li (showAstDataHtml' a))
+              = nested "L" (li (showAstDataHtml' ss) $$ li (showAstDataHtml' a))
 
             -- -------------------------
 
@@ -245,7 +244,7 @@ showAstDataHtml a0 = html $
             annotationEpaLocation = annotation' (text "EpAnn EpaLocation")
 
             annotation' :: forall a. Data a => SDoc -> EpAnn a -> SDoc
-            annotation' tag anns = nested (text $ showConstr (toConstr anns))
+            annotation' _tag anns = nested (text $ showConstr (toConstr anns))
               (vcat (map li $ gmapQ showAstDataHtml' anns))
 
             -- -------------------------

plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE GADTs        #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 -- | This module hosts various abstractions and utility functions to work with ghc-exactprint.
 module Development.IDE.GHC.ExactPrint
@@ -29,6 +30,7 @@ module Development.IDE.GHC.ExactPrint
       removeComma,
       -- * Helper function
       eqSrcSpan,
+      eqSrcSpanA,
       epl,
       epAnn,
       removeTrailingComma,
@@ -434,7 +436,7 @@ modifySmallestDeclWithM validSpan f a = do
         TransformT (lift $ validSpan $ locA src) >>= \case
             True -> do
               (decs', r) <- f ldecl
-              pure $ (DL.fromList decs' <> DL.fromList rest, Just r)
+              pure (DL.fromList decs' <> DL.fromList rest, Just r)
             False -> first (DL.singleton ldecl <>) <$> modifyMatchingDecl rest
   modifyDeclsT' (fmap (first DL.toList) . modifyMatchingDecl) a
 
@@ -476,7 +478,7 @@ modifySigWithM ::
   TransformT m a
 modifySigWithM queryId f a = do
   let modifyMatchingSigD :: [LHsDecl GhcPs] -> TransformT m (DL.DList (LHsDecl GhcPs))
-      modifyMatchingSigD [] = pure (DL.empty)
+      modifyMatchingSigD [] = pure DL.empty
       modifyMatchingSigD (ldecl@(L annSigD (SigD xsig (TypeSig xTypeSig ids (HsWC xHsWc lHsSig)))) : rest)
         | queryId `elem` (unLoc <$> ids) = do
             let newSig = f lHsSig
@@ -546,7 +548,7 @@ modifyMgMatchesT' (MG xMg (L locMatches matches)) f def combineResults = do
 modifyMgMatchesT' (MG xMg (L locMatches matches) originMg) f def combineResults = do
   (unzip -> (matches', rs)) <- mapM f matches
   r' <- lift $ foldM combineResults def rs
-  pure $ (MG xMg (L locMatches matches') originMg, r')
+  pure (MG xMg (L locMatches matches') originMg, r')
 #endif
 
 graftSmallestDeclsWithM ::
@@ -690,7 +692,7 @@ eqSrcSpan l r = leftmost_smallest l r == EQ
 
 -- | Equality on SrcSpan's.
 -- Ignores the (Maybe BufSpan) field of SrcSpan's.
-eqSrcSpanA :: SrcAnn la -> SrcAnn b -> Bool
+eqSrcSpanA :: SrcAnn a -> SrcAnn b -> Bool
 eqSrcSpanA l r = leftmost_smallest (locA l) (locA r) == EQ
 
 addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext
@@ -715,7 +717,7 @@ modifyAnns x f = first ((fmap.fmap) f) x
 removeComma :: SrcSpanAnnA -> SrcSpanAnnA
 removeComma it@(SrcSpanAnn EpAnnNotUsed _) = it
 removeComma (SrcSpanAnn (EpAnn anc (AnnListItem as) cs) l)
-  = (SrcSpanAnn (EpAnn anc (AnnListItem (filter (not . isCommaAnn) as)) cs) l)
+  = SrcSpanAnn (EpAnn anc (AnnListItem (filter (not . isCommaAnn) as)) cs) l
   where
       isCommaAnn AddCommaAnn{} = True
       isCommaAnn _             = False

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs

@@ -40,7 +40,6 @@ import           Data.Ord                                          (comparing)
 import qualified Data.Set                                          as S
 import qualified Data.Text                                         as T
 import qualified Data.Text.Encoding                                as T
-import qualified Data.Text.Utf16.Rope                              as Rope
 import           Development.IDE.Core.Rules
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Service
@@ -102,8 +101,7 @@ import           Language.LSP.Protocol.Types                       (ApplyWorkspa
                                                                     type (|?) (InL, InR),
                                                                     uriToFilePath)
 import qualified Language.LSP.Server                               as LSP
-import           Language.LSP.VFS                                  (VirtualFile,
-                                                                    virtualFileText)
+import           Language.LSP.VFS                                  (virtualFileText)
 import qualified Text.Fuzzy.Parallel                               as TFP
 import qualified Text.Regex.Applicative                            as RE
 import           Text.Regex.TDFA                                   ((=~), (=~~))
@@ -122,7 +120,7 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range Cod
     let
       actions = caRemoveRedundantImports parsedModule text diag xs uri
                <> caRemoveInvalidExports parsedModule text diag xs uri
-    pure $ InL $ actions
+    pure $ InL actions
 
 -------------------------------------------------------------------------------------------------
 
@@ -191,7 +189,7 @@ extendImportHandler :: CommandFunction IdeState ExtendImport
 extendImportHandler ideState _ edit@ExtendImport {..} = ExceptT $ do
   res <- liftIO $ runMaybeT $ extendImportHandler' ideState edit
   whenJust res $ \(nfp, wedit@WorkspaceEdit {_changes}) -> do
-    let (_, (head -> TextEdit {_range})) = fromJust $ _changes >>= listToMaybe . M.toList
+    let (_, head -> TextEdit {_range}) = fromJust $ _changes >>= listToMaybe . M.toList
         srcSpan = rangeToSrcSpan nfp _range
     LSP.sendNotification SMethod_WindowShowMessage $
       ShowMessageParams MessageType_Info $
@@ -389,7 +387,6 @@ suggestHideShadow ps fileContents mTcM mHar Diagnostic {_message, _range}
 findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
 findImportDeclByModuleName decls modName = flip find decls $ \case
   (L _ ImportDecl {..}) -> modName == moduleNameString (unLoc ideclName)
-  _                     -> error "impossible"
 
 isTheSameLine :: SrcSpan -> SrcSpan -> Bool
 isTheSameLine s1 s2
@@ -637,7 +634,6 @@ suggestDeleteUnusedBinding
         case grhssLocalBinds of
           (HsValBinds _ (ValBinds _ bag lsigs)) -> go bag lsigs
           _                                     -> []
-      findRelatedSpanForMatch _ _ _ = []
 
       findRelatedSpanForHsBind
         :: PositionIndexedString
@@ -1123,8 +1119,6 @@ targetModuleName :: ModuleTarget -> ModuleName
 targetModuleName ImplicitPrelude{} = mkModuleName "Prelude"
 targetModuleName (ExistingImp (L _ ImportDecl{..} :| _)) =
     unLoc ideclName
-targetModuleName (ExistingImp _) =
-    error "Cannot happen!"
 
 disambiguateSymbol ::
     Annotated ParsedSource ->
@@ -1538,7 +1532,8 @@ constructNewImportSuggestions
 constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules qis = nubOrdBy simpleCompareImportSuggestion
   [ suggestion
   | Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing] -- strip away qualified module names from the unknown name
-  , identInfo <- maybe [] Set.toList $ (lookupOccEnv (getExportsMap exportsMap) (mkVarOrDataOcc name)) <> (lookupOccEnv (getExportsMap exportsMap) (mkTypeOcc name)) -- look up the modified unknown name in the export map
+  , identInfo <- maybe [] Set.toList $ lookupOccEnv (getExportsMap exportsMap) (mkVarOrDataOcc name)
+                                    <> lookupOccEnv (getExportsMap exportsMap) (mkTypeOcc name) -- look up the modified unknown name in the export map
   , canUseIdent thingMissing identInfo                                              -- check if the identifier information retrieved can be used
   , moduleNameText identInfo `notElem` fromMaybe [] notTheseModules                 -- check if the module of the identifier is allowed
   , suggestion <- renderNewImport identInfo                                         -- creates a list of import suggestions for the retrieved identifier information

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs

@@ -19,6 +19,7 @@ import           Control.Monad.Reader
 import           Control.Monad.Trans.Maybe
 import           Data.Either                                  (fromRight,
                                                                partitionEithers)
+import           Data.Functor                                 ((<&>))
 import           Data.IORef.Extra
 import qualified Data.Map                                     as Map
 import           Data.Maybe                                   (fromMaybe)
@@ -52,7 +53,6 @@ type GhcideCodeAction = ExceptT PluginError (ReaderT CodeActionArgs IO) GhcideCo
 
 -------------------------------------------------------------------------------------------------
 
-{-# ANN runGhcideCodeAction ("HLint: ignore Move guards forward" :: String) #-}
 runGhcideCodeAction :: LSP.MonadLsp Config m => IdeState -> MessageParams Method_TextDocumentCodeAction -> GhcideCodeAction -> m GhcideCodeActionResult
 runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext {_diagnostics = diags}) codeAction = do
   let mbFile = toNormalizedFilePath' <$> uriToFilePath uri
@@ -70,28 +70,26 @@ runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _ra
   caaParsedModule <- onceIO $ runRule GetParsedModuleWithComments
   caaContents <-
     onceIO $
-      runRule GetFileContents >>= \case
-        Just (_, txt) -> pure txt
-        _             -> pure Nothing
+      runRule GetFileContents <&> \case
+        Just (_, txt) -> txt
+        Nothing       -> Nothing
   caaDf <- onceIO $ fmap (ms_hspp_opts . pm_mod_summary) <$> caaParsedModule
   caaAnnSource <- onceIO $ runRule GetAnnotatedParsedSource
   caaTmr <- onceIO $ runRule TypeCheck
   caaHar <- onceIO $ runRule GetHieAst
   caaBindings <- onceIO $ runRule GetBindings
   caaGblSigs <- onceIO $ runRule GetGlobalBindingTypeSigs
   results <- liftIO $
-
       sequence
-        [ runReaderT (runExceptT codeAction) caa
-          | caaDiagnostic <- diags,
-            let caa = CodeActionArgs {..}
+        [ runReaderT (runExceptT codeAction) CodeActionArgs {..}
+          | caaDiagnostic <- diags
         ]
-  let (errs, successes) = partitionEithers results
+  let (_errs, successes) = partitionEithers results
   pure $ concat successes
 
 mkCA :: T.Text -> Maybe CodeActionKind -> Maybe Bool -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction)
 mkCA title kind isPreferred diags edit =
-  InR $ CodeAction title kind (Just $ diags) isPreferred Nothing (Just edit) Nothing Nothing
+  InR $ CodeAction title kind (Just diags) isPreferred Nothing (Just edit) Nothing Nothing
 
 mkGhcideCAPlugin :: GhcideCodeAction -> PluginId -> T.Text -> PluginDescriptor IdeState
 mkGhcideCAPlugin codeAction plId desc =