hlint 3.6.1 → 3.8

raw patch · 29 files changed

+257/−74 lines, 29 filesdep ~ghcdep ~ghc-lib-parserdep ~ghc-lib-parser-exPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc, ghc-lib-parser, ghc-lib-parser-ex

API changes (from Hackage documentation)

Files

• CHANGES.txt +7/−0
• LICENSE +1/−1
• README.md +1/−1
• data/hlint.yaml +10/−4
• data/import_style.yaml +2/−0
• hlint.cabal +8/−7
• src/Apply.hs +1/−1
• src/CmdLine.hs +5/−3
• src/Config/Yaml.hs +3/−2
• src/GHC/All.hs +6/−4
• src/GHC/Util/ApiAnnotation.hs +15/−3
• src/GHC/Util/FreeVars.hs +4/−4
• src/GHC/Util/HsExpr.hs +3/−3
• src/Hint/All.hs +3/−1
• src/Hint/Export.hs +2/−2
• src/Hint/Extensions.hs +6/−3
• src/Hint/Lambda.hs +2/−1
• src/Hint/List.hs +9/−8
• src/Hint/ListRec.hs +1/−1
• src/Hint/Monad.hs +1/−1
• src/Hint/Naming.hs +1/−1
• src/Hint/Negation.hs +62/−0
• src/Hint/NumLiteral.hs +9/−6
• src/Hint/Pragma.hs +1/−1
• src/Hint/Restrict.hs +24/−11
• src/Hint/Unsafe.hs +4/−2
• src/Refact.hs +2/−1
• src/Summary.hs +3/−2
• tests/import_style.test +61/−0

@@ -1,5 +1,12 @@ Changelog for HLint (* = breaking change) +3.8, released 2024-01-15+    #1552, make --git and --ignore-glob work nicely together+    #1502, fix incorrect free variable calculation in some cases+    #1555, slightly more efficient concatMap usages (e.g. pull filter out)+    #1500, suggest avoiding NonEmpty.unzip (use Functor.unzip)+*   #1544, upgrade to GHC 9.8+    #1540, correct Functor law hint, was missing brackets 3.6.1, released 2023-07-03     Attempt to make a binary release 3.6, released 2023-06-26

@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2006-2023.+Copyright Neil Mitchell 2006-2024. All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,4 +1,4 @@-# HLint [![Hackage version](https://img.shields.io/hackage/v/hlint.svg?label=Hackage)](https://hackage.haskell.org/package/hlint) [![Stackage version](https://www.stackage.org/package/hlint/badge/nightly?label=Stackage)](https://www.stackage.org/package/hlint) [![Build status](https://img.shields.io/github/workflow/status/ndmitchell/hlint/ci/master.svg)](https://github.com/ndmitchell/hlint/actions)+# HLint [![Hackage version](https://img.shields.io/hackage/v/hlint.svg?label=Hackage)](https://hackage.haskell.org/package/hlint) [![Stackage version](https://www.stackage.org/package/hlint/badge/nightly?label=Stackage)](https://www.stackage.org/package/hlint) [![Build status](https://img.shields.io/github/actions/workflow/status/ndmitchell/hlint/ci.yml?branch=master)](https://github.com/ndmitchell/hlint/actions)  HLint is a tool for suggesting possible improvements to Haskell code. These suggestions include ideas such as using alternative functions, simplifying code and spotting redundancies. This document is structured as follows: 

@@ -214,6 +214,7 @@     - hint: {lhs: map f (zip x y), rhs: zipWith (curry f) x y, side: not (isApp f)}     - hint: {lhs: "map f (fromMaybe [] x)", rhs: "maybe [] (map f) x"}     - hint: {lhs: "concatMap f (fromMaybe [] x)", rhs: "maybe [] (concatMap f) x"}+    - hint: {lhs: "concat (fromMaybe [] x)", rhs: "maybe [] concat x"}     - warn: {lhs: not (elem x y), rhs: notElem x y}     - warn: {lhs: not (notElem x y), rhs: elem x y}     - hint: {lhs: foldr f z (map g x), rhs: foldr (f . g) z x, name: Fuse foldr/map}@@ -472,11 +473,12 @@     # FUNCTOR      - warn: {lhs: fmap f (fmap g x), rhs: fmap (f . g) x, name: Functor law}-    - warn: {lhs: f <$> g <$> x, rhs: f . g <$> x, name: Functor law}+    - warn: {lhs: f <$> (g <$> x), rhs: f . g <$> x, name: Functor law}     - warn: {lhs: x <&> g <&> f, rhs: x <&> f . g, name: Functor law}     - warn: {lhs: fmap id, rhs: id, name: Functor law}     - warn: {lhs: id <$> x, rhs: x, name: Functor law}     - warn: {lhs: x <&> id, rhs: x, name: Functor law}+    - warn: {lhs: f <$> g <$> x, rhs: f . g <$> x}     - hint: {lhs: fmap f $ x, rhs: f <$> x, side: isApp x || isAtom x}     - hint: {lhs: \x -> a <$> b x, rhs: fmap a . b}     - hint: {lhs: \x -> b x <&> a, rhs: fmap a . b}@@ -670,6 +672,7 @@     - hint: {lhs: "\\x y z -> (x, y, z)", rhs: "(,,)"}     - hint: {lhs: "(,b) a", rhs: "(a,b)", side: isAtom a, name: Evaluate}     - hint: {lhs: "(a,) b", rhs: "(a,b)", side: isAtom b, name: Evaluate}+    - warn: {lhs: "Data.List.NonEmpty.unzip", rhs: "Data.Functor.unzip", name: "Avoid NonEmpty.unzip", note: "The function is being deprecated"}      # MAYBE @@ -878,9 +881,12 @@     - warn: {lhs: all f (concatMap g x), rhs: all (all f . g) x}     - warn: {lhs: fold (concatMap f x), rhs: foldMap (fold . f) x}     - warn: {lhs: foldMap f (concatMap g x), rhs: foldMap (foldMap f . g) x}-    - warn: {lhs: catMaybes (concatMap f x), rhs: concatMap (catMaybes . f) x, name: Move concatMap out}-    - hint: {lhs: filter f (concatMap g x), rhs: concatMap (filter f . g) x, name: Move concatMap out}-    - warn: {lhs: mapMaybe f (concatMap g x), rhs: concatMap (mapMaybe f . g) x, name: Move concatMap out}+    - warn: {lhs: catMaybes (concatMap f x), rhs: concatMap (catMaybes . f) x, name: Move catMaybes}+    - warn: {lhs: catMaybes (concat x), rhs: concatMap catMaybes x, name: Move catMaybes}+    - hint: {lhs: filter f (concatMap g x), rhs: concatMap (filter f . g) x, name: Move filter}+    - hint: {lhs: filter f (concat x), rhs: concatMap (filter f) x, name: Move filter}+    - warn: {lhs: mapMaybe f (concatMap g x), rhs: concatMap (mapMaybe f . g) x, name: Move mapMaybe}+    - warn: {lhs: mapMaybe f (concat x), rhs: concatMap (mapMaybe f) x, name: Move mapMaybe}     - warn: {lhs: or (fmap p x), rhs: any p x}     - warn: {lhs: or (p <$> x), rhs: any p x}     - warn: {lhs: or (x <&> p), rhs: any p x}

@@ -4,3 +4,5 @@   - {name: HypotheticalModule3, importStyle: qualified}   - {name: 'HypotheticalModule3.*', importStyle: unqualified}   - {name: 'HypotheticalModule3.OtherSubModule', importStyle: unrestricted, qualifiedStyle: post}+  - {name: HypotheticalModule4, importStyle: qualified, as: HM4, asRequired: true}+  - {name: HypotheticalModule5, importStyle: qualified, qualifiedStyle: post}

@@ -1,13 +1,13 @@ cabal-version:      1.18 build-type:         Simple name:               hlint-version:            3.6.1+version:            3.8 license:            BSD3 license-file:       LICENSE category:           Development author:             Neil Mitchell <ndmitchell@gmail.com> maintainer:         Neil Mitchell <ndmitchell@gmail.com>-copyright:          Neil Mitchell 2006-2023+copyright:          Neil Mitchell 2006-2024 synopsis:           Source code suggestions description:     HLint gives suggestions on how to improve your source code.@@ -36,7 +36,7 @@ extra-doc-files:     README.md     CHANGES.txt-tested-with:        GHC==9.6, GHC==9.4, GHC==9.2+tested-with:        GHC==9.8, GHC==9.6, GHC==9.4  source-repository head     type:     git@@ -81,16 +81,16 @@         deriving-aeson >= 0.2,         filepattern >= 0.1.1 -    if !flag(ghc-lib) && impl(ghc >= 9.6.1) && impl(ghc < 9.7.0)+    if !flag(ghc-lib) && impl(ghc >= 9.8.1) && impl(ghc < 9.9.0)       build-depends:-        ghc == 9.6.*,+        ghc == 9.8.*,         ghc-boot-th,         ghc-boot     else       build-depends:-          ghc-lib-parser == 9.6.*+          ghc-lib-parser == 9.8.*     build-depends:-        ghc-lib-parser-ex >= 9.6.0.0 && < 9.6.1+        ghc-lib-parser-ex >= 9.8.0.0 && < 9.8.1      if flag(gpl)         build-depends: hscolour >= 1.21@@ -159,6 +159,7 @@         Hint.Match         Hint.Monad         Hint.Naming+        Hint.Negation         Hint.NewType         Hint.Pattern         Hint.Pragma

@@ -17,7 +17,7 @@ import Config.Type import Config.Haskell import GHC.Types.SrcLoc-import GHC.Hs+import GHC.Hs hiding (comments) import Language.Haskell.GhclibParserEx.GHC.Hs import Data.HashSet qualified as Set import Prelude

@@ -12,6 +12,7 @@ import Control.Exception.Extra import Data.ByteString qualified as BS import Data.Char+import Data.List.NonEmpty qualified as NE import Data.List.Extra import Data.Maybe import Data.Functor@@ -182,9 +183,9 @@                    ,"To check all Haskell files in 'src' and generate a report type:"                    ,"  hlint src --report"]     ] &= program "hlint" &= verbosity-    &=  summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2023")+    &=  summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2024")     where-        nam xs = nam_ xs &= name [head xs]+        nam xs = nam_ xs &= name [NE.head $ NE.fromList xs]         nam_ xs = def &= explicit &= name xs  -- | Where should we find the configuration files?@@ -278,7 +279,8 @@         pure [x | x <- xs, drop1 (takeExtension x) `elem` exts, not $ avoidFile x]      else do         isFil <- doesFileExist $ p <\> file-        if isFil then pure [p <\> file]+        if isFil then+            pure [p <\> file | not $ ignore $ p <\> file]          else do             res <- getModule p exts file             case res of

@@ -29,6 +29,7 @@ import Config.Type import Data.Either.Extra import Data.Maybe+import Data.List.NonEmpty qualified as NE import Data.List.Extra import Data.Tuple.Extra import Control.Monad.Extra@@ -163,7 +164,7 @@     -- aim to show a smallish but relevant context     dotDot (fromMaybe (encode focus) $ listToMaybe $ dropWhile (\x -> BS.length x > 250) $ map encode contexts)     where-        (steps, contexts) = unzip $ reverse path+        (steps, contexts) = Prelude.unzip $ reverse path         dotDot x = let (a,b) = BS.splitAt 250 x in BS.unpack a ++ (if BS.null b then "" else "...")  parseArray :: Val -> Parser [Val]@@ -235,7 +236,7 @@     case parser defaultParseFlags{enabledExtensions=configExtensions, disabledExtensions=[]} x of         POk _ x -> pure x         PFailed ps ->-          let errMsg = head . bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages ps)+          let errMsg = NE.head . NE.fromList . bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages ps)               msg = showSDoc baseDynFlags $ pprLocMsgEnvelopeDefault errMsg           in parseFail v $ "Failed to parse " ++ msg ++ ", when parsing:\n " ++ x 

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ViewPatterns #-} @@ -14,6 +15,7 @@ import Control.Monad.IO.Class import Util import Data.Char+import Data.List.NonEmpty qualified as NE import Data.List.Extra import Timing import Language.Preprocessor.Cpphs@@ -22,7 +24,7 @@ import Extension import GHC.Data.FastString -import GHC.Hs+import GHC.Hs hiding (comments) import GHC.Types.SrcLoc import GHC.Types.Fixity import GHC.Types.Error@@ -192,12 +194,12 @@     POk s a -> do       let errs = bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages s)       if not $ null errs then-        ExceptT $ parseFailureErr dynFlags str file str errs+        ExceptT $ parseFailureErr dynFlags str file str $ NE.fromList errs       else do         let fixes = fixitiesFromModule a ++ ghcFixitiesFromParseFlags flags         pure $ ModuleEx (applyFixities fixes a)     PFailed s ->-      ExceptT $ parseFailureErr dynFlags str file str $ bagToList . getMessages  $ GhcPsMessage <$> snd (getPsMessages s)+      ExceptT $ parseFailureErr dynFlags str file str $ NE.fromList . bagToList . getMessages  $ GhcPsMessage <$> snd (getPsMessages s)   where     -- If parsing pragmas fails, synthesize a parse error from the     -- error message.@@ -206,7 +208,7 @@       in ParseError (mkSrcSpan loc loc) msg src      parseFailureErr dynFlags ppstr file str errs =-      let errMsg = head errs+      let errMsg = NE.head errs           loc = errMsgSpan errMsg           doc = pprLocMsgEnvelopeDefault errMsg       in ghcFailOpParseModuleEx ppstr file str (loc, doc)

@@ -1,9 +1,15 @@ {-# LANGUAGE ImportQualifiedPost #-}  module GHC.Util.ApiAnnotation (-    comment_, commentText, isCommentMultiline-  , pragmas, flags, languagePragmas-  , mkFlags, mkLanguagePragmas+    comment_+  , commentText+  , GHC.Util.ApiAnnotation.comments+  , isCommentMultiline+  , pragmas+  , flags+  , languagePragmas+  , mkFlags+  , mkLanguagePragmas   , extensions ) where @@ -44,6 +50,12 @@ -- | The comment string with delimiters removed. commentText :: LEpaComment -> String commentText = trimCommentDelims . comment_++-- | Total replacement for the partial `GHC.Parser.Annotation.comments` field of+-- `EpAnn`+comments :: EpAnn ann -> EpAnnComments+comments EpAnn{ GHC.Parser.Annotation.comments = result } = result+comments EpAnnNotUsed = emptyComments  isCommentMultiline :: LEpaComment -> Bool isCommentMultiline (L _ (EpaComment (EpaBlockComment _) _)) = True

@@ -122,8 +122,8 @@   freeVars (L _ (RecordCon _ _ (HsRecFields flds _))) = Set.unions $ map freeVars flds -- Record construction.   freeVars (L _ (RecordUpd _ e flds)) =     case flds of-      Left fs -> Set.unions $ freeVars e : map freeVars fs-      Right ps -> Set.unions $ freeVars e : map freeVars ps+      RegularRecUpdFields _ fs -> Set.unions $ freeVars e : map freeVars fs+      OverloadedRecUpdFields _ ps -> Set.unions $ freeVars e : map freeVars ps   freeVars (L _ (HsMultiIf _ grhss)) = free (allVars grhss) -- Multi-way if.   freeVars (L _ (HsTypedBracket _ e)) = freeVars e   freeVars (L _ (HsUntypedBracket _ (ExpBr _ e))) = freeVars e@@ -174,7 +174,7 @@    freeVars o@(L _ (HsFieldBind _ _ x _)) = freeVars x  instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (AmbiguousFieldOcc GhcPs)) (LocatedA (HsExpr GhcPs)))) where-  freeVars (L _ (HsFieldBind _ x _ True)) = Set.singleton $ rdrNameOcc $ rdrNameAmbiguousFieldOcc $ unLoc x -- a pun+  freeVars (L _ (HsFieldBind _ x _ True)) = Set.singleton $ rdrNameOcc $ ambiguousFieldOccRdrName $ unLoc x -- a pun   freeVars (L _ (HsFieldBind _ _ x _)) = freeVars x  instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) (LocatedA (HsExpr GhcPs)))) where@@ -233,7 +233,7 @@   allVars (L _ (PatSynBind _ PSB{})) = mempty -- Come back to it.  instance AllVars (MatchGroup GhcPs (LocatedA (HsExpr GhcPs))) where-  allVars (MG _ _alts@(L _ alts)) = inVars (foldMap (allVars . m_pats) ms) (allVars (map m_grhss ms))+  allVars (MG _ _alts@(L _ alts)) = foldMap (\m -> inVars (allVars (m_pats m)) (allVars (m_grhss m))) ms     where ms = map unLoc alts  instance AllVars (LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))) where

@@ -58,7 +58,7 @@  -- | @lambda [p0, p1..pn] body@ makes @\p1 p1 .. pn -> body@ lambda :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs-lambda vs body = noLocA $ HsLam noExtField (MG Generated (noLocA [noLocA $ Match EpAnnNotUsed LambdaExpr vs (GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] body] (EmptyLocalBinds noExtField))]))+lambda vs body = noLocA $ HsLam noExtField (MG (Generated DoPmc) (noLocA [noLocA $ Match EpAnnNotUsed LambdaExpr vs (GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] body] (EmptyLocalBinds noExtField))]))  -- | 'paren e' wraps 'e' in parens if 'e' is non-atomic. paren :: LHsExpr GhcPs -> LHsExpr GhcPs@@ -242,7 +242,7 @@   let grhs = noLocA $ GRHS EpAnnNotUsed [] e :: LGRHS GhcPs (LHsExpr GhcPs)       grhss = GRHSs {grhssExt = emptyComments, grhssGRHSs=[grhs], grhssLocalBinds=EmptyLocalBinds noExtField}       match = noLocA $ Match {m_ext=EpAnnNotUsed, m_ctxt=LambdaExpr, m_pats=map strToPat ss, m_grhss=grhss} :: LMatch GhcPs (LHsExpr GhcPs)-      matchGroup = MG {mg_ext=Generated, mg_alts=noLocA [match]}+      matchGroup = MG {mg_ext=Generated DoPmc, mg_alts=noLocA [match]}   in (noLocA $ HsLam noExtField matchGroup, const [])  @@ -252,7 +252,7 @@ replaceBranches (L l (HsIf _ a b c)) = ([b, c], \[b, c] -> L l (HsIf EpAnnNotUsed a b c))  replaceBranches (L s (HsCase _ a (MG FromSource (L l bs)))) =-  (concatMap f bs, L s . HsCase EpAnnNotUsed a . MG Generated . L l . g bs)+  (concatMap f bs, L s . HsCase EpAnnNotUsed a . MG (Generated DoPmc). L l . g bs)   where     f :: LMatch GhcPs (LHsExpr GhcPs) -> [LHsExpr GhcPs]     f (L _ (Match _ CaseAlt _ (GRHSs _ xs _))) = [x | (L _ (GRHS _ _ x)) <- xs]

@@ -21,6 +21,7 @@ import Hint.Bracket import Hint.Fixities import Hint.Naming+import Hint.Negation import Hint.Pattern import Hint.Import import Hint.Export@@ -37,7 +38,7 @@ -- | A list of the builtin hints wired into HLint. --   This list is likely to grow over time. data HintBuiltin =-    HintList | HintListRec | HintMonad | HintLambda | HintFixities |+    HintList | HintListRec | HintMonad | HintLambda | HintFixities | HintNegation |     HintBracket | HintNaming | HintPattern | HintImport | HintExport |     HintPragma | HintExtensions | HintUnsafe | HintDuplicate | HintRestrict |     HintComment | HintNewType | HintSmell | HintNumLiteral@@ -63,6 +64,7 @@     HintNaming     -> decl namingHint     HintBracket    -> decl bracketHint     HintFixities   -> mempty{hintDecl=fixitiesHint}+    HintNegation   -> decl negationParensHint     HintSmell      -> mempty{hintDecl=smellHint,hintModule=smellModuleHint}     HintPattern    -> decl patternHint     HintMonad      -> decl monadHint

@@ -23,7 +23,7 @@ exportHint :: ModuHint exportHint _ (ModuleEx (L s m@HsModule {hsmodName = Just name, hsmodExports = exports}) )   | Nothing <- exports =-      let r = o{ hsmodExports = Just (noLocA [noLocA (IEModuleContents EpAnnNotUsed name)] )} in+      let r = o{ hsmodExports = Just (noLocA [noLocA (IEModuleContents (Nothing, EpAnnNotUsed) name)] )} in       [(ignore "Use module export list" (L s o) (noLoc r) []){ideaNote = [Note "an explicit list is usually better"]}]   | Just (L _ xs) <- exports   , mods <- [x | x <- xs, isMod x]@@ -32,7 +32,7 @@   , exports' <- [x | x <- xs, not (matchesModName modName x)]   , modName `elem` names =       let dots = mkRdrUnqual (mkVarOcc " ... ")-          r = o{ hsmodExports = Just (noLocA (noLocA (IEVar noExtField (noLocA (IEName noExtField (noLocA dots)))) : exports') )}+          r = o{ hsmodExports = Just (noLocA (noLocA (IEVar Nothing (noLocA (IEName noExtField (noLocA dots)))) : exports') )}       in         [ignore "Use explicit module export list" (L s o) (noLoc r) []]       where

@@ -249,6 +249,8 @@ foo = [|| x ||] {-# LANGUAGE TemplateHaskell #-} \ foo = $bar+{-# LANGUAGE TemplateHaskell #-} \+foo = $$typedExpressionSplice {-# LANGUAGE TypeData # -} \ type data Nat = Zero | Succ Nat  -- @NoRefactor: refactor requires GHC >= 9.6.1 {-# LANGUAGE TypeData #-} \@@ -272,6 +274,7 @@ import Data.Set qualified as Set import Data.Map qualified as Map +import GHC.Data.FastString import GHC.Types.SrcLoc import GHC.Types.SourceText import GHC.Hs@@ -425,7 +428,7 @@     f _ = False used KindSignatures = hasT (un :: HsKind GhcPs) used BangPatterns = hasS isPBangPat ||^ hasS isStrictMatch-used TemplateHaskell = hasS $ not . isQuasiQuoteSplice+used TemplateHaskell = hasS (not . isQuasiQuoteSplice) ||^ hasS isTypedSplice used TemplateHaskellQuotes = hasS f   where     f :: HsExpr GhcPs -> Bool@@ -490,8 +493,8 @@ used NumericUnderscores = hasS f   where     f :: OverLitVal -> Bool-    f (HsIntegral (IL (SourceText t) _ _)) = '_' `elem` t-    f (HsFractional (FL (SourceText t) _ _ _ _)) = '_' `elem` t+    f (HsIntegral (IL (SourceText t) _ _)) = '_' `elem` unpackFS t+    f (HsFractional (FL (SourceText t) _ _ _ _)) = '_' `elem` unpackFS t     f _ = False  used LambdaCase = hasS isLCase

@@ -87,6 +87,7 @@ yes = blah (\ x -> case x of A -> a; B -> b) -- \ case A -> a; B -> b yes = blah (\ x -> case x of A -> a; B -> b) -- @Note may require `{-# LANGUAGE LambdaCase #-}` adding to the top of the file no = blah (\ x -> case x of A -> a x; B -> b x)+no = blah (\ x -> case x of A -> a x; x -> b x) foo = bar (\x -> case x of Y z | z > 0 -> z) -- \case Y z | z > 0 -> z yes = blah (\ x -> (y, x)) -- (y,) yes = blah (\ x -> (y, x, z+q)) -- (y, , z+q)@@ -170,7 +171,7 @@     where           reform :: [LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)           reform ps b = L (combineSrcSpans (locA loc1) (locA loc2)) $ ValD noExtField $-             origBind {fun_matches = MG Generated (noLocA [noLocA $ Match EpAnnNotUsed ctxt ps $ GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] b] $ EmptyLocalBinds noExtField])}+             origBind {fun_matches = MG (Generated DoPmc) (noLocA [noLocA $ Match EpAnnNotUsed ctxt ps $ GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] b] $ EmptyLocalBinds noExtField])}            mkSubtsAndTpl newPats newBody = (sub, tpl)             where

@@ -44,6 +44,7 @@  import Control.Applicative import Data.Generics.Uniplate.DataOnly+import Data.List.NonEmpty qualified as NE import Data.List.Extra import Data.Maybe import Prelude@@ -103,9 +104,9 @@  listCompCheckGuards :: LHsExpr GhcPs -> HsDoFlavour -> [ExprLStmt GhcPs] -> [Idea] listCompCheckGuards o ctx stmts =-  let revs = reverse stmts-      e@(L _ LastStmt{}) = head revs -- In a ListComp, this is always last.-      xs = reverse (tail revs) in+  let revs = NE.reverse $ NE.fromList stmts+      e@(L _ LastStmt{}) = NE.head revs -- In a ListComp, this is always last.+      xs = reverse (NE.tail revs) in   list_comp_aux e xs   where     list_comp_aux e xs@@ -128,10 +129,10 @@ listCompCheckMap o mp f ctx stmts  | varToStr mp == "map" =     [suggest "Move map inside list comprehension" (reLoc o) (reLoc o2) (suggestExpr o o2)]     where-      revs = reverse stmts-      L _ (LastStmt _ body b s) = head revs -- In a ListComp, this is always last.+      revs = NE.reverse $ NE.fromList stmts+      L _ (LastStmt _ body b s) = NE.head revs -- In a ListComp, this is always last.       last = noLocA $ LastStmt noExtField (noLocA $ HsApp EpAnnNotUsed (paren f) (paren body)) b s-      o2 =noLocA $ HsDo EpAnnNotUsed ctx (noLocA $ reverse (tail revs) ++ [last])+      o2 =noLocA $ HsDo EpAnnNotUsed ctx (noLocA $ reverse (NE.tail revs) ++ [last]) listCompCheckMap _ _ _ _ _ = []  suggestExpr :: LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring R.SrcSpan]@@ -162,7 +163,7 @@ listExp overloadedListsOn b (fromParen -> x) =   if null res     then concatMap (listExp overloadedListsOn $ isAppend x) $ children x-    else [head res]+    else [NE.head $ NE.fromList res]   where     res = [suggest name (reLoc x) (reLoc x2) [r]           | (name, f) <- checks overloadedListsOn@@ -170,7 +171,7 @@           , let r = Replace Expr (toSSA x) subts temp ]  listPat :: LPat GhcPs -> [Idea]-listPat x = if null res then concatMap listPat $ children x else [head res]+listPat x = if null res then concatMap listPat $ children x else [NE.head $ NE.fromList res]     where res = [suggest name (reLoc x) (reLoc x2) [r]                   | (name, f) <- pchecks                   , Just (x2, subts, temp) <- [f x]

@@ -176,7 +176,7 @@       gRHS e = noLocA $ GRHS EpAnnNotUsed [] e :: LGRHS GhcPs (LHsExpr GhcPs) -- Guarded rhs.       gRHSSs e = GRHSs emptyComments [gRHS e] emptyLocalBinds -- Guarded rhs set.       match e = Match{m_ext=EpAnnNotUsed,m_pats=ps12, m_grhss=gRHSSs e, ..} -- Match.-      matchGroup e = MG{mg_alts=noLocA [noLocA $ match e], mg_ext=Generated, ..} -- Match group.+      matchGroup e = MG{mg_alts=noLocA [noLocA $ match e], mg_ext=Generated DoPmc, ..} -- Match group.       funBind e = FunBind {fun_matches=matchGroup e, ..} :: HsBindLR GhcPs GhcPs -- Fun bind.    pure (ListCase ps b1 (x, xs, b2), noLocA . ValD noExtField . funBind)

@@ -298,7 +298,7 @@             grhs = noLocA (GRHS EpAnnNotUsed [] rhs)             grhss = GRHSs emptyComments [grhs] (EmptyLocalBinds noExtField)             match = noLocA $ Match EpAnnNotUsed (FunRhs p Prefix NoSrcStrict) [] grhss-            fb = noLocA $ FunBind noExtField p (MG Generated (noLocA [match]))+            fb = noLocA $ FunBind noExtField p (MG (Generated DoPmc) (noLocA [match]))             binds = unitBag fb             valBinds = ValBinds NoAnnSortKey binds []             localBinds = HsValBinds EpAnnNotUsed valBinds

@@ -102,7 +102,7 @@     L locGRHS (GRHS ttg0 guards (L locExpr dots))     where         dots :: HsExpr GhcPs-        dots = HsLit EpAnnNotUsed (HsString (SourceText "...") (mkFastString "..."))+        dots = HsLit EpAnnNotUsed (HsString (SourceText (fsLit "...")) (fsLit "..."))  getNames :: LHsDecl GhcPs -> [String] getNames decl = maybeToList (declName decl) ++ getConstructorNames (unLoc decl)

@@ -0,0 +1,62 @@+{-++Raise a warning if negation precedence may appear ambiguous to human readers.++<TEST>+yes = -1 ^ 2 -- @Suggestion -(1 ^ 2)+yes = -x ^ y -- @Suggestion -(x ^ y)+yes = -5 `plus` 3 -- @Suggestion -(5 `plus` 3)+yes = -f x `mod` y -- @Suggestion -(f x `mod` y)+yes = -x `mod` y -- @Suggestion -(x `mod` y)+no = -(5 + 3)+no = -5 + 3+no = -(f x)+no = -x+</TEST>+-}++module Hint.Negation(negationParensHint) where++import Hint.Type(DeclHint,Idea(..),rawIdea,toSSA)+import Config.Type+import Data.Generics.Uniplate.DataOnly+import Refact.Types+import GHC.Hs+import GHC.Util+import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable+import GHC.Types.SrcLoc++-- | See [motivating issue #1484](https://github.com/ndmitchell/hlint/issues/1484).+--+-- == Implementation note+--+-- The original intention was to compare fixities so as+-- to only fire the rule when the operand of prefix negation+-- has higher fixity than the negation itself (fixity 6).+--+-- However, since there do not exist any numerically-valued+-- operators with lower fixity than 6+-- (see [table](https://www.haskell.org/onlinereport/decls.html#sect4.4.2)),+-- we do not have to worry about fixity comparisons.+negationParensHint :: DeclHint+negationParensHint _ _ x =+  concatMap negatedOp (universeBi x :: [LHsExpr GhcPs])++negatedOp :: LHsExpr GhcPs -> [Idea]+negatedOp e =+  case e of+    L b1 (NegApp a1 inner@(L _ OpApp {}) a2) ->+      pure $+        rawIdea+          Suggestion+          "Parenthesize unary negation"+          (locA (getLoc e))+          (unsafePrettyPrint e)+          (Just renderedNewExpr)+          []+          [Replace (findType e) (toSSA e) [] renderedNewExpr]+        where+          renderedNewExpr = unsafePrettyPrint newExpr+          parenthesizedOperand = addParen inner+          newExpr = L b1 $ NegApp a1 parenthesizedOperand a2+    _ -> []

@@ -22,6 +22,7 @@ module Hint.NumLiteral (numLiteralHint) where  import GHC.Hs+import GHC.Data.FastString import GHC.LanguageExtensions.Type (Extension (..)) import GHC.Types.SrcLoc import GHC.Types.SourceText@@ -49,18 +50,20 @@  suggestUnderscore :: LHsExpr GhcPs -> [Idea] suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsIntegral intLit@(IL (SourceText srcTxt) _ _))))) =-  [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt, srcTxt /= underscoredSrcTxt ]+  [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt', srcTxt' /= underscoredSrcTxt ]   where-    underscoredSrcTxt = addUnderscore srcTxt+    srcTxt' = unpackFS srcTxt+    underscoredSrcTxt = addUnderscore srcTxt'     y :: LocatedAn an (HsExpr GhcPs)-    y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsIntegral intLit{il_text = SourceText underscoredSrcTxt}}+    y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsIntegral intLit{il_text = SourceText (fsLit underscoredSrcTxt)}}     r = Replace Expr (toSSA x) [("a", toSSA y)] "a" suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsFractional fracLit@(FL (SourceText srcTxt) _ _ _ _))))) =-  [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt, srcTxt /= underscoredSrcTxt ]+  [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt', srcTxt' /= underscoredSrcTxt ]   where-    underscoredSrcTxt = addUnderscore srcTxt+    srcTxt' = unpackFS srcTxt+    underscoredSrcTxt = addUnderscore srcTxt'     y :: LocatedAn an (HsExpr GhcPs)-    y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsFractional fracLit{fl_text = SourceText underscoredSrcTxt}}+    y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsFractional fracLit{fl_text = SourceText (fsLit underscoredSrcTxt)}}     r = Replace Expr (toSSA x) [("a", toSSA y)] "a" suggestUnderscore _ = mempty 

@@ -144,7 +144,7 @@       -- 'ls' is a list of language features enabled by this       -- OPTIONS_GHC pragma that are not enabled by LANGUAGE pragmas       -- in this module.-      let ls = filter (not . (`elem` languagePragmas)) (concat $ catMaybes vs) in+      let ls = concatMap (filter (`notElem` languagePragmas)) $ catMaybes vs in       Just (res, ls)   where     -- Try reinterpreting each flag as a list of language features

@@ -31,6 +31,7 @@ import Data.Map qualified as Map import Data.List.Extra import Data.List.NonEmpty (nonEmpty)+import Data.Either import Data.Maybe import Data.Monoid import Data.Semigroup@@ -157,6 +158,11 @@      , not $ null bad]    isGood def mp x = maybe def (within modu "" . riWithin) $ Map.lookup x mp ++-- | Extension to GHC's 'ImportDeclQualifiedStyle', expressing @qualifiedStyle: unrestricted@,+-- i.e. the preference of "either pre- or post-, but qualified" in a rule.+data QualifiedPostOrPre = QualifiedPostOrPre deriving Eq+ checkImports :: String -> [LImportDecl GhcPs] -> (Bool, Map.Map String RestrictItem) -> [Idea] checkImports modu lImportDecls (def, mp) = mapMaybe getImportHint lImportDecls   where@@ -190,30 +196,37 @@               case fromMaybe ImportStyleUnrestricted $ getAlt riImportStyle of                 ImportStyleUnrestricted                   | NotQualified <- ideclQualified -> (Nothing, Nothing)-                  | otherwise -> (second (<> " or unqualified") <$> expectedQualStyle, Nothing)-                ImportStyleQualified -> (expectedQualStyleDef, Nothing)+                  | otherwise -> (Just $ second (<> " or unqualified") expectedQualStyle, Nothing)+                ImportStyleQualified -> (Just expectedQualStyle, Nothing)                 ImportStyleExplicitOrQualified                   | Just (False, _) <- first (== EverythingBut) <$> ideclImportList -> (Nothing, Nothing)                   | otherwise ->-                      ( second (<> " or with an explicit import list") <$> expectedQualStyleDef+                      ( Just $ second (<> " or with an explicit import list") expectedQualStyle                       , Nothing )                 ImportStyleExplicit                   | Just (False, _) <- first (== EverythingBut) <$> ideclImportList -> (Nothing, Nothing)                   | otherwise ->-                      ( Just (NotQualified, "unqualified")+                      ( Just (Right NotQualified, "unqualified")                       , Just $ Just (Exactly, noLocA []) )-                ImportStyleUnqualified -> (Just (NotQualified, "unqualified"), Nothing)-            expectedQualStyleDef = expectedQualStyle <|> Just (QualifiedPre, "qualified")+                ImportStyleUnqualified -> (Just (Right NotQualified, "unqualified"), Nothing)             expectedQualStyle =               case fromMaybe QualifiedStyleUnrestricted $ getAlt riQualifiedStyle of-                QualifiedStyleUnrestricted -> Nothing-                QualifiedStylePost -> Just (QualifiedPost, "post-qualified")-                QualifiedStylePre -> Just (QualifiedPre, "pre-qualified")+                QualifiedStyleUnrestricted -> (Left QualifiedPostOrPre, "qualified")+                QualifiedStylePost -> (Right QualifiedPost, "post-qualified")+                QualifiedStylePre -> (Right QualifiedPre, "pre-qualified")+            -- unless expectedQual is Nothing, it holds the Idea (hint) to ultimately emit,+            -- except in these cases when the rule's requirements are fulfilled in-source:             qualIdea-              | Just ideclQualified == (fst <$> expectedQual) = Nothing+              -- the rule demands a particular importStyle, and the decl obeys exactly+              | Just (Right ideclQualified) == (fst <$> expectedQual) = Nothing+              -- the rule demands a QualifiedPostOrPre import, and the decl does either+              | Just (Left QualifiedPostOrPre) == (fst <$> expectedQual)+                && ideclQualified `elem` [QualifiedPost, QualifiedPre] = Nothing+              -- otherwise, expectedQual gets converted into a warning below (or is Nothing)               | otherwise = expectedQual         whenJust qualIdea $ \(qual, hint) -> do-          let i' = noLoc $ (unLoc i){ ideclQualified = qual+          -- convert non-Nothing qualIdea into hlint's refactoring Idea+          let i' = noLoc $ (unLoc i){ ideclQualified = fromRight QualifiedPre qual                                     , ideclImportList = fromMaybe ideclImportList expectedHiding }               msg = moduleNameString (unLoc ideclName) <> " should be imported " <> hint           Left $ warn msg (reLoc i) i' []

@@ -60,13 +60,15 @@      -- 'x' is not marked 'NOINLINE'.      , x `notElem` noinline]   where+    noInline :: FastString+    noInline = fsLit "{-# NOINLINE"     gen :: OccName -> LHsDecl GhcPs     gen x = noLocA $       SigD noExtField (InlineSig EpAnnNotUsed (noLocA (mkRdrUnqual x))-                      (InlinePragma (SourceText "{-# NOINLINE") (NoInline (SourceText "{-# NOINLINE")) Nothing NeverActive FunLike))+                      (InlinePragma (SourceText noInline) (NoInline (SourceText noInline)) Nothing NeverActive FunLike))     noinline :: [OccName]     noinline = [q | L _(SigD _ (InlineSig _ (L _ (Unqual q))-                                                (InlinePragma _ (NoInline (SourceText "{-# NOINLINE")) Nothing NeverActive FunLike))+                                                (InlinePragma _ (NoInline (SourceText noInline)) Nothing NeverActive FunLike))         ) <- hsmodDecls m]  isUnsafeDecl :: HsDecl GhcPs -> Bool

@@ -10,6 +10,7 @@  import Control.Exception.Extra import Control.Monad+import Data.List.NonEmpty qualified as NE import Data.Maybe import Data.Version.Extra import GHC.LanguageExtensions.Type@@ -58,7 +59,7 @@     mexc <- findExecutable excPath     case mexc of         Just exc -> do-            ver <- readVersion . tail <$> readProcess exc ["--version"] ""+            ver <- readVersion . NE.tail . NE.fromList <$> readProcess exc ["--version"] ""             pure $ if ver >= minRefactorVersion                        then Right exc                        else Left $ "Your version of refactor is too old, please install apply-refact "

@@ -9,6 +9,7 @@ import Data.Map qualified as Map import Control.Monad.Extra import System.FilePath+import Data.List.NonEmpty qualified as NE import Data.List.Extra import System.Directory @@ -121,7 +122,7 @@     ++ ["", "# All LHS/RHS hints"]     ++ (mkLine <$> sortDedup (hintRuleName <$> sLhsRhsRules))   where-    sortDedup = fmap head . group . sort+    sortDedup = fmap (NE.head . NE.fromList) . group . sort     mkLine name = "- " <> show severity <> ": {name: " <> jsonToString name <> "}"  genSummaryMd :: Summary -> String@@ -161,7 +162,7 @@   where     row1 = row $       [ "<td>" ++ hName ++ "</td>", "<td>"]-      ++ showExample (head hExamples)+      ++ showExample (NE.head (NE.fromList hExamples))       ++ ["Does not support refactoring." | not hRefactoring]       ++ ["</td>"] ++       [ "<td>" ++ show hSeverity ++ "</td>"

@@ -66,3 +66,64 @@ No hints  ---------------------------------------------------------------------+RUN tests/importStyle-postqual-pos.hs --hint=data/import_style.yaml -XImportQualifiedPost+FILE tests/importStyle-postqual-pos.hs+import HypotheticalModule1 qualified as HM1+import HypotheticalModule2 qualified+import HypotheticalModule2 qualified as Arbitrary+import HypotheticalModule3 qualified+import HypotheticalModule3 qualified as Arbitrary+import HypotheticalModule4 qualified as HM4+import HypotheticalModule5 qualified+import HypotheticalModule5 qualified as HM5+OUTPUT+No hints++---------------------------------------------------------------------+RUN tests/importStyle-postqual-neg.hs --hint=data/import_style.yaml -XImportQualifiedPost+FILE tests/importStyle-postqual-neg.hs+import HypotheticalModule1 qualified+import qualified HypotheticalModule4+import qualified HypotheticalModule4 as Verbotten+import qualified HypotheticalModule4 as HM4+import HypotheticalModule5 as HM5+import qualified HypotheticalModule5++OUTPUT+tests/importStyle-postqual-neg.hs:1:1-36: Warning: Avoid restricted alias+Found:+  import HypotheticalModule1 qualified+Perhaps:+  import HypotheticalModule1 qualified as HM1+Note: may break the code++tests/importStyle-postqual-neg.hs:2:1-36: Warning: Avoid restricted alias+Found:+  import qualified HypotheticalModule4+Perhaps:+  import qualified HypotheticalModule4 as HM4+Note: may break the code++tests/importStyle-postqual-neg.hs:3:1-49: Warning: Avoid restricted alias+Found:+  import qualified HypotheticalModule4 as Verbotten+Perhaps:+  import qualified HypotheticalModule4 as HM4+Note: may break the code++tests/importStyle-postqual-neg.hs:5:1-33: Warning: HypotheticalModule5 should be imported post-qualified+Found:+  import HypotheticalModule5 as HM5+Perhaps:+  import HypotheticalModule5 qualified as HM5+Note: may break the code++tests/importStyle-postqual-neg.hs:6:1-36: Warning: HypotheticalModule5 should be imported post-qualified+Found:+  import qualified HypotheticalModule5+Perhaps:+  import HypotheticalModule5 qualified+Note: may break the code++5 hints+---------------------------------------------------------------------