packages feed

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 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