Skip to content

Commit 7c9b932

Browse files
jhrcekAnton-Latukha
jhrcek
and
Anton-Latukha
authored
Fix some hlint warnings (#2523)
* Fix some hlint warnings * Revert changes in hie-compat Co-authored-by: Anton Latukha <[email protected]>
1 parent 2aaa5b8 commit 7c9b932

File tree

40 files changed

+81
-123
lines changed

40 files changed

+81
-123
lines changed

‎ghcide/session-loader/Development/IDE/Session.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -467,7 +467,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
467467
let sessionOpts :: (Maybe FilePath, FilePath)
468468
-> IO (IdeResult HscEnvEq, [FilePath])
469469
sessionOpts (hieYaml, file) = do
470-
v <- fromMaybe HM.empty . Map.lookup hieYaml <$> readVar fileToFlags
470+
v <- Map.findWithDefault HM.empty hieYaml <$> readVar fileToFlags
471471
cfp <- makeAbsolute file
472472
case HM.lookup (toNormalizedFilePath' cfp) v of
473473
Just (opts, old_di) -> do

‎ghcide/src/Development/IDE/Import/DependencyInformation.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -166,7 +166,7 @@ data ModuleParseError = ModuleParseError
166166
instance NFData ModuleParseError
167167

168168
-- | Error when trying to locate a module.
169-
data LocateError = LocateError [Diagnostic]
169+
newtype LocateError = LocateError [Diagnostic]
170170
deriving (Eq, Show, Generic)
171171

172172
instance NFData LocateError
@@ -316,7 +316,7 @@ transitiveReverseDependencies file DependencyInformation{..} = do
316316
where
317317
go :: Int -> IntSet -> IntSet
318318
go k i =
319-
let outwards = fromMaybe IntSet.empty (IntMap.lookup k depReverseModuleDeps)
319+
let outwards = IntMap.findWithDefault IntSet.empty k depReverseModuleDeps
320320
res = IntSet.union i outwards
321321
new = IntSet.difference i outwards
322322
in IntSet.foldr go res new

‎ghcide/src/Development/IDE/Types/Logger.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ data Priority
3131
-- | Note that this is logging actions _of the program_, not of the user.
3232
-- You shouldn't call warning/error if the user has caused an error, only
3333
-- if our code has gone wrong and is itself erroneous (e.g. we threw an exception).
34-
data Logger = Logger {logPriority :: Priority -> T.Text -> IO ()}
34+
newtype Logger = Logger {logPriority :: Priority -> T.Text -> IO ()}
3535

3636
instance Semigroup Logger where
3737
l1 <> l2 = Logger $ \p t -> logPriority l1 p t >> logPriority l2 p t

‎hls-graph/src/Control/Concurrent/STM/Stats.hs

-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# LANGUAGE CPP #-}
2-
{-# LANGUAGE RecordWildCards #-}
32
{-# LANGUAGE ScopedTypeVariables #-}
43
module Control.Concurrent.STM.Stats
54
( atomicallyNamed

‎hls-graph/src/Development/IDE/Graph.hs

-2
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,3 @@
1-
{-# LANGUAGE PatternSynonyms #-}
2-
31
module Development.IDE.Graph(
42
shakeOptions,
53
Rules,

‎hls-graph/src/Development/IDE/Graph/Internal/Action.hs

-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# LANGUAGE ConstraintKinds #-}
2-
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
32
{-# LANGUAGE ScopedTypeVariables #-}
43
{-# LANGUAGE TypeFamilies #-}
54

‎hls-graph/src/Development/IDE/Graph/Internal/Database.hs

-3
Original file line numberDiff line numberDiff line change
@@ -4,12 +4,9 @@
44
{-# LANGUAGE DeriveFunctor #-}
55
{-# LANGUAGE DerivingStrategies #-}
66
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7-
{-# LANGUAGE LambdaCase #-}
8-
{-# LANGUAGE NamedFieldPuns #-}
97
{-# LANGUAGE RankNTypes #-}
108
{-# LANGUAGE RecordWildCards #-}
119
{-# LANGUAGE ScopedTypeVariables #-}
12-
{-# LANGUAGE TupleSections #-}
1310
{-# LANGUAGE TypeFamilies #-}
1411

1512
module Development.IDE.Graph.Internal.Database (newDatabase, incDatabase, build, getDirtySet, getKeysAndVisitAge) where

‎hls-graph/src/Development/IDE/Graph/Internal/Options.hs

-2
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,3 @@
1-
{-# LANGUAGE RecordWildCards #-}
2-
31
module Development.IDE.Graph.Internal.Options where
42

53
import Control.Monad.Trans.Reader

‎hls-graph/src/Development/IDE/Graph/Internal/Profile.hs

-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,5 @@
11
{-# LANGUAGE CPP #-}
22
{-# LANGUAGE RecordWildCards #-}
3-
{-# LANGUAGE TemplateHaskell #-}
43
{-# LANGUAGE ViewPatterns #-}
54

65
{- HLINT ignore "Redundant bracket" -} -- a result of CPP expansion

‎hls-graph/src/Development/IDE/Graph/Internal/Rules.hs

+1-3
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,7 @@
11
-- We deliberately want to ensure the function we add to the rule database
22
-- has the constraints we need on it when we get it out.
33
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
4-
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
54
{-# LANGUAGE TypeFamilies #-}
6-
{-# LANGUAGE BangPatterns #-}
75
{-# LANGUAGE ScopedTypeVariables #-}
86
{-# LANGUAGE RecordWildCards #-}
97

@@ -44,7 +42,7 @@ addRule f = do
4442
f2 (Key a) b c = do
4543
v <- f (fromJust $ cast a :: key) b c
4644
v <- liftIO $ evaluate v
47-
pure $ (Value . toDyn) <$> v
45+
pure $ Value . toDyn <$> v
4846

4947
runRule
5048
:: TheRules -> Key -> Maybe BS.ByteString -> RunMode -> Action (RunResult Value)

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

-2
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,8 @@
33
{-# LANGUAGE FlexibleContexts #-}
44
{-# LANGUAGE FlexibleInstances #-}
55
{-# LANGUAGE GADTs #-}
6-
{-# LANGUAGE KindSignatures #-}
76
{-# LANGUAGE LambdaCase #-}
87
{-# LANGUAGE MultiParamTypeClasses #-}
9-
{-# LANGUAGE OverloadedLabels #-}
108
{-# LANGUAGE OverloadedStrings #-}
119
{-# LANGUAGE RecordWildCards #-}
1210
{-# LANGUAGE ScopedTypeVariables #-}

‎hls-plugin-api/src/Ide/PluginUtils.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -178,7 +178,7 @@ getClientConfig = getConfig
178178
getPluginConfig :: MonadLsp Config m => PluginId -> m PluginConfig
179179
getPluginConfig plugin = do
180180
config <- getClientConfig
181-
return $ flip configForPlugin plugin config
181+
return $ configForPlugin config plugin
182182

183183
-- ---------------------------------------------------------------------
184184

‎hls-plugin-api/src/Ide/Types.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -249,7 +249,7 @@ instance PluginMethod TextDocumentCompletion where
249249
combineResponses _ conf _ _ (toList -> xs) = snd $ consumeCompletionResponse limit $ combine xs
250250
where
251251
limit = maxCompletions conf
252-
combine :: [List CompletionItem |? CompletionList] -> ((List CompletionItem) |? CompletionList)
252+
combine :: [List CompletionItem |? CompletionList] -> (List CompletionItem |? CompletionList)
253253
combine cs = go True mempty cs
254254

255255
go !comp acc [] =

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs

-2
Original file line numberDiff line numberDiff line change
@@ -3,11 +3,9 @@
33
{-# LANGUAGE ExtendedDefaultRules #-}
44
{-# LANGUAGE FlexibleContexts #-}
55
{-# LANGUAGE FlexibleInstances #-}
6-
{-# LANGUAGE LambdaCase #-}
76
{-# LANGUAGE NamedFieldPuns #-}
87
{-# LANGUAGE NoMonomorphismRestriction #-}
98
{-# LANGUAGE OverloadedStrings #-}
10-
{-# LANGUAGE PatternSynonyms #-}
119
{-# LANGUAGE RankNTypes #-}
1210
{-# LANGUAGE RecordWildCards #-}
1311
{-# LANGUAGE ScopedTypeVariables #-}

‎plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,7 @@ importLensCommand =
7070
PluginCommand importCommandId "Explicit import command" runImportCommand
7171

7272
-- | The type of the parameters accepted by our command
73-
data ImportCommandParams = ImportCommandParams WorkspaceEdit
73+
newtype ImportCommandParams = ImportCommandParams WorkspaceEdit
7474
deriving (Generic)
7575
deriving anyclass (FromJSON, ToJSON)
7676

‎plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -515,7 +515,7 @@ deriving instance ToJSON RewriteSpec
515515
data QualName = QualName {qual, name :: String}
516516
deriving (Eq, Show, Generic, FromJSON, ToJSON)
517517

518-
data IE name
518+
newtype IE name
519519
= IEVar name
520520
deriving (Eq, Show, Generic, FromJSON, ToJSON)
521521

‎plugins/hls-tactics-plugin/src/Refinery/Future.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -113,18 +113,18 @@ streamProofs s p = ListT $ go s [] pure p
113113
-- This would happen when we had a handler that wasn't followed by an error call.
114114
-- pair >> goal >>= \g -> (handler_ $ \_ -> traceM $ "Handling " <> show g) <|> failure "Error"
115115
-- We would see the "Handling a" message when solving for b.
116-
(go s' (goals ++ [(meta, goal)]) pure $ k h)
116+
go s' (goals ++ [(meta, goal)]) pure $ k h
117117
go s goals handlers (Effect m) = m >>= go s goals handlers
118118
go s goals handlers (Stateful f) =
119119
let (s', p) = f s
120120
in go s' goals handlers p
121121
go s goals handlers (Alt p1 p2) =
122122
unListT $ ListT (go s goals handlers p1) <|> ListT (go s goals handlers p2)
123123
go s goals handlers (Interleave p1 p2) =
124-
interleaveT <$> (go s goals handlers p1) <*> (go s goals handlers p2)
124+
interleaveT <$> go s goals handlers p1 <*> go s goals handlers p2
125125
go s goals handlers (Commit p1 p2) = do
126126
solns <- force =<< go s goals handlers p1
127-
if (any isRight solns) then pure $ ofList solns else go s goals handlers p2
127+
if any isRight solns then pure $ ofList solns else go s goals handlers p2
128128
go _ _ _ Empty = pure Done
129129
go _ _ handlers (Failure err _) = do
130130
annErr <- handlers err

‎plugins/hls-tactics-plugin/src/Wingman/AbstractLSP.hs

+2-3
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,5 @@
11
{-# LANGUAGE AllowAmbiguousTypes #-}
22
{-# LANGUAGE RecordWildCards #-}
3-
{-# LANGUAGE StandaloneDeriving #-}
43

54
{-# LANGUAGE NoMonoLocalBinds #-}
65

@@ -99,7 +98,7 @@ runContinuation plId cont state (fc, b) = do
9998
res <- c_runCommand cont env args fc b
10099

101100
-- This block returns a maybe error.
102-
fmap (maybe (Right $ A.Null) Left . coerce . foldMap Last) $
101+
fmap (maybe (Right A.Null) Left . coerce . foldMap Last) $
103102
for res $ \case
104103
ErrorMessages errs -> do
105104
traverse_ showUserFacingMessage errs
@@ -119,7 +118,7 @@ runContinuation plId cont state (fc, b) = do
119118
}
120119
Right edits -> do
121120
sendEdits edits
122-
pure $ Nothing
121+
pure Nothing
123122

124123

125124
------------------------------------------------------------------------------

‎plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -161,8 +161,8 @@ graftDecl dflags dst ix make_decl (L src (AMatch (FunRhs (L _ name) _ _) pats _)
161161
| dst `isSubspanOf` src = do
162162
L _ dec <- annotateDecl dflags $ make_decl name pats
163163
case dec of
164-
ValD _ (FunBind { fun_matches = MG { mg_alts = L _ alts@(first_match : _)}
165-
}) -> do
164+
ValD _ FunBind{ fun_matches = MG { mg_alts = L _ alts@(first_match : _)}
165+
} -> do
166166
-- For whatever reason, ExactPrint annotates newlines to the ends of
167167
-- case matches and type signatures, but only allows us to insert
168168
-- them at the beginning of those things. Thus, we need want to

‎plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -105,5 +105,5 @@ splitToDecl fixity name ams = do
105105
iterateSplit :: AgdaMatch -> [AgdaMatch]
106106
iterateSplit am =
107107
let iterated = iterate (agdaSplit =<<) $ pure am
108-
in fmap wildify . head . drop 5 $ iterated
108+
in fmap wildify . (!! 5) $ iterated
109109

‎plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs

+4-7
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,6 @@
22
{-# LANGUAGE OverloadedLabels #-}
33
{-# LANGUAGE OverloadedStrings #-}
44
{-# LANGUAGE TupleSections #-}
5-
{-# LANGUAGE TypeApplications #-}
65

76
module Wingman.CodeGen
87
( module Wingman.CodeGen
@@ -141,8 +140,7 @@ mkDestructPat already_in_scope con names
141140
in (names', )
142141
$ ConPatIn (noLoc $ Unqual $ occName $ conLikeName con)
143142
$ RecCon
144-
$ HsRecFields rec_fields
145-
$ Nothing
143+
$ HsRecFields rec_fields Nothing
146144
| otherwise =
147145
(names, ) $ infixifyPatIfNecessary con $
148146
conP
@@ -208,7 +206,7 @@ patSynExTys ps = patSynExTyVars ps
208206

209207
destruct' :: Bool -> (ConLike -> Judgement -> Rule) -> HyInfo CType -> Judgement -> Rule
210208
destruct' use_field_puns f hi jdg = do
211-
when (isDestructBlacklisted jdg) $ cut -- throwError NoApplicableTactic
209+
when (isDestructBlacklisted jdg) cut -- throwError NoApplicableTactic
212210
let term = hi_name hi
213211
ext
214212
<- destructMatches
@@ -227,7 +225,7 @@ destruct' use_field_puns f hi jdg = do
227225
-- resulting matches.
228226
destructLambdaCase' :: Bool -> (ConLike -> Judgement -> Rule) -> Judgement -> Rule
229227
destructLambdaCase' use_field_puns f jdg = do
230-
when (isDestructBlacklisted jdg) $ cut -- throwError NoApplicableTactic
228+
when (isDestructBlacklisted jdg) cut -- throwError NoApplicableTactic
231229
let g = jGoal jdg
232230
case splitFunTy_maybe (unCType g) of
233231
Just (arg, _) | isAlgType arg ->
@@ -320,8 +318,7 @@ nonrecLet occjdgs jdg = do
320318
occexts <- traverse newSubgoal $ fmap snd occjdgs
321319
ctx <- ask
322320
ext <- newSubgoal
323-
$ introduce ctx (userHypothesis $ fmap (second jGoal) occjdgs)
324-
$ jdg
321+
$ introduce ctx (userHypothesis $ fmap (second jGoal) occjdgs) jdg
325322
pure $ fmap noLoc $
326323
let'
327324
<$> traverse

‎plugins/hls-tactics-plugin/src/Wingman/Debug.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ module Wingman.Debug
1717

1818
import Control.DeepSeq
1919
import Control.Exception
20+
import Data.Either (fromRight)
2021
import qualified Debug.Trace
2122
import Development.IDE.GHC.Compat (PlainGhcException, Outputable(..), SDoc, showSDocUnsafe)
2223
import System.IO.Unsafe (unsafePerformIO)
@@ -33,7 +34,7 @@ unsafeRender' sdoc = unsafePerformIO $ do
3334
-- We might not have unsafeGlobalDynFlags (like during testing), in which
3435
-- case GHC panics. Instead of crashing, let's just fail to print.
3536
!res <- try @PlainGhcException $ evaluate $ deepseq z z
36-
pure $ either (const "<unsafeRender'>") id res
37+
pure $ fromRight "<unsafeRender'>" res
3738
{-# NOINLINE unsafeRender' #-}
3839

3940
traceMX :: (Monad m, Show a) => String -> a -> m ()

‎plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs

+5-6
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,7 @@ import Data.Maybe
1717
import Data.Monoid
1818
import qualified Data.Text as T
1919
import Data.Traversable
20-
import Development.IDE (hscEnv)
21-
import Development.IDE (realSrcSpanToRange)
20+
import Development.IDE (hscEnv, realSrcSpanToRange)
2221
import Development.IDE.Core.RuleTypes
2322
import Development.IDE.Core.Shake (IdeState (..))
2423
import Development.IDE.Core.UseStale
@@ -81,7 +80,7 @@ emptyCaseInteraction = Interaction $
8180
, edits
8281
)
8382
)
84-
$ (\ _ _ _ we -> pure $ pure $ RawEdit we)
83+
(\ _ _ _ we -> pure $ pure $ RawEdit we)
8584

8685

8786
scrutinzedType :: EmptyCaseSort Type -> Maybe Type
@@ -115,9 +114,9 @@ graftMatchGroup
115114
-> Graft (Either String) ParsedSource
116115
graftMatchGroup ss l =
117116
hoistGraft (runExcept . runExceptString) $ graftExprWithM ss $ \case
118-
L span (HsCase ext scrut mg@_) -> do
117+
L span (HsCase ext scrut mg) -> do
119118
pure $ Just $ L span $ HsCase ext scrut $ mg { mg_alts = l }
120-
L span (HsLamCase ext mg@_) -> do
119+
L span (HsLamCase ext mg) -> do
121120
pure $ Just $ L span $ HsLamCase ext $ mg { mg_alts = l }
122121
(_ :: LHsExpr GhcPs) -> pure Nothing
123122

@@ -165,6 +164,6 @@ data EmptyCaseSort a
165164
emptyCaseQ :: GenericQ [(SrcSpan, EmptyCaseSort (HsExpr GhcTc))]
166165
emptyCaseQ = everything (<>) $ mkQ mempty $ \case
167166
L new_span (Case scrutinee []) -> pure (new_span, EmptyCase scrutinee)
168-
L new_span (expr@(LamCase [])) -> pure (new_span, EmptyLamCase expr)
167+
L new_span expr@(LamCase []) -> pure (new_span, EmptyLamCase expr)
169168
(_ :: LHsExpr GhcTc) -> mempty
170169

‎plugins/hls-tactics-plugin/src/Wingman/GHC.hs

+6-9
Original file line numberDiff line numberDiff line change
@@ -96,10 +96,7 @@ freshTyvars t = do
9696
pure (tv, setTyVarUnique tv uniq)
9797
pure $
9898
everywhere
99-
(mkT $ \tv ->
100-
case M.lookup tv reps of
101-
Just tv' -> tv'
102-
Nothing -> tv
99+
(mkT $ \tv -> M.findWithDefault tv tv reps
103100
) $ snd $ tcSplitForAllTyVars t
104101

105102

@@ -195,7 +192,7 @@ pattern SingleLet bind pats val expr <-
195192
HsLet _
196193
(L _ (HsValBinds _
197194
(ValBinds _ (bagToList ->
198-
[(L _ (FunBind _ (L _ bind) (MG _ (L _ [L _ (AMatch _ pats val)]) _) _ _))]) _)))
195+
[L _ (FunBind _ (L _ bind) (MG _ (L _ [L _ (AMatch _ pats val)]) _) _ _)]) _)))
199196
(L _ expr)
200197

201198

@@ -204,7 +201,7 @@ pattern SingleLet bind pats val expr <-
204201
pattern Lambda :: [Pat GhcPs] -> HsExpr GhcPs -> HsExpr GhcPs
205202
pattern Lambda pats body <-
206203
HsLam _
207-
(MG {mg_alts = L _ [L _ (AMatch _ pats body) ]})
204+
MG {mg_alts = L _ [L _ (AMatch _ pats body) ]}
208205
where
209206
-- If there are no patterns to bind, just stick in the body
210207
Lambda [] body = body
@@ -232,7 +229,7 @@ pattern SinglePatMatch pat body <-
232229
unpackMatches :: PatCompattable p => [Match p (LHsExpr p)] -> Maybe [(Pat p, LHsExpr p)]
233230
unpackMatches [] = Just []
234231
unpackMatches (SinglePatMatch pat body : matches) =
235-
(:) <$> pure (pat, body) <*> unpackMatches matches
232+
((pat, body):) <$> unpackMatches matches
236233
unpackMatches _ = Nothing
237234

238235

@@ -241,14 +238,14 @@ unpackMatches _ = Nothing
241238
pattern Case :: PatCompattable p => HsExpr p -> [(Pat p, LHsExpr p)] -> HsExpr p
242239
pattern Case scrutinee matches <-
243240
HsCase _ (L _ scrutinee)
244-
(MG {mg_alts = L _ (fmap unLoc -> unpackMatches -> Just matches)})
241+
MG {mg_alts = L _ (fmap unLoc -> unpackMatches -> Just matches)}
245242

246243
------------------------------------------------------------------------------
247244
-- | Like 'Case', but for lambda cases.
248245
pattern LamCase :: PatCompattable p => [(Pat p, LHsExpr p)] -> HsExpr p
249246
pattern LamCase matches <-
250247
HsLamCase _
251-
(MG {mg_alts = L _ (fmap unLoc -> unpackMatches -> Just matches)})
248+
MG {mg_alts = L _ (fmap unLoc -> unpackMatches -> Just matches)}
252249

253250

254251
------------------------------------------------------------------------------

0 commit comments

Comments
 (0)