hlint 3.0.4 → 3.1

raw patch · 11 files changed

+89/−28 lines, 11 filesdep ~ghc-lib-parser-exPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc-lib-parser-ex

API changes (from Hackage documentation)

Files

• CHANGES.txt +9/−0
• data/hlint.yaml +2/−1
• hlint.cabal +2/−2
• src/CmdLine.hs +9/−8
• src/Config/Yaml.hs +1/−1
• src/GHC/Util/Brackets.hs +11/−1
• src/HLint.hs +2/−1
• src/HSE/All.hs +6/−5
• src/Hint/Bracket.hs +7/−0
• src/Hint/Extensions.hs +6/−5
• src/Hint/Monad.hs +34/−4

@@ -1,5 +1,14 @@ Changelog for HLint (* = breaking change) +3.1, released 2020-05-07+    #979, suggest removing flip only for simple final variables+    #978, do is not redundant with non-decreasing indentation+    #969, wrong redundant bracket suggestion with BlockArguments+    #970, detect redundant sections, (a +) b ==> a + b+*   #974, split ParseFlags.extensions into enabled/disabled+    #971, add support for -XNoFoo command line flags+    #976, run refactor even if no hints+    #971, add support for NoFoo language pragmas 3.0.4, released 2020-05-03     #968, fail on all parse errors     #967, enable TypeApplications by default

@@ -300,7 +300,7 @@     - warn: {lhs: (Data.Function.& f), rhs: f, name: Redundant Data.Function.&}     - hint: {lhs: \x -> y, rhs: const y, side: isAtom y && not (isWildcard y)}         # If any isWildcard recursively then x may be used but not mentioned explicitly-    - warn: {lhs: flip f x y, rhs: f y x, side: isApp original}+    - warn: {lhs: flip f x y, rhs: f y x, side: isApp original && isAtom y}     - warn: {lhs: id x, rhs: x}     - warn: {lhs: id . x, rhs: x, name: Redundant id}     - warn: {lhs: x . id, rhs: x, name: Redundant id}@@ -1170,4 +1170,5 @@ # test953 = for [] $ \n -> bar n >>= \case {Just n  -> pure (); Nothing -> baz n} @NoRefactor # f = map (flip (,) "a") "123" -- (,"a") # f = map ((,) "a") "123" -- ("a",)+# test979 = flip Map.traverseWithKey blocks \k v -> lots_of_code_goes_here @NoRefactor # </TEST>

@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               hlint-version:            3.0.4+version:            3.1 license:            BSD3 license-file:       LICENSE category:           Development@@ -76,7 +76,7 @@       build-depends:           ghc-lib-parser == 8.10.*     build-depends:-        ghc-lib-parser-ex >= 8.10.0.5 && < 8.10.1+        ghc-lib-parser-ex >= 8.10.0.6 && < 8.10.1      if flag(gpl)         build-depends: hscolour >= 1.21

@@ -230,14 +230,14 @@     where         ancestors = init . map joinPath . reverse . inits . splitPath -cmdExtensions :: Cmd -> (Maybe Language, [Extension])+cmdExtensions :: Cmd -> (Maybe Language, ([Extension], [Extension])) cmdExtensions = getExtensions . cmdLanguage   cmdCpp :: Cmd -> CppFlags cmdCpp cmd     | cmdCppSimple cmd = CppSimple-    | Cpp `elem` snd (cmdExtensions cmd) = Cpphs defaultCpphsOptions+    | Cpp `elem` (fst . snd) (cmdExtensions cmd) = Cpphs defaultCpphsOptions         {boolopts=defaultBoolOptions{hashline=False, stripC89=True, ansi=cmdCppAnsi cmd}         ,includes = cmdCppInclude cmd         ,preInclude = cmdCppFile cmd@@ -314,14 +314,15 @@ getModule _ _ _ = pure Nothing  -getExtensions :: [String] -> (Maybe Language, [Extension])-getExtensions args = (lang, foldl f (if null langs then defaultExtensions else []) exts)+getExtensions :: [String] -> (Maybe Language, ([Extension], [Extension]))+getExtensions args =+  (lang, foldl f (if null langs then (defaultExtensions, []) else ([], [])) exts)     where         lang = if null langs then Nothing else Just $ fromJust $ lookup (last langs) ls         (langs, exts) = partition (isJust . flip lookup ls) args         ls = [(show x, x) | x <- [Haskell98, Haskell2010]] -        f a "Haskell98" = []-        f a ('N':'o':x) | Just x <- GhclibParserEx.readExtension x = delete x a-        f a x | Just x <- GhclibParserEx.readExtension x = x : delete x a-        f a x = a -- Ignore unknown extension.+        f (a, e) "Haskell98" = ([], [])+        f (a, e) ('N':'o':x) | Just x <- GhclibParserEx.readExtension x = (delete x a, x : delete x e)+        f (a, e) x | Just x <- GhclibParserEx.readExtension x = (x : delete x a, delete x e)+        f (a, e) x = (a, e) -- Ignore unknown extension.

@@ -164,7 +164,7 @@ parseGHC :: (ParseFlags -> String -> ParseResult v) -> Val -> Parser v parseGHC parser v = do     x <- parseString v-    case parser defaultParseFlags{extensions=configExtensions} x of+    case parser defaultParseFlags{enabledExtensions=configExtensions, disabledExtensions=[]} x of         POk _ x -> pure x         PFailed ps ->           let (_, errs) = getMessages ps baseDynFlags

@@ -67,7 +67,7 @@   needBracket' i parent child -- Note: i is the index in children, not in the AST.      | isAtom' child = False      | isSection parent, L _ HsApp{} <- child = False-     | L _ OpApp{} <- parent, L _ HsApp{} <- child = False+     | L _ OpApp{} <- parent, L _ HsApp{} <- child, i /= 0 || isAtomOrApp child = False      | L _ ExplicitList{} <- parent = False      | L _ ExplicitTuple{} <- parent = False      | L _ HsIf{} <- parent, isAnyApp child = False@@ -85,6 +85,16 @@       | L _ HsPar{} <- parent = False      | otherwise = True++-- | Am I an HsApp such that having me in an infix doesn't require brackets.+--   Before BlockArguments that was _all_ HsApps. Now, imagine:+--+--   (f \x -> x) *> ...+--   (f do x) *> ...+isAtomOrApp :: LHsExpr GhcPs -> Bool+isAtomOrApp x | isAtom' x = True+isAtomOrApp (L _ (HsApp _ _ x)) = isAtomOrApp x+isAtomOrApp _ = False  instance Brackets' (Located (Pat GhcPs)) where   remParen' (L _ (ParPat _ x)) = Just x

@@ -182,8 +182,9 @@         then [i | i <- ideas, ideaHint i `elem` cmdOnly]         else ideas +-- #746: run refactor even if no hint, which ensures consistent output+-- whether there are hints or not. handleRefactoring :: [Idea] -> [String] -> Cmd -> IO ()-handleRefactoring [] _ _ = pure () -- No refactorings to apply handleRefactoring ideas files cmd@CmdMain{..} =     case cmdFiles of         [file] -> do

@@ -44,20 +44,21 @@ data ParseFlags = ParseFlags     {cppFlags :: CppFlags -- ^ How the file is preprocessed (defaults to 'NoCpp').     ,baseLanguage :: Maybe Language -- ^ Base language (e.g. Haskell98, Haskell2010), defaults to 'Nothing'.-    ,extensions :: [Extension] -- ^ List of extensions enabled for parsing, defaults to many non-conflicting extensions.+    ,enabledExtensions :: [Extension] -- ^ List of extensions enabled for parsing, defaults to many non-conflicting extensions.+    ,disabledExtensions :: [Extension] -- ^ List of extensions disabled for parsing, usually empty.     ,fixities :: [FixityInfo] -- ^ List of fixities to be aware of, defaults to those defined in @base@.     }  -- | Default value for 'ParseFlags'. defaultParseFlags :: ParseFlags-defaultParseFlags = ParseFlags NoCpp Nothing defaultExtensions defaultFixities+defaultParseFlags = ParseFlags NoCpp Nothing defaultExtensions [] defaultFixities  -- | Given some fixities, add them to the existing fixities in 'ParseFlags'. parseFlagsAddFixities :: [FixityInfo] -> ParseFlags -> ParseFlags parseFlagsAddFixities fx x = x{fixities = fx ++ fixities x} -parseFlagsSetLanguage :: (Maybe Language, [Extension]) -> ParseFlags -> ParseFlags-parseFlagsSetLanguage (l, es) x = x{baseLanguage = l, extensions = es}+parseFlagsSetLanguage :: (Maybe Language, ([Extension], [Extension])) -> ParseFlags -> ParseFlags+parseFlagsSetLanguage (l, (es, ds)) x = x{baseLanguage = l, enabledExtensions = es, disabledExtensions = ds}   runCpp :: CppFlags -> FilePath -> String -> IO String@@ -105,7 +106,7 @@  -- GHC extensions to enable/disable given HSE parse flags. ghcExtensionsFromParseFlags :: ParseFlags -> ([Extension], [Extension])-ghcExtensionsFromParseFlags ParseFlags{extensions=exts}= (exts, [])+ghcExtensionsFromParseFlags ParseFlags{enabledExtensions=es, disabledExtensions=ds}= (es, ds)  -- GHC fixities given HSE parse flags. ghcFixitiesFromParseFlags :: ParseFlags -> [(String, Fixity)]

@@ -40,6 +40,8 @@ issue909 = foo (\((x : z) -> y) -> 9 + x * 7) -- \(x : z -> y) -> 9 + x * 7 issue909 = let ((x:: y) -> z) = q in q issue909 = do {((x :: y) -> z) <- e; return 1}+issue970 = (f x +) (g x) -- f x + (g x) @NoRefactor+issue969 = (Just \x -> x || x) *> Just True @NoRefactor  -- type bracket reduction foo :: (Int -> Int) -> Int@@ -246,6 +248,11 @@           [ suggest' "Redundant bracket" x y []           | L _ (OpApp _ (L _ (HsPar _ o1@(L _ (OpApp _ v1 (isDot -> True) v2)))) o2 v3) <- [x], varToStr o2 == "<$>"           , let y = noLoc (OpApp noExtField o1 o2 v3) :: LHsExpr GhcPs]+          +++          [ suggest' "Redundant section" x y []+          | L _ (HsApp _ (L _ (HsPar _ (L _ (SectionL _ a b)))) c) <- [x]+          -- , error $ show (unsafePrettyPrint a, gshow b, unsafePrettyPrint c)+          , let y = noLoc $ OpApp noExtField a b c :: LHsExpr GhcPs]  splitInfix :: LHsExpr GhcPs -> [(LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)] splitInfix (L l (OpApp _ lhs op rhs)) =

@@ -196,6 +196,10 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE Trustworthy, NamedFieldPuns #-} -- {-# LANGUAGE Trustworthy #-} {-# LANGUAGE Haskell2010 #-}+{-# LANGUAGE NoStarIsType, ExplicitNamespaces #-} \+import GHC.TypeLits(KnownNat, type (+), type (*))+{-# LANGUAGE LambdaCase, MultiWayIf, NoRebindableSyntax #-} \+foo = \case True -> 3 -- {-# LANGUAGE LambdaCase, NoRebindableSyntax #-} </TEST> -} @@ -244,7 +248,7 @@             | (_, Just x) <- explainedRemovals])         [ModifyComment (toSS' (mkLanguagePragmas sl exts)) newPragma]     | (L sl _,  exts) <- languagePragmas $ pragmas (ghcAnnotations x)-    , let before = [(x, readExtension x) | x <- filterEnabled exts]+    , let before = [(x, readExtension x) | x <- exts]     , let after = filter (maybe True (`Set.member` keep) . snd) before     , before /= after     , let explainedRemovals@@ -254,9 +258,6 @@             if null after then "" else comment (mkLanguagePragmas sl $ map fst after)     ]   where-    filterEnabled :: [String] -> [String]-    filterEnabled  = filter (not . isPrefixOf "No")-     usedTH :: Bool     usedTH = used TemplateHaskell (ghcModule x) || used QuasiQuotes (ghcModule x)       -- If TH or QuasiQuotes is on, can use all other extensions@@ -265,7 +266,7 @@     -- All the extensions defined to be used.     extensions :: Set.Set Extension     extensions = Set.fromList $ mapMaybe readExtension $-        concatMap (filterEnabled . snd) $ languagePragmas (pragmas (ghcAnnotations x))+        concatMap snd $ languagePragmas (pragmas (ghcAnnotations x))      -- Those extensions we detect to be useful.     useful :: Set.Set Extension

@@ -50,6 +50,10 @@ main = do bar; forM_ f xs; return () -- do bar; forM_ f xs main = do a; when b c; return () -- do a; when b c bar = 1 * do {\x -> x+x} + y+issue978 = do \+   print "x" \+   if False then main else do \+   return () </TEST> -} @@ -70,22 +74,37 @@ import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable import GHC.Util +import Data.Generics.Uniplate.Data import Data.Tuple.Extra import Data.Maybe import Data.List.Extra import Refact.Types hiding (Match) import qualified Refact.Types as R + badFuncs :: [String] badFuncs = ["mapM","foldM","forM","replicateM","sequence","zipWithM","traverse","for","sequenceA"] unitFuncs :: [String] unitFuncs = ["when","unless","void"]  monadHint :: DeclHint'-monadHint _ _ d = concatMap (monadExp d) $ universeParentExp' d+monadHint _ _ d = concatMap (f Nothing Nothing) $ childrenBi d+    where+        decl = declName d+        f parentDo parentExpr x =+            monadExp decl parentDo parentExpr x +++            concat [f (if isHsDo x then Just x else parentDo) (Just (i, x)) c | (i, c) <- zipFrom 0 $ children x] -monadExp :: LHsDecl GhcPs -> (Maybe (Int, LHsExpr GhcPs), LHsExpr GhcPs) -> [Idea]-monadExp (declName -> decl) (parent, x) =+        isHsDo (L _ HsDo{}) = True+        isHsDo _ = False+++-- | Call with the name of the declaration,+--   the nearest enclosing `do` expression+--   the nearest enclosing expression+--   the expression of interest+monadExp :: Maybe String -> Maybe (LHsExpr GhcPs) -> Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]+monadExp decl parentDo parentExpr x =   case x of     (view' -> App2' op x1 x2) | isTag ">>" op -> f x1     (view' -> App2' op x1 (view' -> LamConst1' _)) | isTag ">>=" op -> f x1@@ -94,7 +113,9 @@     (L loc (HsDo _ ctx (L loc2 [L loc3 (BodyStmt _ y _ _ )]))) ->       let doOrMDo = case ctx of MDoExpr -> "mdo"; _ -> "do"        in [ warnRemove ("Redundant " ++ doOrMDo) (doSpan doOrMDo loc) doOrMDo [Replace Expr (toSS' x) [("y", toSS' y)] "y"]-          | not $ doAsBrackets parent y ]+          | not $ doAsBrackets parentExpr y+          , not $ doAsAvoidingIndentation parentDo x+          ]     (L loc (HsDo _ DoExpr (L _ xs))) ->       monadSteps (cL loc . HsDo noExtField DoExpr . noLoc) xs ++       [suggest' "Use let" from to [r] | (from, to, r) <- monadLet xs] ++@@ -119,6 +140,15 @@ doAsBrackets (Just (2, L _ (OpApp _ _ op _ ))) _ | isDol op = False -- not quite atomic, but close enough doAsBrackets (Just (i, o)) x = needBracket' i o x doAsBrackets Nothing x = False+++-- Sometimes people write do, to avoid identation, see+-- https://github.com/ndmitchell/hlint/issues/978+-- Return True if they are using do as avoiding identation+doAsAvoidingIndentation :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool+doAsAvoidingIndentation (Just (L _ (HsDo _ _ (L (RealSrcSpan a) _)))) (L _ (HsDo _ _ (L (RealSrcSpan b) _)))+    = srcSpanStartCol a == srcSpanStartCol b+doAsAvoidingIndentation parent self = False   returnsUnit :: LHsExpr GhcPs -> Bool