Skip to content

Commit f844a29

Browse files
jhrcekjhrcek
authored
Fix -Wall in refactor plugin (#4065)
* Fix -Wall in refactor plugin * Fix hlint warnings * stylish-haskell
1 parent 1bbe780 commit f844a29

File tree

9 files changed

+92
-112
lines changed

9 files changed

+92
-112
lines changed

‎ghcide/test/exe/InitializeResponseTests.hs‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -77,13 +77,13 @@ tests = withResource acquire release tests where
7777
testCase title $ getInitializeResponse >>= \ir -> expected @=? (getActual . innerCaps) ir
7878

7979
che :: TestName -> (ServerCapabilities -> Maybe ExecuteCommandOptions) -> [T.Text] -> TestTree
80-
che title getActual expected = testCase title doTest
81-
where
82-
doTest = do
83-
ir <- getInitializeResponse
84-
let Just ExecuteCommandOptions {_commands = commands} = getActual $ innerCaps ir
85-
commandNames = (!! 2) . T.splitOn ":" <$> commands
86-
zipWithM_ (\e o -> T.isSuffixOf e o @? show (e,o)) (sort expected) (sort commandNames)
80+
che title getActual expected = testCase title $ do
81+
ir <- getInitializeResponse
82+
ExecuteCommandOptions {_commands = commands} <- case getActual $ innerCaps ir of
83+
Just eco -> pure eco
84+
Nothing -> assertFailure "Was expecting Just ExecuteCommandOptions, got Nothing"
85+
let commandNames = (!! 2) . T.splitOn ":" <$> commands
86+
zipWithM_ (\e o -> T.isSuffixOf e o @? show (e,o)) (sort expected) (sort commandNames)
8787

8888
innerCaps :: TResponseMessage Method_Initialize -> ServerCapabilities
8989
innerCaps (TResponseMessage _ _ (Right (InitializeResult c _))) = c
@@ -93,5 +93,5 @@ tests = withResource acquire release tests where
9393
acquire = run initializeResponse
9494

9595
release :: TResponseMessage Method_Initialize -> IO ()
96-
release = const $ pure ()
96+
release = mempty
9797

‎haskell-language-server.cabal‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1439,7 +1439,7 @@ common refactor
14391439
cpp-options: -Dhls_refactor
14401440

14411441
library hls-refactor-plugin
1442-
import: defaults, warnings
1442+
import: defaults, pedantic, warnings
14431443
exposed-modules: Development.IDE.GHC.ExactPrint
14441444
Development.IDE.GHC.Compat.ExactPrint
14451445
Development.IDE.Plugin.CodeAction
@@ -1473,7 +1473,6 @@ library hls-refactor-plugin
14731473
, bytestring
14741474
, ghc-boot
14751475
, regex-tdfa
1476-
, text-rope
14771476
, ghcide == 2.6.0.0
14781477
, hls-plugin-api == 2.6.0.0
14791478
, lsp
@@ -1497,7 +1496,7 @@ library hls-refactor-plugin
14971496
, parser-combinators
14981497

14991498
test-suite hls-refactor-plugin-tests
1500-
import: defaults, test-defaults, warnings
1499+
import: defaults, pedantic, test-defaults, warnings
15011500
type: exitcode-stdio-1.0
15021501
hs-source-dirs: plugins/hls-refactor-plugin/test
15031502
main-is: Main.hs

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

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ showAstDataHtml a0 = html $
4242
pre = tag "pre"
4343
showAstDataHtml' :: Data a => a -> SDoc
4444
showAstDataHtml' =
45-
(generic
45+
generic
4646
`ext1Q` list
4747
`extQ` string `extQ` fastString `extQ` srcSpan `extQ` realSrcSpan
4848
`extQ` annotation
@@ -73,7 +73,6 @@ showAstDataHtml a0 = html $
7373
`extQ` srcSpanAnnP
7474
`extQ` srcSpanAnnC
7575
`extQ` srcSpanAnnN
76-
)
7776

7877
where generic :: Data a => a -> SDoc
7978
generic t = nested (text $ showConstr (toConstr t))
@@ -157,15 +156,15 @@ showAstDataHtml a0 = html $
157156

158157
srcSpan :: SrcSpan -> SDoc
159158
srcSpan ss = char ' ' <>
160-
(hang (ppr ss) 1
159+
hang (ppr ss) 1
161160
-- TODO: show annotations here
162-
(text ""))
161+
(text "")
163162

164163
realSrcSpan :: RealSrcSpan -> SDoc
165164
realSrcSpan ss = braces $ char ' ' <>
166-
(hang (ppr ss) 1
165+
hang (ppr ss) 1
167166
-- TODO: show annotations here
168-
(text ""))
167+
(text "")
169168

170169
addEpAnn :: AddEpAnn -> SDoc
171170
addEpAnn (AddEpAnn a s) = text "AddEpAnn" <+> ppr a <+> epaAnchor s
@@ -202,7 +201,7 @@ showAstDataHtml a0 = html $
202201

203202
located :: (Data a, Data b) => GenLocated a b -> SDoc
204203
located (L ss a)
205-
= nested "L" $ (li (showAstDataHtml' ss) $$ li (showAstDataHtml' a))
204+
= nested "L" (li (showAstDataHtml' ss) $$ li (showAstDataHtml' a))
206205

207206
-- -------------------------
208207

@@ -245,7 +244,7 @@ showAstDataHtml a0 = html $
245244
annotationEpaLocation = annotation' (text "EpAnn EpaLocation")
246245

247246
annotation' :: forall a. Data a => SDoc -> EpAnn a -> SDoc
248-
annotation' tag anns = nested (text $ showConstr (toConstr anns))
247+
annotation' _tag anns = nested (text $ showConstr (toConstr anns))
249248
(vcat (map li $ gmapQ showAstDataHtml' anns))
250249

251250
-- -------------------------

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

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE GADTs #-}
22
{-# LANGUAGE TypeFamilies #-}
3+
{-# OPTIONS_GHC -Wno-orphans #-}
34

45
-- | This module hosts various abstractions and utility functions to work with ghc-exactprint.
56
module Development.IDE.GHC.ExactPrint
@@ -29,6 +30,7 @@ module Development.IDE.GHC.ExactPrint
2930
removeComma,
3031
-- * Helper function
3132
eqSrcSpan,
33+
eqSrcSpanA,
3234
epl,
3335
epAnn,
3436
removeTrailingComma,
@@ -434,7 +436,7 @@ modifySmallestDeclWithM validSpan f a = do
434436
TransformT (lift $ validSpan $ locA src) >>= \case
435437
True -> do
436438
(decs', r) <- f ldecl
437-
pure $ (DL.fromList decs' <> DL.fromList rest, Just r)
439+
pure (DL.fromList decs' <> DL.fromList rest, Just r)
438440
False -> first (DL.singleton ldecl <>) <$> modifyMatchingDecl rest
439441
modifyDeclsT' (fmap (first DL.toList) . modifyMatchingDecl) a
440442

@@ -476,7 +478,7 @@ modifySigWithM ::
476478
TransformT m a
477479
modifySigWithM queryId f a = do
478480
let modifyMatchingSigD :: [LHsDecl GhcPs] -> TransformT m (DL.DList (LHsDecl GhcPs))
479-
modifyMatchingSigD [] = pure (DL.empty)
481+
modifyMatchingSigD [] = pure DL.empty
480482
modifyMatchingSigD (ldecl@(L annSigD (SigD xsig (TypeSig xTypeSig ids (HsWC xHsWc lHsSig)))) : rest)
481483
| queryId `elem` (unLoc <$> ids) = do
482484
let newSig = f lHsSig
@@ -546,7 +548,7 @@ modifyMgMatchesT' (MG xMg (L locMatches matches)) f def combineResults = do
546548
modifyMgMatchesT' (MG xMg (L locMatches matches) originMg) f def combineResults = do
547549
(unzip -> (matches', rs)) <- mapM f matches
548550
r' <- lift $ foldM combineResults def rs
549-
pure $ (MG xMg (L locMatches matches') originMg, r')
551+
pure (MG xMg (L locMatches matches') originMg, r')
550552
#endif
551553

552554
graftSmallestDeclsWithM ::
@@ -690,7 +692,7 @@ eqSrcSpan l r = leftmost_smallest l r == EQ
690692

691693
-- | Equality on SrcSpan's.
692694
-- Ignores the (Maybe BufSpan) field of SrcSpan's.
693-
eqSrcSpanA :: SrcAnn la -> SrcAnn b -> Bool
695+
eqSrcSpanA :: SrcAnn a -> SrcAnn b -> Bool
694696
eqSrcSpanA l r = leftmost_smallest (locA l) (locA r) == EQ
695697

696698
addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext
@@ -715,7 +717,7 @@ modifyAnns x f = first ((fmap.fmap) f) x
715717
removeComma :: SrcSpanAnnA -> SrcSpanAnnA
716718
removeComma it@(SrcSpanAnn EpAnnNotUsed _) = it
717719
removeComma (SrcSpanAnn (EpAnn anc (AnnListItem as) cs) l)
718-
= (SrcSpanAnn (EpAnn anc (AnnListItem (filter (not . isCommaAnn) as)) cs) l)
720+
= SrcSpanAnn (EpAnn anc (AnnListItem (filter (not . isCommaAnn) as)) cs) l
719721
where
720722
isCommaAnn AddCommaAnn{} = True
721723
isCommaAnn _ = False

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

Lines changed: 5 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,6 @@ import Data.Ord (comparing)
4040
import qualified Data.Set as S
4141
import qualified Data.Text as T
4242
import qualified Data.Text.Encoding as T
43-
import qualified Data.Text.Utf16.Rope as Rope
4443
import Development.IDE.Core.Rules
4544
import Development.IDE.Core.RuleTypes
4645
import Development.IDE.Core.Service
@@ -102,8 +101,7 @@ import Language.LSP.Protocol.Types (ApplyWorkspa
102101
type (|?) (InL, InR),
103102
uriToFilePath)
104103
import qualified Language.LSP.Server as LSP
105-
import Language.LSP.VFS (VirtualFile,
106-
virtualFileText)
104+
import Language.LSP.VFS (virtualFileText)
107105
import qualified Text.Fuzzy.Parallel as TFP
108106
import qualified Text.Regex.Applicative as RE
109107
import Text.Regex.TDFA ((=~), (=~~))
@@ -122,7 +120,7 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range Cod
122120
let
123121
actions = caRemoveRedundantImports parsedModule text diag xs uri
124122
<> caRemoveInvalidExports parsedModule text diag xs uri
125-
pure $ InL $ actions
123+
pure $ InL actions
126124

127125
-------------------------------------------------------------------------------------------------
128126

@@ -191,7 +189,7 @@ extendImportHandler :: CommandFunction IdeState ExtendImport
191189
extendImportHandler ideState _ edit@ExtendImport {..} = ExceptT $ do
192190
res <- liftIO $ runMaybeT $ extendImportHandler' ideState edit
193191
whenJust res $ \(nfp, wedit@WorkspaceEdit {_changes}) -> do
194-
let (_, (head -> TextEdit {_range})) = fromJust $ _changes >>= listToMaybe . M.toList
192+
let (_, head -> TextEdit {_range}) = fromJust $ _changes >>= listToMaybe . M.toList
195193
srcSpan = rangeToSrcSpan nfp _range
196194
LSP.sendNotification SMethod_WindowShowMessage $
197195
ShowMessageParams MessageType_Info $
@@ -389,7 +387,6 @@ suggestHideShadow ps fileContents mTcM mHar Diagnostic {_message, _range}
389387
findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
390388
findImportDeclByModuleName decls modName = flip find decls $ \case
391389
(L _ ImportDecl {..}) -> modName == moduleNameString (unLoc ideclName)
392-
_ -> error "impossible"
393390

394391
isTheSameLine :: SrcSpan -> SrcSpan -> Bool
395392
isTheSameLine s1 s2
@@ -637,7 +634,6 @@ suggestDeleteUnusedBinding
637634
case grhssLocalBinds of
638635
(HsValBinds _ (ValBinds _ bag lsigs)) -> go bag lsigs
639636
_ -> []
640-
findRelatedSpanForMatch _ _ _ = []
641637

642638
findRelatedSpanForHsBind
643639
:: PositionIndexedString
@@ -1123,8 +1119,6 @@ targetModuleName :: ModuleTarget -> ModuleName
11231119
targetModuleName ImplicitPrelude{} = mkModuleName "Prelude"
11241120
targetModuleName (ExistingImp (L _ ImportDecl{..} :| _)) =
11251121
unLoc ideclName
1126-
targetModuleName (ExistingImp _) =
1127-
error "Cannot happen!"
11281122

11291123
disambiguateSymbol ::
11301124
Annotated ParsedSource ->
@@ -1538,7 +1532,8 @@ constructNewImportSuggestions
15381532
constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules qis = nubOrdBy simpleCompareImportSuggestion
15391533
[ suggestion
15401534
| Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing] -- strip away qualified module names from the unknown name
1541-
, identInfo <- maybe [] Set.toList $ (lookupOccEnv (getExportsMap exportsMap) (mkVarOrDataOcc name)) <> (lookupOccEnv (getExportsMap exportsMap) (mkTypeOcc name)) -- look up the modified unknown name in the export map
1535+
, identInfo <- maybe [] Set.toList $ lookupOccEnv (getExportsMap exportsMap) (mkVarOrDataOcc name)
1536+
<> lookupOccEnv (getExportsMap exportsMap) (mkTypeOcc name) -- look up the modified unknown name in the export map
15421537
, canUseIdent thingMissing identInfo -- check if the identifier information retrieved can be used
15431538
, moduleNameText identInfo `notElem` fromMaybe [] notTheseModules -- check if the module of the identifier is allowed
15441539
, 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‎

Lines changed: 8 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ import Control.Monad.Reader
1919
import Control.Monad.Trans.Maybe
2020
import Data.Either (fromRight,
2121
partitionEithers)
22+
import Data.Functor ((<&>))
2223
import Data.IORef.Extra
2324
import qualified Data.Map as Map
2425
import Data.Maybe (fromMaybe)
@@ -52,7 +53,6 @@ type GhcideCodeAction = ExceptT PluginError (ReaderT CodeActionArgs IO) GhcideCo
5253

5354
-------------------------------------------------------------------------------------------------
5455

55-
{-# ANN runGhcideCodeAction ("HLint: ignore Move guards forward" :: String) #-}
5656
runGhcideCodeAction :: LSP.MonadLsp Config m => IdeState -> MessageParams Method_TextDocumentCodeAction -> GhcideCodeAction -> m GhcideCodeActionResult
5757
runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext {_diagnostics = diags}) codeAction = do
5858
let mbFile = toNormalizedFilePath' <$> uriToFilePath uri
@@ -70,28 +70,26 @@ runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _ra
7070
caaParsedModule <- onceIO $ runRule GetParsedModuleWithComments
7171
caaContents <-
7272
onceIO $
73-
runRule GetFileContents >>= \case
74-
Just (_, txt) -> pure txt
75-
_ -> pure Nothing
73+
runRule GetFileContents <&> \case
74+
Just (_, txt) -> txt
75+
Nothing -> Nothing
7676
caaDf <- onceIO $ fmap (ms_hspp_opts . pm_mod_summary) <$> caaParsedModule
7777
caaAnnSource <- onceIO $ runRule GetAnnotatedParsedSource
7878
caaTmr <- onceIO $ runRule TypeCheck
7979
caaHar <- onceIO $ runRule GetHieAst
8080
caaBindings <- onceIO $ runRule GetBindings
8181
caaGblSigs <- onceIO $ runRule GetGlobalBindingTypeSigs
8282
results <- liftIO $
83-
8483
sequence
85-
[ runReaderT (runExceptT codeAction) caa
86-
| caaDiagnostic <- diags,
87-
let caa = CodeActionArgs {..}
84+
[ runReaderT (runExceptT codeAction) CodeActionArgs {..}
85+
| caaDiagnostic <- diags
8886
]
89-
let (errs, successes) = partitionEithers results
87+
let (_errs, successes) = partitionEithers results
9088
pure $ concat successes
9189

9290
mkCA :: T.Text -> Maybe CodeActionKind -> Maybe Bool -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction)
9391
mkCA title kind isPreferred diags edit =
94-
InR $ CodeAction title kind (Just $ diags) isPreferred Nothing (Just edit) Nothing Nothing
92+
InR $ CodeAction title kind (Just diags) isPreferred Nothing (Just edit) Nothing Nothing
9593

9694
mkGhcideCAPlugin :: GhcideCodeAction -> PluginId -> T.Text -> PluginDescriptor IdeState
9795
mkGhcideCAPlugin codeAction plId desc =

0 commit comments

Comments
 (0)