hlint 2.0.15 → 2.1

raw patch · 13 files changed

+193/−101 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.txt +13/−1
• data/hlint.yaml +25/−0
• data/report_template.html +64/−65
• hlint.cabal +2/−2
• src/Apply.hs +7/−6
• src/HSE/All.hs +46/−1
• src/Hint/All.hs +1/−1
• src/Hint/Duplicate.hs +13/−7
• src/Hint/Lambda.hs +4/−1
• src/Hint/Monad.hs +2/−2
• src/Hint/Restrict.hs +3/−2
• src/Hint/Unsafe.hs +3/−3
• src/Idea.hs +10/−10

@@ -1,5 +1,17 @@-Changelog for HLint+Changelog for HLint (* = breaking change) +2.1, released 2018-02-07+*   #433, make ideas span multiple modules/declarations+    #433, allow ignoring statement-level duplication hint+    #439, add more fixities for new base operators+    #437, --json output should be finite+    #425, avoid misparsing use of Gtk2Hs `on` function+    #353, detect unused results from for/traverse/sequenceA+    #428, add a few rules for the lens package+    #429, spot restricted functions in infix operators+    #427, don't eta reduce variables in the presence of quasi-quotes+    Improve the HTML slightly+    #416, add lens package fixities 2.0.15, released 2018-01-18     #426, don't suggest removing brackets for "x . (x +? x . x)"     #426, better results with haskell-src-exts-util-0.2.2

@@ -36,6 +36,13 @@     - import Monad as Control.Monad     - import Char as Data.Char +- package:+    name: lens+    modules:+    - import Control.Lens+    - import Control.Lens.Operators+    - import Control.Monad.Reader+ - group:     name: default     enabled: true@@ -592,6 +599,22 @@     - warn: {lhs: null x  , rhs: "False", side: isTuple x, name: Using null on tuple}     - warn: {lhs: length x, rhs: "1"    , side: isTuple x, name: Using length on tuple} +- group:+    name: lens+    enabled: true+    imports:+    - package base+    - package lens+    rules:+    - warn: {lhs: "(a ^. b) ^. c", rhs: "a ^. (b . c)"}+    - warn: {lhs: "(a ^. b) ^? c", rhs: "a ^? (b . c)"}+    - warn: {lhs: "fromJust (a ^? b)", rhs: "a ^?! b"}+    - warn: {lhs: "a .~ Just b", rhs: "a ?~ b"}+    - warn: {lhs: "a & (mapped %~ b)", rhs: "a <&> b"}+    - warn: {lhs: "a & ((mapped . b) %~ c)", rhs: "a <&> b %~ c"}+    - warn: {lhs: "a & (mapped .~ b)", rhs: "b <$ a"}+    - warn: {lhs: "ask <&> (^. a)", rhs: "view a"}+    - warn: {lhs: "view a <&> (^. b)", rhs: "view (a . b)"}  - group:     name: generalise@@ -778,4 +801,6 @@ # import Prelude((==)) \ # import qualified Prelude as P \ # main = P.length xs == 0 -- P.null xs+# main = hello .~ Just 12 -- hello ?~ 12+# foo = liftIO $ window `on` deleteEvent $ do a; b # </TEST>

@@ -16,15 +16,15 @@  function deleteRules(n) {-	var css = document.styleSheets[0];-	for (var i = 0; i < n; i++)-		css.deleteRule(css.cssRules.length-1);+    var css = document.styleSheets[0];+    for (var i = 0; i < n; i++)+        css.deleteRule(css.cssRules.length-1); }  function insertRule(s) {-	var css = document.styleSheets[0];-	css.insertRule(s, css.cssRules.length);+    var css = document.styleSheets[0];+    css.insertRule(s, css.cssRules.length); }  // SHOW/HIDE LOGIC //@@ -33,28 +33,28 @@  function show(id) {-	if (id == last) return;-	if (id == "")-	{-		deleteRules(3);-		insertRule(".all {font-weight: bold;}");-	}-	else-	{-		if (last == "")-		{-			deleteRules(1);-			insertRule("#content div {display:none;}");-		}-		else-		{-			deleteRules(2);-		}-		insertRule("#content div." + id + " {display:block;}");-		insertRule("#" + id + "{font-weight:bold;}");-	}+    if (id == last) return;+    if (id == "")+    {+        deleteRules(3);+        insertRule(".all {font-weight: bold;}");+    }+    else+    {+        if (last == "")+        {+            deleteRules(1);+            insertRule("#content div {display:none;}");+        }+        else+        {+            deleteRules(2);+        }+        insertRule("#content div." + id + " {display:block;}");+        insertRule("#" + id + "{font-weight:bold;}");+    } -	last = id;+    last = id; }  </script>@@ -70,44 +70,43 @@ <style type="text/css"> /* See http://www.webreference.com/programming/css_frames/ */ body {-	margin:0;-	border:0;-	padding:0;-	height:100%;-	max-height:100%;-	font-family: sans-serif;-	font-size:76%;-	overflow: hidden;+    margin:0;+    border:0;+    padding:0;+    height:100%;+    max-height:100%;+    font-family: sans-serif;+    font-size:76%;+    overflow: hidden; }  #leftbar {-	position:absolute;-	top:0px;-	left:0px;-	width: 215px;-	bottom: 0px;-	overflow:auto;-	background:rgb(202,223,255);-	margin: 10px;-	padding-top: 0;-	padding-left: 7px;-	padding-right: 7px;-	-moz-border-radius: 5px;-	-webkit-border-radius: 5px;+    position:absolute;+    top:0px;+    left:0px;+    width: 215px;+    bottom: 0px;+    overflow:auto;+    background:rgb(202,223,255);+    margin: 10px;+    padding-top: 0;+    padding-left: 7px;+    padding-right: 7px;+    border-radius: 5px; -	display:none; /* Override if script present */+    display:none; /* Override if script present */ }  #content {-	position:absolute;-	top:0;-	bottom:0;-	right:0;-	overflow:auto;-	padding-bottom: 15px;-	padding-right: 7px;+    position:absolute;+    top:0;+    bottom:0;+    right:0;+    overflow:auto;+    padding-bottom: 15px;+    padding-right: 7px; -	left:10px; /* Override if script present */+    left:10px; /* Override if script present */ }  #leftbar ul {margin-top: 0px; padding-left: 15px;}@@ -115,16 +114,16 @@ .note {color: gray; font-size: smaller;}  pre {-	font-family: "lucida console", monospace;-	padding-left: 15px;-	margin: 2px;+    font-family: "lucida console", monospace;+    padding-left: 15px;+    margin: 2px; }  #content div {-	margin-bottom: 10px;-	margin-right: 10px;-	padding-top: 4px;-	border-top: 1px solid #ccc;+    margin-bottom: 10px;+    margin-right: 10px;+    padding-top: 4px;+    border-top: 1px solid #ccc; }  .script #content {left:250px;}@@ -158,9 +157,9 @@ </div> <div id="content" valign="top" width="100%"> <p>-	Report generated by <a href="http://community.haskell.org/~ndm/hlint/">HLint</a>+    Report generated by <a href="http://community.haskell.org/~ndm/hlint/">HLint</a> $VERSION-	- a tool to suggest improvements to your Haskell code.+    - a tool to suggest improvements to your Haskell code. </p>  $CONTENT

@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               hlint-version:            2.0.15+version:            2.1 license:            BSD3 license-file:       LICENSE category:           Development@@ -27,7 +27,7 @@ extra-doc-files:     README.md     CHANGES.txt-tested-with:        GHC==8.2.1, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+tested-with:        GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2  source-repository head     type:     git

@@ -45,15 +45,16 @@ applyHintsReal :: [Setting] -> Hint -> [(Module_, [Comment])] -> [Idea] applyHintsReal settings hints_ ms = concat $     [ map (classify $ cls ++ mapMaybe readPragma (universeBi m)) $-        order "" (hintModule hints settings nm m) `merge`-        concat [order (fromNamed d) $ decHints d | d <- moduleDecls m] `merge`-        concat [order "" $ hintComment hints settings c | c <- cs]+        order [] (hintModule hints settings nm m) `merge`+        concat [order [fromNamed d] $ decHints d | d <- moduleDecls m] `merge`+        concat [order [] $ hintComment hints settings c | c <- cs]     | (nm,(m,cs)) <- mns     , let decHints = hintDecl hints settings nm m -- partially apply-    , let order n = map (\i -> i{ideaModule=moduleName m, ideaDecl=n}) . sortBy (comparing ideaSpan)+    , let order n = map (\i -> i{ideaModule= f $ moduleName m : ideaModule i, ideaDecl= f $ n ++ ideaDecl i}) . sortBy (comparing ideaSpan)     , let merge = mergeBy (comparing ideaSpan)] ++     [map (classify cls) (hintModules hints settings $ map (second fst) mns)]     where+        f = nubOrd . filter (/= "")         cls = [x | SettingClassify x <- settings]         mns = map (scopeCreate . fst &&& id) ms         hints = (if length ms <= 1 then noModules else id) hints_@@ -88,6 +89,6 @@     where         -- figure out if we need to change the severity         f :: Idea -> Severity -> Classify -> Severity-        f i r c | classifyHint c ~= ideaHint i && classifyModule c ~= ideaModule i && classifyDecl c ~= ideaDecl i = classifySeverity c+        f i r c | classifyHint c ~= [ideaHint i] && classifyModule c ~= ideaModule i && classifyDecl c ~= ideaDecl i = classifySeverity c                 | otherwise = r-        x ~= y = null x || x == y+        x ~= y = null x || x `elem` y

@@ -48,10 +48,55 @@     ,hseFlags :: ParseMode -- ^ How the file is parsed (defaults to all fixities in the @base@ package and most non-conflicting extensions).     } +lensFixities :: [Fixity]+lensFixities = concat+    -- List as provided at https://github.com/ndmitchell/hlint/issues/416+    [infixr_ 4 ["%%@~","<%@~","%%~","<+~","<*~","<-~","<//~","<^~","<^^~","<**~"]+    ,infix_ 4 ["%%@=","<%@=","%%=","<+=","<*=","<-=","<//=","<^=","<^^=","<**="]+    ,infixr_ 2 ["<<~"]+    ,infixr_ 9 ["#."]+    ,infixl_ 8 [".#"]+    ,infixr_ 8 ["^!","^@!"]+    ,infixl_ 1 ["&","<&>","??"]+    ,infixl_ 8 ["^.","^@."]+    ,infixr_ 9 ["<.>","<.",".>"]+    ,infixr_ 4 ["%@~",".~","+~","*~","-~","//~","^~","^^~","**~","&&~","<>~","||~","%~"]+    ,infix_ 4 ["%@=",".=","+=","*=","-=","//=","^=","^^=","**=","&&=","<>=","||=","%="]+    ,infixr_ 2 ["<~"]+    ,infixr_ 2 ["`zoom`","`magnify`"]+    ,infixl_ 8 ["^..","^?","^?!","^@..","^@?","^@?!"]+    ,infixl_ 8 ["^#"]+    ,infixr_ 4 ["<#~","#~","#%~","<#%~","#%%~"]+    ,infix_ 4 ["<#=","#=","#%=","<#%=","#%%="]+    ,infixl_ 9 [":>"]+    ,infixr_ 4 ["</>~","<</>~","<.>~","<<.>~"]+    ,infix_ 4 ["</>=","<</>=","<.>=","<<.>="]+    ,infixr_ 4 [".|.~",".&.~","<.|.~","<.&.~"]+    ,infix_ 4 [".|.=",".&.=","<.|.=","<.&.="]+    ]++-- Fixites from the `base` package which are currently+-- missing from `haskell-src-exts`'s baseFixities.+-- see https://github.com/haskell-suite/haskell-src-exts/pull/400+baseNotYetInHSE :: [Fixity]+baseNotYetInHSE = concat+    [infixr_ 9 ["`Compose`"]+    ,infixr_ 6 ["<>"]+    ,infixr_ 5 ["<|"]+    ,infixl_ 4 ["<$!>","<$","$>"]+    ,infix_ 4 [":~:", ":~~:"]+    ]++customFixities :: [Fixity]+customFixities =+    infixl_ 1 ["`on`"]+        -- see https://github.com/ndmitchell/hlint/issues/425+        -- otherwise GTK apps using `on` at a different fixity have spurious warnings+ -- | Default value for 'ParseFlags'. defaultParseFlags :: ParseFlags defaultParseFlags = ParseFlags NoCpp-    defaultParseMode{fixities=Just baseFixities, ignoreLinePragmas=False, ignoreFunctionArity=True, extensions=defaultExtensions}+    defaultParseMode{fixities=Just $ customFixities ++ baseFixities ++ baseNotYetInHSE ++ lensFixities, ignoreLinePragmas=False, ignoreFunctionArity=True, extensions=defaultExtensions}  parseFlagsNoLocations :: ParseFlags -> ParseFlags parseFlagsNoLocations x = x{cppFlags = case cppFlags x of Cpphs y -> Cpphs $ f y; y -> y}

@@ -52,7 +52,7 @@     HintExport     -> modu exportHint     HintPragma     -> modu pragmaHint     HintExtensions -> modu extensionsHint-    HintUnsafe     -> modu unsafeHint+    HintUnsafe     -> decl unsafeHint     HintDuplicate  -> mods duplicateHint     HintComment    -> comm commentHint     HintNewType    -> decl newtypeHint

@@ -12,6 +12,7 @@ main = do a; a; a; b; a; a; a -- ??? main = do a; a; a; b; a; a foo = a where {a = 1; b = 2; c = 3}; bar = a where {a = 1; b = 2; c = 3} -- ???+{-# ANN main "HLint: ignore Reduce duplication" #-}; main = do a; a; a; a; a; a -- @Ignore ??? </TEST> -} @@ -19,6 +20,7 @@ module Hint.Duplicate(duplicateHint) where  import Hint.Type+import Data.Default import Data.Tuple.Extra import Data.List hiding (find) import qualified Data.Map as Map@@ -26,18 +28,22 @@  duplicateHint :: CrossHint duplicateHint ms =-    dupes [y | Do _ y :: Exp S <- universeBi modu] ++-    dupes [y | BDecls l y :: Binds S <- universeBi modu]-    where modu = map snd ms+    dupes [(m,d,y) | (m,d,x) <- ds, Do _ y :: Exp S <- universeBi x] +++    dupes [(m,d,y) | (m,d,x) <- ds, BDecls _ y :: Binds S <- universeBi x]+    where ds = [(moduleName m, fromNamed d, d) | m <- map snd ms, d <- moduleDecls m]  +dupes :: (Pretty (f SrcSpan), Annotated f, Ord (f ())) => [(String, String, [f S])] -> [Idea] dupes ys =-    [rawIdeaN+    [(rawIdeaN         (if length xs >= 5 then Warning else Suggestion)         "Reduce duplication" p1         (unlines $ map (prettyPrint . fmap (const p1)) xs)-        (Just $ "Combine with " ++ showSrcLoc (getPointLoc p2)) []-    | (p1,p2,xs) <- duplicateOrdered 3 $ map (map (srcInfoSpan . ann &&& dropAnn)) ys]+        (Just $ "Combine with " ++ showSrcLoc (getPointLoc p2)) [])+      {ideaModule = [m1,m2], ideaDecl = [d1,d2]}+    | ((m1,d1,p1),(m2,d2,p2),xs) <- duplicateOrdered 3 $ map f ys]+    where+        f (m,d,xs) = [((m,d,srcInfoSpan $ ann x), dropAnn x) | x <- xs]   ---------------------------------------------------------------------@@ -59,7 +65,7 @@     where f new = add pos vs  -duplicateOrdered :: Ord val => Int -> [[(SrcSpan,val)]] -> [(SrcSpan,SrcSpan,[val])]+duplicateOrdered :: (Ord pos, Default pos, Ord val) => Int -> [[(pos,val)]] -> [(pos,pos,[val])] duplicateOrdered threshold xs = concat $ concat $ snd $ mapAccumL f (Dupe def Map.empty) xs     where         f d xs = second overlaps $ mapAccumL (g pos) d $ takeWhile ((>= threshold) . length) $ tails xs

@@ -68,6 +68,8 @@ baz = bar (\x -> (x +)) -- (+) yes = blah (\ x -> case x of A -> a; B -> b) -- \ case A -> a; B -> b no = blah (\ x -> case x of A -> a x; B -> b x)+{-# LANGUAGE QuasiQuotes #-}; authOAuth2 name = authOAuth2Widget [whamlet|Login via #{name}|] name+{-# LANGUAGE QuasiQuotes #-}; authOAuth2 = foo (\name -> authOAuth2Widget [whamlet|Login via #{name}|] name) </TEST> -} @@ -118,6 +120,7 @@ etaReduce :: [Pat_] -> Exp_ -> ([Pat_], Exp_) etaReduce ps (App _ x (Var _ (UnQual _ (Ident _ y))))     | ps /= [], PVar _ (Ident _ p) <- last ps, p == y, p /= "mr", y `notElem` vars x+    , not $ any isQuasiQuote $ universe x     = etaReduce (init ps) x etaReduce ps (InfixApp a x (isDol -> True) y) = etaReduce ps (App a x y) etaReduce ps x = (ps,x)@@ -133,7 +136,7 @@ --      subts = [("a", toSS y), ("*", toSS v)] lambdaExp p o@(Paren _ (App _ (App _ (view -> Var_ "flip") (Var _ x)) y)) | allowRightSection $ fromNamed x =     [suggestN "Use section" o $ RightSection an (QVarOp an x) y]-lambdaExp p o@Lambda{} | maybe True (not . isInfixApp) p, (res, refact) <- niceLambdaR [] o, not $ isLambda res =+lambdaExp p o@Lambda{} | maybe True (not . isInfixApp) p, (res, refact) <- niceLambdaR [] o, not $ isLambda res, not $ any isQuasiQuote $ universe res =     [(if isVar res || isCon res then warn else suggest) "Avoid lambda" o res (refact $ toSS o)] lambdaExp p o@(Lambda _ pats x) | isLambda (fromParen x), null (universeBi pats :: [Exp_]), maybe True (not . isLambda) p =     [suggest "Collapse lambdas" o (Lambda an pats body) [Replace Expr (toSS o) subts template]]

@@ -57,7 +57,7 @@ import Prelude  -badFuncs = ["mapM","foldM","forM","replicateM","sequence","zipWithM"]+badFuncs = ["mapM","foldM","forM","replicateM","sequence","zipWithM","traverse","for","sequenceA"]   monadHint :: DeclHint@@ -109,7 +109,7 @@                                       in go -> (ret:f:fs, view -> Var_ v))):g@(Generator _ (view -> PVar_ u) x):rest)     | ret ~= "return", notDol x, u == v, null rest, v `notElem` vars (f:fs)     = Just (reverse (Qualifier an (InfixApp an (foldl' (flip (InfixApp an) (toNamed ".")) f fs) (toNamed "<$>") x):rest),-            [Replace Stmt (toSS g) (("x", toSS x):zip vs (toSS <$> f:fs)) (intercalate " . " vs ++ " <$> x"), Delete Stmt (toSS q)])+            [Replace Stmt (toSS g) (("x", toSS x):zip vs (toSS <$> f:fs)) (intercalate " . " (take (length fs + 1) vs) ++ " <$> x"), Delete Stmt (toSS q)])   where vs = ('f':) . show <$> [0..]         notDol (InfixApp _ _ op _) = not $ isDol op         notDol _ = True

@@ -6,6 +6,7 @@ -- These tests rely on the .hlint.yaml file in the root <TEST> foo = unsafePerformIO --+foo = bar `unsafePerformIO` baz -- module Util where otherFunc = unsafePerformIO $ print 1 -- module Util where exitMessageImpure = unsafePerformIO $ print 1 foo = unsafePerformOI@@ -93,9 +94,9 @@  checkFunctions :: String -> [Decl_] -> (Bool, Map.Map String RestrictItem) -> [Idea] checkFunctions modu decls (def, mp) =-    [ ideaMayBreak $ ideaNoTo $ warn "Avoid restricted function" x x []+    [ (ideaMayBreak $ ideaNoTo $ warn "Avoid restricted function" x x []){ideaDecl = [dname]}     | d <- decls     , let dname = fromNamed d-    , x@Var{} <- universeBi d+    , x <- universeBi d :: [QName S]     , not $ maybe def (within modu dname) $ Map.lookup (fromNamed x) mp     ]

@@ -23,13 +23,13 @@ import Refact.Types  -unsafeHint :: ModuHint-unsafeHint _ m =+unsafeHint :: DeclHint+unsafeHint _ m = \d ->         [ rawIdea Warning "Missing NOINLINE pragma" (srcInfoSpan $ ann d)             (prettyPrint d)             (Just $ dropWhile isSpace (prettyPrint $ gen x) ++ "\n" ++ prettyPrint d)             [] [InsertComment (toSS d) (prettyPrint $ gen x)]-        | d@(PatBind _ (PVar _ x) _ _) <- moduleDecls m+        | d@(PatBind _ (PVar _ x) _ _) <- [d]         , isUnsafeDecl d, x `notElem_` noinline]     where         gen x = InlineSig an False Nothing $ UnQual an x

@@ -23,8 +23,8 @@  -- | An idea suggest by a 'Hint'. data Idea = Idea-    {ideaModule :: String -- ^ The module the idea applies to, may be @\"\"@ if the module cannot be determined or is a result of cross-module hints.-    ,ideaDecl :: String -- ^ The declaration the idea applies to, typically the function name, but may be a type name.+    {ideaModule :: [String] -- ^ The modules the idea is for, usually a singleton.+    ,ideaDecl :: [String] -- ^ The declarations the idea is for, usually a singleton, typically the function name, but may be a type name.     ,ideaSeverity :: Severity -- ^ The severity of the idea, e.g. 'Warning'.     ,ideaHint :: String -- ^ The name of the hint that generated the idea, e.g. @\"Use reverse\"@.     ,ideaSpan :: SrcSpan -- ^ The source code the idea relates to.@@ -39,9 +39,9 @@ -- 1) Aeson doesn't esape unicode characters, and I want to (allows me to ignore encoding) -- 2) I want to control the format so it's slightly human readable as well showIdeaJson :: Idea -> String-showIdeaJson idea@Idea{ideaSpan=srcSpan@SrcSpan{..}, ..} = wrap . intercalate "," . map mkPair $-    [("module", str ideaModule)-    ,("decl", str ideaDecl)+showIdeaJson idea@Idea{ideaSpan=srcSpan@SrcSpan{..}, ..} = dict+    [("module", list $ map str ideaModule)+    ,("decl", list $ map str ideaDecl)     ,("severity", str $ show ideaSeverity)     ,("hint", str ideaHint)     ,("file", str srcSpanFilename)@@ -51,7 +51,7 @@     ,("endColumn", show srcSpanEndColumn)     ,("from", str ideaFrom)     ,("to", maybe "null" str ideaTo)-    ,("note", "[" ++ intercalate "," (map (str . show) ideaNote) ++ "]")+    ,("note", list (map (str . show) ideaNote))     ,("refactorings", str $ show ideaRefactoring)     ]   where@@ -62,8 +62,8 @@               f '\r' = "\\r"               f x | isControl x || not (isAscii x) = "\\u" ++ takeEnd 4 ("0000" ++ showHex (ord x) "")               f x = [x]-    mkPair (k, v) = show k ++ ":" ++ v-    wrap x = "{" ++ x ++ "}"+    dict xs = "{" ++ intercalate "," [show k ++ ":" ++ v | (k,v) <- xs] ++ "}"+    list xs = "[" ++ intercalate "," xs ++ "]"  showIdeasJson :: [Idea] -> String showIdeasJson ideas = "[" ++ intercalate "\n," (map showIdeaJson ideas) ++ "]"@@ -87,8 +87,8 @@             where xs = lines $ tt x  -rawIdea = Idea "" ""-rawIdeaN a b c d e f = Idea "" "" a b c d e f []+rawIdea = Idea [] []+rawIdeaN a b c d e f = Idea [] [] a b c d e f []  idea severity hint from to = rawIdea severity hint (srcInfoSpan $ ann from) (f from) (Just $ f to) []     where f = trimStart . prettyPrint