diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,8 @@ Changelog for HLint (* = breaking change) +3.0.2, released 2020-05-03 + #963, don't generate use-section hints for tuples + #745, fix up free variables for A{x}, fixes list comp hints 3.0.1, released 2020-05-02 #961, don't crash on non-extension LANGUAGE pragmas, e.g. Safe 3.0, released 2020-05-02 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -222,7 +222,7 @@ ### Why do I get a parse error? -HLint enables/disables a set of extensions designed to allow as many files to parse as possible, but sometimes you'll need to enable an additional extension (e.g. Arrows), or disable some (e.g. MagicHash) to enable your code to parse. In addition, sometimes the underlying parser library ([haskell-src-exts](https://github.com/haskell-suite/haskell-src-exts)) has a bug which causes a parse error. +HLint enables/disables a set of extensions designed to allow as many files to parse as possible, but sometimes you'll need to enable an additional extension (e.g. Arrows), or disable some (e.g. MagicHash) to enable your code to parse. ## Customizing the hints @@ -357,4 +357,4 @@ ### Acknowledgements -This program has only been made possible by the presence of the [haskell-src-exts](https://github.com/haskell-suite/haskell-src-exts) package, and many improvements have been made by [Niklas Broberg](http://www.nbroberg.se) in response to feature requests. Additionally, many people have provided help and patches, including Lennart Augustsson, Malcolm Wallace, Henk-Jan van Tuyl, Gwern Branwen, Alex Ott, Andy Stewart, Roman Leshchinskiy, Johannes Lippmann, Iustin Pop, Steve Purcell, Mitchell Rosen and others. +Many improvements to this program have been made by [Niklas Broberg](http://www.nbroberg.se) in response to feature requests. Additionally, many people have provided help and patches, including Lennart Augustsson, Malcolm Wallace, Henk-Jan van Tuyl, Gwern Branwen, Alex Ott, Andy Stewart, Roman Leshchinskiy, Johannes Lippmann, Iustin Pop, Steve Purcell, Mitchell Rosen and others. diff --git a/data/hlint.yaml b/data/hlint.yaml --- a/data/hlint.yaml +++ b/data/hlint.yaml @@ -1168,4 +1168,6 @@ # import Data.Map.Strict (fromList) \ # fromList [] -- Data.Map.Strict.empty # test953 = for [] $ \n -> bar n >>= \case {Just n -> pure (); Nothing -> baz n} @NoRefactor +# f = map (flip (,) "a") "123" -- (,"a") +# f = map ((,) "a") "123" -- ("a",) # diff --git a/hlint.cabal b/hlint.cabal --- a/hlint.cabal +++ b/hlint.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: hlint -version: 3.0.1 +version: 3.0.2 license: BSD3 license-file: LICENSE category: Development diff --git a/src/Apply.hs b/src/Apply.hs --- a/src/Apply.hs +++ b/src/Apply.hs @@ -71,7 +71,7 @@ removeRequiresExtensionNotes :: ModuleEx -> Idea -> Idea removeRequiresExtensionNotes m = \x -> x{ideaNote = filter keep $ ideaNote x} where - exts = Set.fromList $ concatMap snd $ langExts $ pragmas $ ghcAnnotations m + exts = Set.fromList $ concatMap snd $ languagePragmas $ pragmas $ ghcAnnotations m keep (RequiresExtension x) = not $ x `Set.member` exts keep _ = True diff --git a/src/GHC/Util/ApiAnnotation.hs b/src/GHC/Util/ApiAnnotation.hs --- a/src/GHC/Util/ApiAnnotation.hs +++ b/src/GHC/Util/ApiAnnotation.hs @@ -1,8 +1,8 @@ module GHC.Util.ApiAnnotation ( comment, commentText, isCommentMultiline - , pragmas, flags, langExts - , mkFlags, mkLangExts + , pragmas, flags, languagePragmas + , mkFlags, mkLanguagePragmas ) where import ApiAnnotation @@ -83,12 +83,12 @@ <|> stripPrefixCI "OPTIONS " s] , let opts = words rest] --- Language extensions. The first element of the pair is the (located) --- annotation comment that enables the extensions enumerated by he --- second element of the pair. -langExts :: [(Located AnnotationComment, String)] +-- Language pragmas. The first element of the +-- pair is the (located) annotation comment that enables the +-- pragmas enumerated by he second element of the pair. +languagePragmas :: [(Located AnnotationComment, String)] -> [(Located AnnotationComment, [String])] -langExts ps = +languagePragmas ps = [(c, exts) | (c, s) <- ps , Just rest <- [stripPrefixCI "LANGUAGE " s] , let exts = map trim (splitOn "," rest)] @@ -98,6 +98,6 @@ mkFlags loc flags = L loc $ AnnBlockComment ("{-# " ++ "OPTIONS_GHC " ++ unwords flags ++ " #-}") -mkLangExts :: SrcSpan -> [String] -> Located AnnotationComment -mkLangExts loc exts = +mkLanguagePragmas :: SrcSpan -> [String] -> Located AnnotationComment +mkLanguagePragmas loc exts = L loc $ AnnBlockComment ("{-# " ++ "LANGUAGE " ++ intercalate ", " exts ++ " #-}") diff --git a/src/GHC/Util/FreeVars.hs b/src/GHC/Util/FreeVars.hs --- a/src/GHC/Util/FreeVars.hs +++ b/src/GHC/Util/FreeVars.hs @@ -154,7 +154,8 @@ freeVars' _ = mempty instance FreeVars' (LHsRecField GhcPs (LHsExpr GhcPs)) where - freeVars' (L _ (HsRecField _ x _)) = freeVars' x + freeVars' o@(L _ (HsRecField x _ True)) = Set.singleton $ occName $ unLoc $ rdrNameFieldOcc $ unLoc x -- a pun + freeVars' o@(L _ (HsRecField _ x _)) = freeVars' x instance FreeVars' (LHsRecUpdField GhcPs) where freeVars' (L _ (HsRecField _ x _)) = freeVars' x diff --git a/src/Hint/Extensions.hs b/src/Hint/Extensions.hs --- a/src/Hint/Extensions.hs +++ b/src/Hint/Extensions.hs @@ -236,13 +236,13 @@ extensionsHint _ x = [ rawIdea' Hint.Type.Warning "Unused LANGUAGE pragma" sl - (comment (mkLangExts sl exts)) + (comment (mkLanguagePragmas sl exts)) (Just newPragma) ( [RequiresExtension (show gone) | (_, Just x) <- before \\ after, gone <- Map.findWithDefault [] x disappear] ++ [ Note $ "Extension " ++ show x ++ " is " ++ reason x | (_, Just x) <- explainedRemovals]) - [ModifyComment (toSS' (mkLangExts sl exts)) newPragma] - | (L sl _, exts) <- langExts $ pragmas (ghcAnnotations x) + [ModifyComment (toSS' (mkLanguagePragmas sl exts)) newPragma] + | (L sl _, exts) <- languagePragmas $ pragmas (ghcAnnotations x) , let before = [(x, readExtension x) | x <- filterEnabled exts] , let after = filter (maybe True (`Set.member` keep) . snd) before , before /= after @@ -250,7 +250,7 @@ | null after && not (any (`Map.member` implied) $ mapMaybe snd before) = [] | otherwise = before \\ after , let newPragma = - if null after then "" else comment (mkLangExts sl $ map fst after) + if null after then "" else comment (mkLanguagePragmas sl $ map fst after) ] where filterEnabled :: [String] -> [String] @@ -264,7 +264,7 @@ -- All the extensions defined to be used. extensions :: Set.Set Extension extensions = Set.fromList $ mapMaybe readExtension $ - concatMap (filterEnabled . snd) $ langExts (pragmas (ghcAnnotations x)) + concatMap (filterEnabled . snd) $ languagePragmas (pragmas (ghcAnnotations x)) -- Those extensions we detect to be useful. useful :: Set.Set Extension diff --git a/src/Hint/Lambda.hs b/src/Hint/Lambda.hs --- a/src/Hint/Lambda.hs +++ b/src/Hint/Lambda.hs @@ -88,6 +88,8 @@ {-# LANGUAGE TypeApplications #-}; noBug545 = coerce ((<>) @[a]) {-# LANGUAGE QuasiQuotes #-}; authOAuth2 name = authOAuth2Widget [whamlet|Login via #{name}|] name {-# LANGUAGE QuasiQuotes #-}; authOAuth2 = foo (\name -> authOAuth2Widget [whamlet|Login via #{name}|] name) +f = {- generates a hint using hlint.yaml only -} map (flip (,) "a") "123" +f = {- generates a hint using hlint.yaml only -} map ((,) "a") "123" -} @@ -174,7 +176,7 @@ [suggestN' "Use section" o $ noLoc $ HsPar noExtField $ noLoc $ SectionL noExtField y oper] lambdaExp _ o@(L _ (HsPar _ (view' -> App2' (view' -> Var_' "flip") origf@(view' -> Var_' f) y))) - | allowRightSection f + | allowRightSection f, not $ "(" `isPrefixOf` f = [suggestN' "Use section" o $ noLoc $ HsPar noExtField $ noLoc $ SectionR noExtField origf y] lambdaExp p o@(L _ HsLam{}) | not $ any isOpApp p diff --git a/src/Hint/List.hs b/src/Hint/List.hs --- a/src/Hint/List.hs +++ b/src/Hint/List.hs @@ -32,6 +32,7 @@ issue619 = [pkgJobs | Pkg{pkgGpd, pkgJobs} <- pkgs, not $ null $ C.condTestSuites pkgGpd] {-# LANGUAGE MonadComprehensions #-}\ foo = [x | False, x <- [1 .. 10]] -- [] +foo = [_ | x <- _, let _ = A{x}] -} @@ -133,20 +134,19 @@ || any isPFieldWildcard (universeBi x) then const False else \x -> - let pvars = pvars' p in + let pvars = pvars' p + vars = varss' x + in -- See this code from 'RdrHsSyn.hs' (8.10.1): -- plus_RDR, pun_RDR :: RdrName -- plus_RDR = mkUnqual varName (fsLit "+") -- Hack -- pun_RDR = mkUnqual varName (fsLit "pun-right-hand-side") -- Todo (SF, 2020-03-28): Try to make this better somehow. - pvars `disjoint` vars_ x && "pun-right-hand-side" `notElem` pvars + pvars `disjoint` vars && "pun-right-hand-side" `notElem` pvars ) guards f guards (x@(L _ BodyStmt{}):xs) = f (x:guards) xs f guards (x@(L _ LetStmt{}):xs) = f (x:guards) xs f guards xs = reverse guards ++ xs - - -- Fake something that works - vars_ x = [unsafePrettyPrint a | HsVar _ (L _ a) <- universeBi x :: [HsExpr GhcPs]] listExp :: Bool -> LHsExpr GhcPs -> [Idea] listExp b (fromParen' -> x) = diff --git a/src/Hint/Pattern.hs b/src/Hint/Pattern.hs --- a/src/Hint/Pattern.hs +++ b/src/Hint/Pattern.hs @@ -87,7 +87,7 @@ concatMap (patHint strict True) (universeBi $ transformBi noPatBind x) ++ concatMap expHint (universeBi x) where - exts = nubOrd $ concatMap snd (langExts (pragmas (ghcAnnotations modu))) -- language extensions enabled at source + exts = nubOrd $ concatMap snd (languagePragmas (pragmas (ghcAnnotations modu))) -- language extensions enabled at source strict = "Strict" `elem` exts noPatBind :: LHsBind GhcPs -> LHsBind GhcPs diff --git a/src/Hint/Pragma.hs b/src/Hint/Pragma.hs --- a/src/Hint/Pragma.hs +++ b/src/Hint/Pragma.hs @@ -48,13 +48,13 @@ pragmaHint _ modu = let ps = pragmas (ghcAnnotations modu) opts = flags ps - lang = langExts ps in + lang = languagePragmas ps in languageDupes lang ++ optToPragma opts lang optToPragma :: [(Located AnnotationComment, [String])] -> [(Located AnnotationComment, [String])] -> [Idea] -optToPragma flags langExts = +optToPragma flags languagePragmas = [pragmaIdea (OptionsToComment (fst <$> old2) ys rs) | Just old2 <- [NE.nonEmpty old]] where (old, new, ns, rs) = @@ -62,16 +62,16 @@ | old <- flags, Just (new, ns) <- [optToLanguage old ls] , let r = mkRefact old new ns] - ls = concatMap snd langExts + ls = concatMap snd languagePragmas ns2 = nubOrd (concat ns) \\ ls - ys = [mkLangExts noSrcSpan ns2 | ns2 /= []] ++ catMaybes new + ys = [mkLanguagePragmas noSrcSpan ns2 | ns2 /= []] ++ catMaybes new mkRefact :: (Located AnnotationComment, [String]) -> Maybe (Located AnnotationComment) -> [String] -> Refactoring R.SrcSpan mkRefact old (maybe "" comment -> new) ns = - let ns' = map (\n -> comment (mkLangExts noSrcSpan [n])) ns + let ns' = map (\n -> comment (mkLanguagePragmas noSrcSpan [n])) ns in ModifyComment (toSS' (fst old)) (intercalate "\n" (filter (not . null) (new : ns'))) data PragmaIdea = SingleComment (Located AnnotationComment) (Located AnnotationComment) @@ -101,8 +101,8 @@ languageDupes :: [(Located AnnotationComment, [String])] -> [Idea] languageDupes ( (a@(L l _), les) : cs ) = (if nubOrd les /= les - then [pragmaIdea (SingleComment a (mkLangExts l $ nubOrd les))] - else [pragmaIdea (MultiComment a b (mkLangExts l (nubOrd $ les ++ les'))) | ( b@(L _ _), les' ) <- cs, not $ disjoint les les'] + then [pragmaIdea (SingleComment a (mkLanguagePragmas l $ nubOrd les))] + else [pragmaIdea (MultiComment a b (mkLanguagePragmas l (nubOrd $ les ++ les'))) | ( b@(L _ _), les' ) <- cs, not $ disjoint les les'] ) ++ languageDupes cs languageDupes _ = [] @@ -128,12 +128,12 @@ optToLanguage :: (Located AnnotationComment, [String]) -> [String] -> Maybe (Maybe (Located AnnotationComment), [String]) -optToLanguage (L loc _, flags) langExts +optToLanguage (L loc _, flags) languagePragmas | any isJust vs = -- '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` langExts)) (concat $ catMaybes vs) in + let ls = filter (not . (`elem` languagePragmas)) (concat $ catMaybes vs) in Just (res, ls) where -- Try reinterpreting each flag as a list of language features diff --git a/src/Hint/Restrict.hs b/src/Hint/Restrict.hs --- a/src/Hint/Restrict.hs +++ b/src/Hint/Restrict.hs @@ -43,7 +43,7 @@ let anns = ghcAnnotations m ps = pragmas anns opts = flags ps - exts = langExts ps in + exts = languagePragmas ps in checkPragmas modu opts exts restrict ++ maybe [] (checkImports modu $ hsmodImports (unLoc (ghcModule m))) (Map.lookup RestrictModule restrict) ++ maybe [] (checkFunctions modu $ hsmodDecls (unLoc (ghcModule m))) (Map.lookup RestrictFunction restrict)