hlint 3.2.2 → 3.2.3
raw patch · 7 files changed
+68/−47 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGES.txt +6/−0
- hlint.cabal +4/−2
- src/HLint.hs +5/−4
- src/Hint/Lambda.hs +31/−10
- src/Hint/Restrict.hs +15/−11
- src/HsColour.hs +5/−13
- src/Idea.hs +2/−7
CHANGES.txt view
@@ -1,5 +1,11 @@ Changelog for HLint (* = breaking change) +3.2.3, released 2020-11-23+ #1160, never consult the .hscolour file for color preferences+ #1171, do not refactor redundant lambda with case+ #1169, default to -A32 (doubles speed for 4 CPU)+ #1169, make -j actually use parallelism+ #1167, enable refactoring for "Use lambda" 3.2.2, released 2020-11-15 #1166, detect more unboxed data to avoid suggesting newtype #1153, fix incorrect redundant bracket with @($foo)
hlint.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: hlint-version: 3.2.2+version: 3.2.3 license: BSD3 license-file: LICENSE category: Development@@ -165,6 +165,8 @@ build-depends: base, hlint main-is: src/Main.hs - ghc-options: -rtsopts+ -- See https://github.com/ndmitchell/hlint/pull/1169 for benchmarks+ -- that indicate -A32 is a good idea+ ghc-options: -rtsopts -with-rtsopts=-A32m if flag(threaded) ghc-options: -threaded
src/HLint.hs view
@@ -134,6 +134,8 @@ cmd@CmdMain{..} <- if null args2 then pure cmd else getCmd $ args2 ++ args1 -- command line arguments are passed last settings2 <- concatMapM (fmap snd . computeSettings (cmdParseFlags cmd)) cmdFindHints let settings3 = [SettingClassify $ Classify Ignore x "" "" | x <- cmdIgnore]+ cmdThreads <- if cmdThreads == 0 then getNumProcessors else pure cmdThreads+ cmd <- pure CmdMain {..} pure (cmd, settings1 ++ settings2 ++ settings3) where enableGroup groupName =@@ -144,9 +146,8 @@ ] runHints :: [String] -> [Setting] -> Cmd -> IO [Idea]-runHints args settings cmd@CmdMain{..} = do- j <- if cmdThreads == 0 then getNumProcessors else pure cmdThreads- withNumCapabilities j $ do+runHints args settings cmd@CmdMain{..} =+ withNumCapabilities cmdThreads $ do let outStrLn = whenNormal . putStrLn ideas <- getIdeas cmd settings ideas <- pure $ if cmdShowAll then ideas else filter (\i -> ideaSeverity i /= Ignore) ideas@@ -161,7 +162,7 @@ handleRefactoring ideas cmdFiles cmd else do usecolour <- cmdUseColour cmd- showItem <- if usecolour then showANSI else pure show+ let showItem = if usecolour then showIdeaANSI else show mapM_ (outStrLn . showItem) ideas handleReporting ideas cmd pure ideas
src/Hint/Lambda.hs view
@@ -80,10 +80,11 @@ baz = bar (\x -> (x +)) -- (+) xs `withArgsFrom` args = f args foo = bar (\x -> case x of Y z -> z) -- \(Y z) -> z-foo = bar (\x -> case x of Y z | z > 0 -> z) -- \case Y z | z > 0 -> z+foo = bar (\x -> case x of [y, z] -> z) -- \[y, z] -> z 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)+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) yes = blah (\ x -> (y, x, y, u, v)) -- (y, , y, u, v)@@ -103,7 +104,7 @@ module Hint.Lambda(lambdaHint) where -import Hint.Type (DeclHint, Idea, Note(RequiresExtension), suggest, warn, toSS, suggestN, ideaNote, substVars)+import Hint.Type (DeclHint, Idea, Note(RequiresExtension), suggest, warn, toSS, suggestN, ideaNote, substVars, toRefactSrcSpan) import Util import Data.List.Extra import Data.Set (Set)@@ -142,7 +143,11 @@ (sub, tpl) = mkSubtsAndTpl newPats newBody gen :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsDecl GhcPs gen ps = uncurry reform . fromLambda . lambda ps- in [warn "Redundant lambda" o (gen pats origBody) [Replace Decl (toSS o) sub tpl]]+ refacts = case newBody of+ -- https://github.com/alanz/ghc-exactprint/issues/97+ L _ HsCase{} -> []+ _ -> [Replace Decl (toSS o) sub tpl]+ in [warn "Redundant lambda" o (gen pats origBody) refacts] | let (newPats, newBody) = etaReduce pats origBody , length newPats < length pats, pvars (drop (length newPats) pats) `disjoint` varss bind@@ -252,14 +257,30 @@ -- * mark match as being in a lambda context so that it's printed properly oldMG@(MG _ (L _ [L _ oldmatch]) _) | all (\(L _ (GRHS _ stmts _)) -> null stmts) (grhssGRHSs (m_grhss oldmatch)) ->- [suggestN "Use lambda" o $ noLoc $ HsLam noExtField oldMG- { mg_alts = noLoc- [noLoc oldmatch- { m_pats = map mkParPat $ m_pats oldmatch- , m_ctxt = LambdaExpr+ let patLocs = fmap getLoc (m_pats oldmatch)+ bodyLocs = concatMap (\case L _ (GRHS _ _ body) -> [getLoc body]; _ -> [])+ $ grhssGRHSs (m_grhss oldmatch)+ r | notNull patLocs && notNull bodyLocs =+ let xloc = foldl1' combineSrcSpans patLocs+ yloc = foldl1' combineSrcSpans bodyLocs+ in [ Replace Expr (toSS o) [("x", toRefactSrcSpan xloc), ("y", toRefactSrcSpan yloc)]+ ((if needParens then "\\(x)" else "\\x") ++ " -> y")+ ]+ | otherwise = []+ needParens = any (patNeedsParens appPrec . unLoc) (m_pats oldmatch)+ in [ suggest "Use lambda" o+ ( noLoc $ HsLam noExtField oldMG+ { mg_alts = noLoc+ [ noLoc oldmatch+ { m_pats = map mkParPat $ m_pats oldmatch+ , m_ctxt = LambdaExpr+ }+ ] }- ] }- ]+ :: LHsExpr GhcPs+ )+ r+ ] -- otherwise we should use @LambdaCase@ MG _ (L _ _) _ ->
src/Hint/Restrict.hs view
@@ -178,16 +178,20 @@ , let dname = fromMaybe "" (declName d) , x <- universeBi d :: [Located RdrName] , let xMods = possModules scope x- , let (withins, message) = fromMaybe ([("","") | def], Nothing) (findFunction x xMods)+ , let (withins, message) = fromMaybe ([("","") | def], Nothing) (findFunction mp x xMods) , not $ within modu dname withins ]- where- -- Returns Just iff there are rules for x, which are either unqualified, or qualified with a module that is- -- one of x's possible modules.- -- If there are multiple matching rules (e.g., there's both an unqualified version and a qualified version), their- -- withins and messages are concatenated with (<>).- findFunction :: Located RdrName -> [ModuleName] -> Maybe ([(String, String)], Maybe String)- findFunction (rdrNameStr -> x) (map moduleNameString -> possMods)- | Just (RestrictFun mp) <- Map.lookup x mp =- fmap sconcat . NonEmpty.nonEmpty . Map.elems $ Map.filterWithKey (const . maybe True (`elem` possMods)) mp- | otherwise = Nothing++-- Returns Just iff there are rules for x, which are either unqualified, or qualified with a module that is+-- one of x's possible modules.+-- If there are multiple matching rules (e.g., there's both an unqualified version and a qualified version), their+-- withins and messages are concatenated with (<>).+findFunction+ :: Map.Map String RestrictFunction+ -> Located RdrName+ -> [ModuleName]+ -> Maybe ([(String, String)], Maybe String)+findFunction restrictMap (rdrNameStr -> x) (map moduleNameString -> possMods) = do+ (RestrictFun mp) <- Map.lookup x restrictMap+ n <- NonEmpty.nonEmpty . Map.elems $ Map.filterWithKey (const . maybe True (`elem` possMods)) mp+ pure (sconcat n)
src/HsColour.hs view
@@ -1,32 +1,24 @@ {-# LANGUAGE CPP #-}-module HsColour(hsColourHTML, hsColourConsole, hsColourConsolePure) where+module HsColour(hsColourHTML, hsColourConsole) where #ifdef GPL_SCARES_ME -hsColourConsole :: IO (String -> String)-hsColourConsole = pure id--hsColourConsolePure :: String -> String-hsColourConsolePure = id+hsColourConsole :: String -> String+hsColourConsole = id hsColourHTML :: String -> String hsColourHTML = id #else -import Data.Functor import Prelude import Language.Haskell.HsColour.TTY as TTY import Language.Haskell.HsColour.Colourise import Language.Haskell.HsColour.CSS as CSS --hsColourConsole :: IO (String -> String)-hsColourConsole = TTY.hscolour <$> readColourPrefs--hsColourConsolePure :: String -> String-hsColourConsolePure = TTY.hscolour defaultColourPrefs+hsColourConsole :: String -> String+hsColourConsole = TTY.hscolour defaultColourPrefs hsColourHTML :: String -> String hsColourHTML = CSS.hscolour False 1
src/Idea.hs view
@@ -4,12 +4,11 @@ Idea(..), rawIdea, idea, suggest, suggestRemove, ideaRemove, warn, ignore, rawIdeaN, suggestN, ignoreNoSuggestion,- showIdeasJson, showANSI, showIdeaANSI,+ showIdeasJson, showIdeaANSI, Note(..), showNotes, Severity(..), ) where -import Data.Functor import Data.List.Extra import Config.Type import HsColour@@ -68,13 +67,9 @@ show = showEx id --- | Show an 'Idea' with ANSI color, using the hscolour preferences file.-showANSI :: IO (Idea -> String)-showANSI = showEx <$> hsColourConsole- -- | Show an 'Idea' with ANSI color codes to give syntax coloring to the Haskell code. showIdeaANSI :: Idea -> String-showIdeaANSI = showEx hsColourConsolePure+showIdeaANSI = showEx hsColourConsole showEx :: (String -> String) -> Idea -> String showEx tt Idea{..} = unlines $