Skip to content

Commit aedf448

Browse files
jhrcekjhrcek
committed
Fix -Wall in refactor plugin
1 parent 1bbe780 commit aedf448

File tree

9 files changed

+78
-97
lines changed

9 files changed

+78
-97
lines changed

‎ghcide/test/exe/InitializeResponseTests.hs

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -77,21 +77,24 @@ 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} <- assertJust "ExecuteCommandOptions" $ getActual $ innerCaps ir
83+
let commandNames = (!! 2) . T.splitOn ":" <$> commands
84+
zipWithM_ (\e o -> T.isSuffixOf e o @? show (e,o)) (sort expected) (sort commandNames)
8785

8886
innerCaps :: TResponseMessage Method_Initialize -> ServerCapabilities
8987
innerCaps (TResponseMessage _ _ (Right (InitializeResult c _))) = c
9088
innerCaps (TResponseMessage _ _ (Left _)) = error "Initialization error"
9189

90+
assertJust :: String -> Maybe a -> IO a
91+
assertJust s = \case
92+
Nothing -> assertFailure $ "Expecting Just " <> s <> ", got Nothing"
93+
Just x -> pure x
94+
9295
acquire :: IO (TResponseMessage Method_Initialize)
9396
acquire = run initializeResponse
9497

9598
release :: TResponseMessage Method_Initialize -> IO ()
96-
release = const $ pure ()
99+
release = mempty
97100

‎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: 2 additions & 3 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))
@@ -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: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
{-# LANGUAGE GADTs #-}
22
{-# LANGUAGE TypeFamilies #-}
3-
3+
{-# OPTIONS_GHC -Wno-orphans #-}
44
-- | This module hosts various abstractions and utility functions to work with ghc-exactprint.
55
module Development.IDE.GHC.ExactPrint
66
( Graft(..),
@@ -29,6 +29,7 @@ module Development.IDE.GHC.ExactPrint
2929
removeComma,
3030
-- * Helper function
3131
eqSrcSpan,
32+
eqSrcSpanA,
3233
epl,
3334
epAnn,
3435
removeTrailingComma,
@@ -690,7 +691,7 @@ eqSrcSpan l r = leftmost_smallest l r == EQ
690691

691692
-- | Equality on SrcSpan's.
692693
-- Ignores the (Maybe BufSpan) field of SrcSpan's.
693-
eqSrcSpanA :: SrcAnn la -> SrcAnn b -> Bool
694+
eqSrcSpanA :: SrcAnn a -> SrcAnn b -> Bool
694695
eqSrcSpanA l r = leftmost_smallest (locA l) (locA r) == EQ
695696

696697
addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext

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

Lines changed: 1 addition & 7 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 ((=~), (=~~))
@@ -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 ->

‎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 =

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

Lines changed: 8 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,7 @@ rewriteToEdit :: HasCallStack =>
8282
Either String [TextEdit]
8383
rewriteToEdit dflags
8484
(Rewrite dst f) = do
85-
(ast, anns , _) <- runTransformT
85+
(ast, _ , _) <- runTransformT
8686
$ do
8787
ast <- f dflags
8888
pure $ traceAst "REWRITE_result" $ resetEntryDP ast
@@ -209,10 +209,6 @@ lastMaybe :: [a] -> Maybe a
209209
lastMaybe [] = Nothing
210210
lastMaybe other = Just $ last other
211211

212-
liftMaybe :: String -> Maybe a -> TransformT (Either String) a
213-
liftMaybe _ (Just x) = return x
214-
liftMaybe s _ = TransformT $ lift $ Left s
215-
216212
------------------------------------------------------------------------------
217213
extendImport :: Maybe String -> String -> LImportDecl GhcPs -> Rewrite
218214
extendImport mparent identifier lDecl@(L l _) =
@@ -243,7 +239,7 @@ extendImportTopLevel thing (L l it@ImportDecl{..})
243239
#else
244240
| Just (hide, L l' lies) <- ideclHiding
245241
#endif
246-
, hasSibling <- not $ null lies = do
242+
= do
247243
src <- uniqueSrcSpanT
248244
top <- uniqueSrcSpanT
249245
let rdr = reLocA $ L src $ mkRdrUnqual $ mkVarOcc thing
@@ -312,7 +308,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..})
312308
where
313309
go _hide _l' _pre ((L _ll' (IEThingAll _ (L _ ie))) : _xs)
314310
| parent == unIEWrappedName ie = TransformT $ lift . Left $ child <> " already included in " <> parent <> " imports"
315-
go hide l' pre (lAbs@(L ll' (IEThingAbs _ absIE@(L _ ie))) : xs)
311+
go hide l' pre ((L ll' (IEThingAbs _ absIE@(L _ ie))) : xs)
316312
-- ThingAbs ie => ThingWith ie child
317313
| parent == unIEWrappedName ie = do
318314
srcChild <- uniqueSrcSpanT
@@ -353,9 +349,8 @@ extendImportViaParent df parent child (L l it@ImportDecl{..})
353349
#endif
354350
lies = L l' $ reverse pre ++ [L l'' thing] ++ xs
355351
return $ L l it'
356-
| parent == unIEWrappedName ie
357-
, hasSibling <- not $ null lies' =
358-
do
352+
| parent == unIEWrappedName ie = do
353+
let hasSibling = not $ null lies'
359354
srcChild <- uniqueSrcSpanT
360355
let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child
361356
childRdr <- pure $ setEntryDP childRdr $ SameLine $ if hasSibling then 1 else 0
@@ -380,8 +375,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..})
380375
fixLast = if hasSibling then first addComma else id
381376
return $ L l it'
382377
go hide l' pre (x : xs) = go hide l' (x : pre) xs
383-
go hide l' pre []
384-
| hasSibling <- not $ null pre = do
378+
go hide l' pre [] = do
385379
-- [] => ThingWith parent [child]
386380
l'' <- uniqueSrcSpanT
387381
srcParent <- uniqueSrcSpanT
@@ -440,7 +434,7 @@ addCommaInImportList lies x =
440434
_ -> Nothing
441435
pure $ any isTrailingAnnComma (lann_trailing lastItemAnn)
442436

443-
hasSibling = not . null $ lies
437+
hasSibling = not $ null lies
444438

445439
-- Setup the new item. It should have a preceding whitespace if it has siblings, and a trailing comma if the
446440
-- preceding item already has one.
@@ -480,8 +474,6 @@ hideSymbol symbol lidecl@(L loc ImportDecl{..}) =
480474
Just (True, hides) -> Rewrite (locA loc) $ extendHiding symbol lidecl (Just hides)
481475
Just (False, imports) -> Rewrite (locA loc) $ deleteFromImport symbol lidecl imports
482476
#endif
483-
hideSymbol _ (L _ (XImportDecl _)) =
484-
error "cannot happen"
485477

486478
extendHiding ::
487479
String ->
@@ -534,7 +526,7 @@ deleteFromImport ::
534526
XRec GhcPs [LIE GhcPs] ->
535527
DynFlags ->
536528
TransformT (Either String) (LImportDecl GhcPs)
537-
deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do
529+
deleteFromImport (T.pack -> symbol) (L l idecl) (L lieLoc lies) _ = do
538530
let edited = L lieLoc deletedLies
539531
lidecl' =
540532
L l $

0 commit comments

Comments
 (0)