Hlint hints. (haskell#1227)

Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>

Author: peterwicksstringfield

GenChangelogs.hs

@@ -24,7 +24,7 @@ main = do
 
   prs <- github' $ pullRequestsForR "haskell" "haskell-language-server" stateClosed FetchAll
   let prsAfterLastTag = either (error . show)
-                        (foldMap (\pr -> if inRange pr then [pr] else []))
+                        (foldMap (\pr -> [pr | inRange pr]))
                         prs
       inRange pr
         | Just mergedDate <- simplePullRequestMergedAt pr = mergedDate > lastDate

ghcide/.hlint.yaml

@@ -11,7 +11,6 @@
 - ignore: {name: "Redundant do"}
 - ignore: {name: "Avoid lambda"}
 - ignore: {name: "Use newtype instead of data"}
-- ignore: {name: "Use fromMaybe"}
 - ignore: {name: "Use unless"}
 - ignore: {name: "Move brackets to avoid $"}
 - ignore: {name: "Eta reduce"}
@@ -25,6 +24,21 @@
 - ignore: {name: "Use uncurry"}
 - ignore: {name: "Avoid lambda using `infix`"}
 
+# Gives at least one suggestion we don't like.
+- ignore: {name: "Use <=<"}
+- ignore: {name: "Use zipFrom"}
+- ignore: {name: "Use zipWithFrom"}
+
+# We are using the "redundant" return/pure to assign a name. We do not want to
+# delete it. In particular, this is not an improvement:
+# Found:
+#   do options <- somethingComplicated
+#      pure options
+# Perhaps:
+#   do somethingComplicated
+- ignore: {name: "Redundant return"}
+- ignore: {name: "Redundant pure"}
+
 # Off by default hints we like
 - warn: {name: Use module export list}
 
@@ -107,7 +121,7 @@
   # Things that are unsafe in Haskell base library
   - {name: unsafeInterleaveIO, within: [Development.IDE.LSP.LanguageServer]}
   - {name: unsafeDupablePerformIO, within: []}
-  - {name: unsafeCoerce, within: []}
+  - {name: unsafeCoerce, within: [Ide.Plugin.Eval.Code]}
   # Things that are a bit dangerous in the GHC API
   - {name: nameModule, within: []}
 

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

@@ -123,7 +123,7 @@ getInitialGhcLibDirDefault = do
         hPutStrLn stderr $ "Couldn't load cradle for libdir: " ++ show (err,dir,hieYaml,cradle)
         pure Nothing
       CradleNone -> do
-        hPutStrLn stderr $ "Couldn't load cradle (CradleNone)"
+        hPutStrLn stderr "Couldn't load cradle (CradleNone)"
         pure Nothing
 
 -- | Sets `unsafeGlobalDynFlags` on using the hie-bios cradle and returns the GHC libdir

ghcide/src/Development/IDE/GHC/ExactPrint.hs

@@ -5,8 +5,6 @@
 {-# LANGUAGE RankNTypes         #-}
 {-# LANGUAGE TypeFamilies       #-}
 
-{- HLINT ignore "Use zipFrom" -}
-
 module Development.IDE.GHC.ExactPrint
     ( Graft(..),
       graft,

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

@@ -158,7 +158,7 @@ documentHighlight hf rf pos = pure highlights
     ns = concat $ pointCommand hf pos (rights . M.keys . nodeIdentifiers . nodeInfo)
     highlights = do
       n <- ns
-      ref <- maybe [] id (M.lookup (Right n) rf)
+      ref <- fromMaybe [] (M.lookup (Right n) rf)
       pure $ makeHighlight ref
     makeHighlight (sp,dets) =
       DocumentHighlight (realSrcSpanToRange sp) (Just $ highlightType $ identInfo dets)
@@ -266,12 +266,12 @@ typeLocationsAtPoint hiedb lookupModule _ideOptions pos (HAR _ ast _ _ hieKind)
             HQualTy a b -> getTypes [a,b]
             HCastTy a -> getTypes [a]
             _ -> []
-        in fmap nubOrd $ concatMapM (fmap (maybe [] id) . nameToLocation hiedb lookupModule) (getTypes ts)
+        in fmap nubOrd $ concatMapM (fmap (fromMaybe []) . nameToLocation hiedb lookupModule) (getTypes ts)
     HieFresh ->
       let ts = concat $ pointCommand ast pos getts
           getts x = nodeType ni  ++ (mapMaybe identType $ M.elems $ nodeIdentifiers ni)
             where ni = nodeInfo x
-        in fmap nubOrd $ concatMapM (fmap (maybe [] id) . nameToLocation hiedb lookupModule) (getTypes ts)
+        in fmap nubOrd $ concatMapM (fmap (fromMaybe []) . nameToLocation hiedb lookupModule) (getTypes ts)
 
 namesInType :: Type -> [Name]
 namesInType (TyVarTy n)      = [Var.varName n]

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

@@ -135,7 +135,7 @@ clientSupportsDocumentChanges caps =
         WorkspaceEditClientCapabilities mDc _ _ <- _workspaceEdit wCaps
         mDc
   in
-    fromMaybe False supports
+    Just True == supports
 
 -- ---------------------------------------------------------------------
 
@@ -214,7 +214,7 @@ allLspCmdIds' pid mp = mkPlugin (allLspCmdIds pid) (Just . pluginCommands)
 
 
 allLspCmdIds :: T.Text -> [(PluginId, [PluginCommand ideState])] -> [T.Text]
-allLspCmdIds pid commands = concat $ map go commands
+allLspCmdIds pid commands = concatMap go commands
   where
     go (plid, cmds) = map (mkLspCmdId pid plid . commandId) cmds
 

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

@@ -1,7 +1,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ViewPatterns #-}

install/src/Cabal.hs

@@ -96,7 +96,7 @@ getProjectFile ver = do
             else "cabal.project"
 
 checkCabal_ :: [String] -> Action ()
-checkCabal_ args = checkCabal args >> return ()
+checkCabal_ args = void $ checkCabal args
 
 -- | check `cabal` has the required version
 checkCabal :: [String] -> Action String

install/src/Env.hs

@@ -54,7 +54,7 @@ findInstalledGhcs = do
     -- sort by version to make it coherent with getHlsVersions
     $ sortBy (comparing fst)
     -- nub by version. knownGhcs takes precedence.
-    $ nubBy ((==) `on` fst)
+    $ nubOrdBy (compare `on` fst)
     -- filter out stack provided GHCs (assuming that stack programs path is the default one in linux)
     $ filter (not . isInfixOf ".stack" . snd) (knownGhcs ++ availableGhcs)
 

install/src/Print.hs

@@ -25,7 +25,7 @@ printInStars = liftIO . putStrLn . embedInStars
 
 -- | Trim whitespace of both ends of a string
 trim :: String -> String
-trim = dropWhileEnd isSpace . dropWhile isSpace
+trim = trimEnd . trimStart
 
 -- | Trim the whitespace of the stdout of a command
 trimmedStdout :: Stdout String -> String

plugins/default/src/Ide/Plugin/Fourmolu.hs

@@ -93,7 +93,7 @@ provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable
 
 convertDynFlags :: DynFlags -> IO [DynOption]
 convertDynFlags df =
-    let pp = if null p then [] else ["-pgmF=" <> p]
+    let pp = ["-pgmF=" <> p | not (null p)]
         p = D.sPgm_F $ D.settings df
         pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df
         ex = map showExtension $ S.toList $ D.extensionFlags df

plugins/default/src/Ide/Plugin/Ormolu.hs

@@ -44,7 +44,7 @@ provider ideState typ contents fp _ = withIndefiniteProgress title Cancellable $
       let
         pp =
           let p = D.sPgm_F $ D.settings df
-          in  if null p then [] else ["-pgmF=" <> p]
+          in  ["-pgmF=" <> p | not (null p)]
         pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df
         ex = map showExtension $ S.toList $ D.extensionFlags df
       in

plugins/default/src/Ide/Plugin/Pragmas.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE DeriveAnyClass        #-}
-{-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE ViewPatterns          #-}
@@ -12,6 +10,7 @@ module Ide.Plugin.Pragmas
 
 import           Control.Lens                    hiding (List)
 import qualified Data.HashMap.Strict             as H
+import           Data.Maybe                      (catMaybes)
 import qualified Data.Text                       as T
 import           Development.IDE                 as D
 import           Ide.Types
@@ -78,7 +77,7 @@ codeActionProvider state _plId (CodeActionParams _ _ docId _ (J.CodeActionContex
             disabled
               | Just dynFlags <- mDynflags
                 -- GHC does not export 'OnOff', so we have to view it as string
-              = [ e | Just e <- T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags]
+              = catMaybes $ T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags
               | otherwise
                 -- When the module failed to parse, we don't have access to its
                 -- dynFlags. In that case, simply don't disable any pragmas.

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

@@ -1,8 +1,6 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE ExtendedDefaultRules #-}
 {-# LANGUAGE FlexibleContexts #-}

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

@@ -15,6 +15,7 @@ module Ide.Plugin.Eval.Util (
     logWith,
 ) where
 
+import Control.Monad.Extra (maybeM)
 import Control.Monad.IO.Class (MonadIO (liftIO))
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Except (
@@ -84,7 +85,7 @@ handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
 handleMaybe msg = maybe (throwE msg) return
 
 handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
-handleMaybeM msg act = maybe (throwE msg) return =<< lift act
+handleMaybeM msg act = maybeM (throwE msg) return $ lift act
 
 response :: Functor f => ExceptT String f c -> f (Either ResponseError c)
 response =

plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs

@@ -278,7 +278,7 @@ codeActionProvider ideState plId (CodeActionParams _ _ docId _ context) = Right
         in LSP.CodeAction "Apply all hints" (Just LSP.CodeActionQuickFix) Nothing Nothing Nothing Nothing (Just cmd)
 
     applyOneActions :: [LSP.CodeAction]
-    applyOneActions = catMaybes $ map mkHlintAction (filter validCommand diags)
+    applyOneActions = mapMaybe mkHlintAction (filter validCommand diags)
 
     -- |Some hints do not have an associated refactoring
     validCommand (LSP.Diagnostic _ _ (Just (InR code)) (Just "hlint") _ _ _) =

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

@@ -20,6 +20,7 @@ import           Control.Concurrent.Extra       (readVar)
 import           Control.Exception.Safe         (Exception (..), SomeException,
                                                  catch, throwIO, try)
 import           Control.Monad                  (forM, unless)
+import           Control.Monad.Extra            (maybeM)
 import           Control.Monad.IO.Class         (MonadIO (liftIO))
 import           Control.Monad.Trans.Class      (MonadTrans (lift))
 import           Control.Monad.Trans.Except     (ExceptT (..), runExceptT,
@@ -146,14 +147,14 @@ extractImports ModSummary{ms_mod} topLevelBinds (Unfold thing)
   , names <- listify p fun_matches
   =
     [ AddImport {..}
-    | name <- names,
-        Just ideclNameString <-
-        [moduleNameString . GHC.moduleName <$> nameModule_maybe name],
-        let ideclSource = False,
+    | let ideclSource = False,
+        name <- names,
         let r = nameRdrName name,
         let ideclQualifiedBool = isQual r,
         let ideclAsString = moduleNameString . fst <$> isQual_maybe r,
-        let ideclThing = Just (IEVar $ occNameString $ rdrNameOcc r)
+        let ideclThing = Just (IEVar $ occNameString $ rdrNameOcc r),
+        Just ideclNameString <-
+        [moduleNameString . GHC.moduleName <$> nameModule_maybe name]
     ]
     where
         p name = nameModule_maybe name /= Just ms_mod
@@ -178,8 +179,8 @@ provider state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) range ca)
           ++ [ r
                | TyClGroup {group_tyclds} <- hs_tyclds,
                  L l g <- group_tyclds,
-                 r <- suggestTypeRewrites uri ms_mod g,
-                 pos `isInsideSrcSpan` l
+                 pos `isInsideSrcSpan` l,
+                 r <- suggestTypeRewrites uri ms_mod g
 
              ]
 
@@ -235,7 +236,6 @@ suggestBindRewrites originatingFile pos ms_mod FunBind {fun_id = L l' rdrName}
               description = "Fold " <> pprNameText <> describeRestriction restrictToOriginatingFile
            in (description, CodeActionRefactorExtract, RunRetrieParams {..})
      in [unfoldRewrite False, unfoldRewrite True, foldRewrite False, foldRewrite True]
-  where
 suggestBindRewrites _ _ _ _ = []
 
 describeRestriction :: IsString p => Bool -> p
@@ -409,9 +409,7 @@ callRetrie state session rewrites origin restrictToOriginatingFile = do
     -- TODO add the imports to the resulting edits
     (_user, ast, change@(Change _replacements _imports)) <-
       lift $ runRetrie fixityEnv retrie cpp
-    case ast of
-      _ ->
-        return $ asTextEdits change
+    return $ asTextEdits change
 
   let (errors :: [CallRetrieError], replacements) = partitionEithers results
       editParams :: WorkspaceEdit
@@ -485,7 +483,7 @@ handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
 handleMaybe msg = maybe (throwE msg) return
 
 handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
-handleMaybeM msg act = maybe (throwE msg) return =<< lift act
+handleMaybeM msg act = maybeM (throwE msg) return $ lift act
 
 response :: Monad m => ExceptT String m a -> m (Either ResponseError a)
 response =

plugins/hls-splice-plugin/hls-splice-plugin.cabal

@@ -18,6 +18,7 @@ library
   build-depends:    aeson
                   , base       >=4.12 && <5
                   , containers
+                  , extra
                   , foldl
                   , lsp
                   , hls-plugin-api

plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

@@ -25,6 +25,7 @@ import Control.Arrow
 import qualified Control.Foldl as L
 import Control.Lens (ix, view, (%~), (<&>), (^.))
 import Control.Monad
+import Control.Monad.Extra (eitherM)
 import qualified Control.Monad.Fail as Fail
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Except
@@ -324,8 +325,8 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e
                                 graftDeclsWithM (RealSrcSpan srcSpan) $ \case
                                     (L _spn (SpliceD _ (SpliceDecl _ (L _ spl) _))) -> do
                                         eExpr <-
-                                            either (fail . show) pure
-                                                =<< lift
+                                            eitherM (fail . show) pure
+                                                $ lift
                                                     ( lift $
                                                         gtry @_ @SomeException $
                                                             (fst <$> rnTopSpliceDecls spl)
@@ -337,8 +338,8 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e
                                 graftWithM (RealSrcSpan srcSpan) $ \case
                                     (L _spn (matchSplice astP -> Just spl)) -> do
                                         eExpr <-
-                                            either (fail . show) pure
-                                                =<< lift
+                                            eitherM (fail . show) pure
+                                                $ lift
                                                     ( lift $
                                                         gtry @_ @SomeException $
                                                             (fst <$> expandSplice astP spl)

src/Ide/Main.hs

@@ -5,10 +5,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE NamedFieldPuns #-}
 
 module Ide.Main(defaultMain, runLspMode) where
 

test/functional/Progress.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE GADTs #-}
 
 module Progress (tests) where
@@ -106,9 +105,9 @@ expectProgressReports xs = expectProgressReports' [] xs
                 EndM msg -> do
                     liftIO $ token msg `expectElem` tokens
                     expectProgressReports' (delete (token msg) tokens) expectedTitles
-    title msg = msg ^. L.value ^. L.title
+    title msg = msg ^. L.value . L.title
     token msg = msg ^. L.token
-    create = CreateM . view L.params <$> (message SWindowWorkDoneProgressCreate)
+    create = CreateM . view L.params <$> message SWindowWorkDoneProgressCreate
     begin = BeginM <$> satisfyMaybe (\case
       FromServerMess SProgress (NotificationMessage _ _ (ProgressParams t (Begin x))) -> Just (ProgressParams t x)
       _ -> Nothing)

test/functional/Reference.hs

@@ -25,7 +25,7 @@ tests = testGroup "references" [
             , mkRange 4 14 4 17
             , mkRange 4 0 4 3
             , mkRange 2 6 2 9
-            ] `isInfixOf` (coerce refs) @? "Contains references"
+            ] `isInfixOf` coerce refs @? "Contains references"
     -- TODO: Respect withDeclaration parameter
     -- ignoreTestBecause "Broken" $ testCase "works without definitions" $ runSession hlsCommand fullCaps "test/testdata" $ do
     --   doc <- openDoc "References.hs" "haskell"

test/functional/Tactic.hs

@@ -150,7 +150,7 @@ mkTest name fp line col ts =
     for_ ts $ \(f, tc, var) -> do
       let title = tacticTitle tc var
       liftIO $
-        f (elem title titles)
+        f (title `elem` titles)
           @? ("Expected a code action with title " <> T.unpack title)
 
 

test/utils/Test/Hls/Util.hs

@@ -173,6 +173,7 @@ logFilePath = "hls-" ++ show ghcVersion ++ ".log"
 -- on PATH. Cabal seems to respond to @build-tool-depends@ specifically while
 -- stack just puts all project executables on PATH.
 hlsCommand :: String
+{-# NOINLINE hlsCommand #-}
 hlsCommand = unsafePerformIO $ do
   testExe <- fromMaybe "haskell-language-server" <$> lookupEnv "HLS_TEST_EXE"
   pure $ testExe ++ " --lsp -d -j2 -l test-logs/" ++ logFilePath