hlint 3.3.4 → 3.3.5
raw patch · 12 files changed
+176/−31 lines, 12 filesdep ~aesonPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson
API changes (from Hackage documentation)
Files
- CHANGES.txt +9/−0
- README.md +1/−0
- data/hlint.yaml +5/−0
- hlint.cabal +3/−1
- src/Config/Yaml.hs +8/−1
- src/GHC/Util/ApiAnnotation.hs +11/−0
- src/GHC/Util/DynFlags.hs +5/−14
- src/Hint/All.hs +3/−1
- src/Hint/Bracket.hs +11/−2
- src/Hint/Extensions.hs +13/−11
- src/Hint/Naming.hs +1/−1
- src/Hint/NumLiteral.hs +106/−0
CHANGES.txt view
@@ -1,5 +1,14 @@ Changelog for HLint (* = breaking change) +3.3.5, released 2021-12-12+ #1304, support aeson-2.0+ #1309, suggest `either Left f x` becomes `f =<< x`+ #1295, suggest TemplateHaskell to TemplateHaskellQuotes if it works+ #1292, don't say redundant bracket around pattern splices+ #1289, suggest expanding tuple sections in some cases+ #1289, suggest length [1..n] ==> max 0 n+ #1279, suggest using NumericUnderscores more if it is enabled+ #1290, move reverse out of filter 3.3.4, released 2021-08-30 #1288, fix generation of Linux binaries 3.3.3, released 2021-08-29
README.md view
@@ -20,6 +20,7 @@ * HLint can be configured with knowledge of C Pre Processor flags, but it can only see one conditional set of code at a time. * HLint turns on many language extensions so it can parse more documents, occasionally some break otherwise legal syntax - e.g. `{-#INLINE foo#-}` doesn't work with `MagicHash`, `foo $bar` means something different with `TemplateHaskell`. These extensions can be disabled with `-XNoMagicHash` or `-XNoTemplateHaskell` etc. * HLint doesn't run any custom preprocessors, e.g. [markdown-unlit](https://hackage.haskell.org/package/markdown-unlit) or [record-dot-preprocessor](https://hackage.haskell.org/package/record-dot-preprocessor), so code making use of them will usually fail to parse.+* Some hints, like `Use const`, don't work for non-lifted (i.e. unlifted and unboxed) types. ## Installing and running HLint
data/hlint.yaml view
@@ -221,6 +221,7 @@ - warn: {lhs: "lookup b (zip l [0..])", rhs: elemIndex b l} - hint: {lhs: "elem x [y]", rhs: x == y, note: ValidInstance Eq a} - hint: {lhs: "notElem x [y]", rhs: x /= y, note: ValidInstance Eq a}+ - hint: {lhs: "length [1..n]", rhs: max 0 n} - hint: {lhs: length x >= 0, rhs: "True", name: Length always non-negative} - hint: {lhs: 0 <= length x, rhs: "True", name: Length always non-negative} - hint: {lhs: length x > 0, rhs: not (null x), note: IncreasesLaziness, name: Use null}@@ -564,6 +565,8 @@ - warn: {lhs: snd (unzip x), rhs: map snd x} - hint: {lhs: "\\x y -> (x, y)", rhs: "(,)"} - 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} # MAYBE @@ -627,6 +630,7 @@ - warn: {lhs: catMaybes (nubOrd x), rhs: nubOrd (catMaybes x), name: Move nubOrd out} - warn: {lhs: lefts (nubOrd x), rhs: nubOrd (lefts x), name: Move nubOrd out} - warn: {lhs: rights (nubOrd x), rhs: nubOrd (rights x), name: Move nubOrd out}+ - warn: {lhs: filter f (reverse x), rhs: reverse (filter f x), name: Move reverse out} # EITHER @@ -640,6 +644,7 @@ - warn: {lhs: fromRight x (fmap f y), rhs: either (const x) f y} - warn: {lhs: either (const x) id, rhs: fromRight x} - warn: {lhs: either id (const x), rhs: fromLeft x}+ - warn: {lhs: either Left f x, rhs: f =<< x} # INFIX
hlint.cabal view
@@ -1,7 +1,7 @@ cabal-version: 1.18 build-type: Simple name: hlint-version: 3.3.4+version: 3.3.5 license: BSD3 license-file: LICENSE category: Development@@ -160,10 +160,12 @@ Hint.Smell Hint.Type Hint.Unsafe+ Hint.NumLiteral Test.All Test.Annotations Test.InputOutput Test.Util+ ghc-options: -Wunused-binds -Wunused-imports -Worphans executable hlint
src/Config/Yaml.hs view
@@ -40,6 +40,9 @@ import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import Data.Char+#if MIN_VERSION_aeson(2,0,0)+import Data.Aeson.KeyMap (toHashMapText)+#endif #ifdef HS_YAML @@ -68,6 +71,10 @@ #endif +#if !MIN_VERSION_aeson(2,0,0)+toHashMapText :: a -> a+toHashMapText = id+#endif -- | Read a config file in YAML format. Takes a filename, and optionally the contents. -- Fails if the YAML doesn't parse or isn't valid HLint YAML@@ -138,7 +145,7 @@ parseArray v = pure [v] parseObject :: Val -> Parser (Map.HashMap T.Text Value)-parseObject (getVal -> Object x) = pure x+parseObject (getVal -> Object x) = pure (toHashMapText x) parseObject v = parseFail v "Expected an Object" parseObject1 :: Val -> Parser (String, Val)
src/GHC/Util/ApiAnnotation.hs view
@@ -3,13 +3,19 @@ comment, commentText, isCommentMultiline , pragmas, flags, languagePragmas , mkFlags, mkLanguagePragmas+ , extensions ) where +import GHC.LanguageExtensions.Type (Extension) import GHC.Parser.Annotation import GHC.Types.SrcLoc +import Language.Haskell.GhclibParserEx.GHC.Driver.Session+ import Control.Applicative import Data.List.Extra+import Data.Maybe+import qualified Data.Set as Set trimCommentStart :: String -> String trimCommentStart s@@ -63,6 +69,11 @@ where realToLoc :: RealLocated a -> Located a realToLoc (L r x) = L (RealSrcSpan r Nothing) x++-- All the extensions defined to be used.+extensions :: ApiAnns -> Set.Set Extension+extensions = Set.fromList . mapMaybe readExtension .+ concatMap snd . languagePragmas . pragmas -- Utility for a case insensitive prefix strip. stripPrefixCI :: String -> String -> Maybe String
src/GHC/Util/DynFlags.hs view
@@ -1,23 +1,14 @@ module GHC.Util.DynFlags (initGlobalDynFlags, baseDynFlags) where import GHC.Driver.Session-import GHC.LanguageExtensions.Type-import Data.List.Extra import Language.Haskell.GhclibParserEx.GHC.Settings.Config +-- The list of default enabled extensions is empty. This is because:+-- the extensions to enable/disable are set exclusively in+-- 'parsePragmasIntoDynFlags' based solely on the parse flags+-- (and source level annotations). baseDynFlags :: DynFlags-baseDynFlags =- -- The list of default enabled extensions is empty except for- -- 'TemplateHaskellQuotes'. This is because:- -- * The extensions to enable/disable are set exclusively in- -- 'parsePragmasIntoDynFlags' based solely on HSE parse flags- -- (and source level annotations);- -- * 'TemplateHaskellQuotes' is not a known HSE extension but IS- -- needed if the GHC parse is to succeed for the unit-test at- -- hlint.yaml:860- let enable = [TemplateHaskellQuotes]- in foldl' xopt_set (defaultDynFlags fakeSettings fakeLlvmConfig) enable-+baseDynFlags = defaultDynFlags fakeSettings fakeLlvmConfig initGlobalDynFlags :: IO () initGlobalDynFlags = setUnsafeGlobalDynFlags baseDynFlags
src/Hint/All.hs view
@@ -32,6 +32,7 @@ import Hint.Unsafe import Hint.NewType import Hint.Smell+import Hint.NumLiteral -- | A list of the builtin hints wired into HLint. -- This list is likely to grow over time.@@ -39,7 +40,7 @@ HintList | HintListRec | HintMonad | HintLambda | HintFixities | HintBracket | HintNaming | HintPattern | HintImport | HintExport | HintPragma | HintExtensions | HintUnsafe | HintDuplicate | HintRestrict |- HintComment | HintNewType | HintSmell+ HintComment | HintNewType | HintSmell | HintNumLiteral deriving (Show,Eq,Ord,Bounded,Enum) -- See https://github.com/ndmitchell/hlint/issues/1150 - Duplicate is too slow@@ -67,6 +68,7 @@ HintPattern -> decl patternHint HintMonad -> decl monadHint HintExtensions -> modu extensionsHint+ HintNumLiteral -> decl numLiteralHint where wrap = timed "Hint" (drop 4 $ show x) . forceList decl f = mempty{hintDecl=const $ \a b c -> wrap $ f a b c}
src/Hint/Bracket.hs view
@@ -101,6 +101,9 @@ -- type splices are a bit special no = f @($x)++-- template haskell is harder+issue1292 = [e| handleForeignCatch $ \ $(varP pylonExPtrVarName) -> $(quoteExp C.block modifiedStr) |] </TEST> -} @@ -189,8 +192,10 @@ -- In some context, removing parentheses from 'x' succeeds. Does -- 'x' actually need bracketing in this context? f (Just (i, o, gen)) v@(remParens' -> Just x)- | not $ needBracket i o x, not $ isPartialAtom (Just o) x =- rawIdea Suggestion msg (getLoc v) (pretty o) (Just (pretty (gen x))) [] [r] : g x+ | not $ needBracket i o x+ , not $ isPartialAtom (Just o) x+ , not $ any isSplicePat $ universeBi o -- over-appoximate ,see #1292+ = rawIdea Suggestion msg (getLoc v) (pretty o) (Just (pretty (gen x))) [] [r] : g x where typ = findType v r = Replace typ (toSS v) [("x", toSS x)] "x"@@ -202,6 +207,10 @@ -- Enumerate over all the immediate children of 'o' looking for -- redundant parentheses in each. g o = concat [f (Just (i, o, gen)) x | (i, (x, gen)) <- zipFrom 0 $ holes o]++isSplicePat :: Pat GhcPs -> Bool+isSplicePat SplicePat{} = True+isSplicePat _ = False bracketWarning :: (Outputable a, Outputable b, Brackets (Located b)) => String -> Located a -> Located b -> Idea bracketWarning msg o x =
src/Hint/Extensions.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE LambdaCase, NamedFieldPuns #-}+{-# LANGUAGE LambdaCase, NamedFieldPuns, ScopedTypeVariables #-} {- Suggest removal of unnecessary extensions@@ -15,7 +15,9 @@ {-# LANGUAGE TemplateHaskell #-} \ $(deriveNewtypes typeInfo) {-# LANGUAGE TemplateHaskell #-} \-main = foo ''Bar+main = foo ''Bar --+{-# LANGUAGE QuasiQuotes, TemplateHaskell #-} \+f x = x + [e| x + 1 |] + [foo| x + 1 |] -- {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE PatternGuards #-} \ test = case x of _ | y <- z -> w {-# LANGUAGE TemplateHaskell,EmptyDataDecls #-} \@@ -290,7 +292,9 @@ ] where usedTH :: Bool- usedTH = used TemplateHaskell (ghcModule x) || used QuasiQuotes (ghcModule x)+ usedTH = used TemplateHaskell (ghcModule x)+ || used TemplateHaskellQuotes (ghcModule x)+ || used QuasiQuotes (ghcModule x) -- If TH or QuasiQuotes is on, can use all other extensions -- programmatically. @@ -301,7 +305,10 @@ -- Those extensions we detect to be useful. useful :: Set.Set Extension- useful = if usedTH then extensions else Set.filter (`usedExt` ghcModule x) extensions+ useful =+ if usedTH+ then Set.filter (\case TemplateHaskell -> usedExt TemplateHaskell (ghcModule x); _ -> True) extensions+ else Set.filter (`usedExt` ghcModule x) extensions -- Those extensions which are useful, but implied by other useful -- extensions. implied :: Map.Map Extension Extension@@ -379,12 +386,8 @@ f _ = False used KindSignatures = hasT (un :: HsKind GhcPs) used BangPatterns = hasS isPBangPat ||^ hasS isStrictMatch'-used TemplateHaskell = hasT2' (un :: (HsBracket GhcPs, HsSplice GhcPs)) ||^ hasS f ||^ hasS isSpliceDecl- where- f :: HsBracket GhcPs -> Bool- f VarBr{} = True- f TypBr{} = True- f _ = False+used TemplateHaskell = hasS $ \case (HsQuasiQuote{} :: HsSplice GhcPs) -> False; _ -> True+used TemplateHaskellQuotes = hasT (un :: HsBracket GhcPs) used ForeignFunctionInterface = hasT (un :: CCallConv) used PatternGuards = hasS f where@@ -536,7 +539,6 @@ un = undefined hasT t x = not $ null (universeBi x `asTypeOf` [t])-hasT2' ~(t1,t2) = hasT t1 ||^ hasT t2 hasS :: (Data x, Data a) => (a -> Bool) -> x -> Bool hasS test = any test . universeBi
src/Hint/Naming.hs view
@@ -124,7 +124,7 @@ any (`isPrefixOf` original) ["prop_","case_","unit_","test_","spec_","scprop_","hprop_"] = Nothing | otherwise = Just $ f original where- good = all isAlphaNum $ drp '_' $ drp '#' $ filter (/= '\'') $ reverse $ drp '_' original+ good = all isAlphaNum $ drp '_' $ drp '#' $ reverse $ filter (/= '\'') $ drp '_' original drp x = dropWhile (== x) f xs = us ++ g ys
+ src/Hint/NumLiteral.hs view
@@ -0,0 +1,106 @@+{-+ Suggest the usage of underscore when NumericUnderscores is enabled.++<TEST>+123456+{-# LANGUAGE NumericUnderscores #-} \+12345 -- @Suggestion 12_345 @NoRefactor+{-# LANGUAGE NumericUnderscores #-} \+123456789.0441234e-123456 -- @Suggestion 123_456_789.044_123_4e-123_456 @NoRefactor+{-# LANGUAGE NumericUnderscores #-} \+0x12abc.523defp+172345 -- @Suggestion 0x1_2abc.523d_efp+172_345 @NoRefactor+{-# LANGUAGE NumericUnderscores #-} \+3.14159265359 -- @Suggestion 3.141_592_653_59 @NoRefactor+{-# LANGUAGE NumericUnderscores #-} \+12_33574_56+</TEST>++-}++module Hint.NumLiteral (numLiteralHint) where++import GHC.Hs+import GHC.LanguageExtensions.Type (Extension (..))+import GHC.Types.SrcLoc+import GHC.Types.Basic (SourceText (..), IntegralLit (..), FractionalLit (..))+import GHC.Util.ApiAnnotation (extensions)+import Data.Char (isDigit, isOctDigit, isHexDigit)+import Data.List (intercalate)+import Data.Generics.Uniplate.DataOnly (universeBi)+import Refact.Types++import Hint.Type (DeclHint, toSS, ghcAnnotations)+import Idea (Idea, suggest)++numLiteralHint :: DeclHint+numLiteralHint _ modu =+ if NumericUnderscores `elem` extensions (ghcAnnotations modu) then+ concatMap suggestUnderscore . universeBi+ else+ const []++suggestUnderscore :: LHsExpr GhcPs -> [Idea]+suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsIntegral intLit@(IL (SourceText srcTxt) _ _)) _))) =+ [ suggest "Use underscore" x y [r] | '_' `notElem` srcTxt, srcTxt /= underscoredSrcTxt ]+ where+ underscoredSrcTxt = addUnderscore srcTxt+ y = noLoc $ HsOverLit noExtField $ ol{ol_val = HsIntegral intLit{il_text = SourceText underscoredSrcTxt}}+ r = Replace Expr (toSS x) [("a", toSS y)] "a"+suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsFractional fracLit@(FL (SourceText srcTxt) _ _)) _))) =+ [ suggest "Use underscore" x y [r] | '_' `notElem` srcTxt, srcTxt /= underscoredSrcTxt ]+ where+ underscoredSrcTxt = addUnderscore srcTxt+ y = noLoc $ HsOverLit noExtField $ ol{ol_val = HsFractional fracLit{fl_text = SourceText underscoredSrcTxt}}+ r = Replace Expr (toSS x) [("a", toSS y)] "a"+suggestUnderscore _ = mempty++addUnderscore :: String -> String+addUnderscore intStr = numLitToStr underscoredNumLit+ where+ numLit = toNumLiteral intStr+ underscoredNumLit = numLit{ nl_intPart = underscoreFromRight chunkSize $ nl_intPart numLit+ , nl_fracPart = underscore chunkSize $ nl_fracPart numLit+ , nl_exp = underscoreFromRight 3 $ nl_exp numLit -- Exponential part is always decimal+ }+ chunkSize = if null (nl_prefix numLit) then 3 else 4++ underscore chunkSize = intercalate "_" . chunk chunkSize+ underscoreFromRight chunkSize = reverse . underscore chunkSize . reverse+ chunk chunkSize [] = []+ chunk chunkSize xs = a:chunk chunkSize b where (a, b) = splitAt chunkSize xs++data NumLiteral = NumLiteral+ { nl_prefix :: String+ , nl_intPart :: String+ , nl_decSep :: String -- decimal separator+ , nl_fracPart :: String+ , nl_expSep :: String -- e, e+, e-, p, p+, p-+ , nl_exp :: String+ } deriving (Show, Eq)++toNumLiteral :: String -> NumLiteral+toNumLiteral str = case str of+ '0':'b':digits -> (afterPrefix isBinDigit digits){nl_prefix = "0b"}+ '0':'B':digits -> (afterPrefix isBinDigit digits){nl_prefix = "0B"}+ '0':'o':digits -> (afterPrefix isOctDigit digits){nl_prefix = "0o"}+ '0':'O':digits -> (afterPrefix isOctDigit digits){nl_prefix = "0O"}+ '0':'x':digits -> (afterPrefix isHexDigit digits){nl_prefix = "0x"}+ '0':'X':digits -> (afterPrefix isHexDigit digits){nl_prefix = "0X"}+ _ -> afterPrefix isDigit str+ where+ isBinDigit x = x == '0' || x == '1'++ afterPrefix isDigit str = (afterIntPart isDigit suffix){nl_intPart = intPart}+ where (intPart, suffix) = span isDigit str++ afterIntPart isDigit ('.':suffix) = (afterDecSep isDigit suffix){nl_decSep = "."}+ afterIntPart isDigit str = afterFracPart str++ afterDecSep isDigit str = (afterFracPart suffix){nl_fracPart = fracPart}+ where (fracPart, suffix) = span isDigit str++ afterFracPart str = NumLiteral "" "" "" "" expSep exp+ where (expSep, exp) = break isDigit str++numLitToStr :: NumLiteral -> String+numLitToStr (NumLiteral p ip ds fp es e) = p ++ ip ++ ds ++ fp ++ es ++ e