Hlint fixes.

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,16 @@
 - ignore: {name: "Use uncurry"}
 - ignore: {name: "Avoid lambda using `infix`"}
 
+# 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 +116,7 @@
   # Things that are unsafe in Haskell base library
   - {name: unsafeInterleaveIO, within: []}
   - {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

@@ -120,7 +120,7 @@ setInitialDynFlags = 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
   dynFlags <- mapM dynFlagsForPrinting libdir
   mapM_ setUnsafeGlobalDynFlags dynFlags

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/Types.hs

@@ -55,6 +55,8 @@ type Loc = Located Line
 
 type Line = Int
 
+{- HLINT ignore locate "Use zipWithFrom" -}
+
 locate :: Loc [a] -> [Loc a]
 locate (Located l tst) = zipWith Located [l ..] tst
 

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)

plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs

@@ -27,6 +27,7 @@ import           Data.Functor ((<&>))
 import           Data.Generics.Aliases (mkQ)
 import           Data.Generics.Schemes (everything)
 import           Data.List
+import           Data.List.Extra (enumerate)
 import           Data.Map (Map)
 import qualified Data.Map as M
 import           Data.Maybe
@@ -75,7 +76,7 @@ descriptor plId = (defaultPluginDescriptor plId)
               (tcCommandId tc)
               (tacticDesc $ tcCommandName tc)
               (tacticCmd $ commandTactic tc))
-              [minBound .. maxBound]
+            (enumerate :: [TacticCommand])
     , pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionProvider
     }
 
@@ -173,7 +174,7 @@ codeActionProvider state plId (CodeActionParams _ _ (TextDocumentIdentifier uri)
         (_, jdg, _, dflags) <- judgementForHole state nfp range
         actions <- lift $
           -- This foldMap is over the function monoid.
-          foldMap commandProvider [minBound .. maxBound]
+          foldMap commandProvider (enumerate :: [TacticCommand])
             dflags
             plId
             uri
@@ -207,19 +208,19 @@ provide tc name _ plId uri range _ = do
 -- predicate holds for the goal.
 requireExtension :: Extension -> TacticProvider -> TacticProvider
 requireExtension ext tp dflags plId uri range jdg =
-  case xopt ext dflags of
-    True  -> tp dflags plId uri range jdg
-    False -> pure []
+  if xopt ext dflags
+    then tp dflags plId uri range jdg
+    else pure []
 
 
 ------------------------------------------------------------------------------
 -- | Restrict a 'TacticProvider', making sure it appears only when the given
 -- predicate holds for the goal.
 filterGoalType :: (Type -> Bool) -> TacticProvider -> TacticProvider
 filterGoalType p tp dflags plId uri range jdg =
-  case p $ unCType $ jGoal jdg of
-    True  -> tp dflags plId uri range jdg
-    False -> pure []
+  if p $ unCType $ jGoal jdg
+    then tp dflags plId uri range jdg
+    else pure []
 
 
 ------------------------------------------------------------------------------
@@ -234,9 +235,9 @@ filterBindingType p tp dflags plId uri range jdg =
       g  = jGoal jdg
    in fmap join $ for (unHypothesis hy) $ \hi ->
         let ty = unCType $ hi_type hi
-         in case p (unCType g) ty of
-              True  -> tp (hi_name hi) ty dflags plId uri range jdg
-              False -> pure []
+         in if p (unCType g) ty
+              then tp (hi_name hi) ty dflags plId uri range jdg
+              else pure []
 
 
 data TacticParams = TacticParams

plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TupleSections    #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ViewPatterns     #-}
 
 module Ide.Plugin.Tactic.CodeGen
   ( module Ide.Plugin.Tactic.CodeGen
@@ -202,4 +201,3 @@ buildDataCon jdg dc tyapps = do
   pure
     . (rose (show dc) $ pure tr,)
     $ mkCon dc sgs
-