packages feed

hlint 3.1.5 → 3.1.6

raw patch · 12 files changed

+121/−10 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

CHANGES.txt view
@@ -1,5 +1,9 @@ Changelog for HLint (* = breaking change) +3.1.6, released 2020-06-24+    #1062, make sure matching inserts brackets if required+    #1058, weaken the self-definition check to match more things+    #1060, suggest [] ++ x and [] ++ x to x 3.1.5, released 2020-06-19     #1049, suggest or/and from True `elem` xs and False `notElem` xs     #1055, avoid incorrect hints with nested (.)'s
data/hlint.yaml view
@@ -737,6 +737,8 @@     - warn: {lhs: const x y, rhs: x, name: Evaluate}     - warn: {lhs: any (const False), rhs: const False, note: IncreasesLaziness, name: Evaluate}     - warn: {lhs: all (const True), rhs: const True, note: IncreasesLaziness, name: Evaluate}+    - warn: {lhs: "[] ++ x", rhs: x, name: Evaluate}+    - warn: {lhs: "x ++ []", rhs: x, name: Evaluate}      # FOLDABLE + TUPLES @@ -1172,6 +1174,8 @@ # issue1055 = map f ((sort . map g) xs) # issue1049 = True `elem` xs -- or xs # issue1049 = elem True -- or+# issue1062 = bar (\(f, x) -> baz () () . f $ x) -- uncurry ((.) (baz () ()))+# issue1058 n = [] ++ issue1058 (n+1) -- issue1058 (n+1)  # import Prelude \ # yes = flip mapM -- Control.Monad.forM
hlint.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               hlint-version:            3.1.5+version:            3.1.6 license:            BSD3 license-file:       LICENSE category:           Development@@ -158,6 +158,7 @@         Test.Annotations         Test.InputOutput         Test.Proof+        Test.Summary         Test.Translate         Test.Util
src/CmdLine.hs view
@@ -149,6 +149,7 @@         ,cmdQuickCheck :: Bool         ,cmdTypeCheck :: Bool         ,cmdWithRefactor :: FilePath+        ,cmdGenerateSummary :: Bool      -- ^ Generate a summary of built-in hints         }     deriving (Data,Typeable,Show) @@ -196,6 +197,7 @@         ,cmdTypeCheck = nam_ "typecheck" &= help "Use GHC to type check the hints"         ,cmdQuickCheck = nam_ "quickcheck" &= help "Use QuickCheck to check the hints"         ,cmdTempDir = nam_ "tempdir" &= help "Where to put temporary files (not cleaned up)"+        ,cmdGenerateSummary = nam_ "generate-summary" &= help "Generate a summary of built-in hints"         } &= explicit &= name "test"         &= details ["HLint gives hints on how to improve Haskell code."                    ,""
src/GHC/Util/Unify.hs view
@@ -171,7 +171,12 @@     | (L _ (OpApp _ lhs1 op1@(L _ (HsVar _ op1')) rhs1)) <- x =         guard (nm op1' op2') >> (, Nothing) <$> liftA2 (<>) (unifyExp' nm False lhs1 lhs2) (unifyExp' nm False rhs1 rhs2)     | isDol op2 = unifyExp nm root x $ noLoc (HsApp noExtField lhs2 rhs2)-    | otherwise  = unifyExp nm root x $ noLoc (HsApp noExtField (noLoc (HsApp noExtField op2 lhs2)) rhs2)+    | otherwise  = unifyExp nm root x $ noLoc (HsApp noExtField (noLoc (HsApp noExtField op2 (addPar lhs2))) (addPar rhs2))+        where+          -- add parens around when desugaring the expression, if necessary+          addPar :: LHsExpr GhcPs -> LHsExpr GhcPs+          addPar x = if isAtom x then x else addParen x+ unifyExp nm root x y = (, Nothing) <$> unifyExp' nm root x y  -- | If we "throw away" the extra than we have no where to put it, and the substitution is wrong
src/Hint/Duplicate.hs view
@@ -6,13 +6,14 @@ If you have n the same, error out  <TEST>+foo = a where {a = 1; b = 2; c = 3} \+bar = a where {a = 1; b = 2; c = 3} -- ??? @NoRefactor main = do a; a; a; a main = do a; a; a; a; a; a -- ??? @NoRefactor: refactoring not supported for duplication hints. main = do a; a; a; a; a; a; a -- ??? @NoRefactor main = do (do b; a; a; a); do (do c; a; a; a) -- ??? @NoRefactor main = do a; a; a; b; a; a; a -- ??? @NoRefactor 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} -- ??? @NoRefactor {-# ANN main "HLint: ignore Reduce duplication" #-}; main = do a; a; a; a; a; a -- @Ignore ??? @NoRefactor {-# HLINT ignore main "Reduce duplication" #-}; main = do a; a; a; a; a; a -- @Ignore ??? @NoRefactor {- HLINT ignore main "Reduce duplication" -}; main = do a; a; a; a; a; a -- @Ignore ??? @NoRefactor
src/Hint/Match.hs view
@@ -157,7 +157,7 @@   guard $ not (any isLambda $ universe lhs) || not (any isQuasiQuote $ universe x)    guard $ checkSide (unextendInstances <$> hintRuleSide) $ ("original", x) : ("result", res) : fromSubst u-  guard $ checkDefine declName parent res+  guard $ checkDefine declName parent rhs    (u, tpl) <- pure $ if any ((== noSrcSpan) . getLoc . snd) (fromSubst u) then (mempty, res) else (u, tpl)   tpl <- pure $ unqualify sa sb (performSpecial tpl)
src/Hint/Pragma.hs view
@@ -15,6 +15,7 @@ {-# OPTIONS_YHC -cpp #-} {-# OPTIONS_GHC -XFoo #-} -- {-# LANGUAGE Foo #-} {-# OPTIONS_GHC -fglasgow-exts #-} -- ??? @NoRefactor+{-# LANGUAGE RebindableSyntax, EmptyCase, RebindableSyntax #-} -- {-# LANGUAGE RebindableSyntax, EmptyCase #-} {-# LANGUAGE RebindableSyntax, EmptyCase, DuplicateRecordFields, RebindableSyntax #-} -- {-# LANGUAGE RebindableSyntax, EmptyCase, DuplicateRecordFields #-} {-# LANGUAGE RebindableSyntax #-} {-# OPTIONS_GHC -cpp -foo #-} -- {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -foo #-} @NoRefactor -foo is not a valid flag
src/Test/All.hs view
@@ -9,7 +9,9 @@ import Control.Monad.IO.Class import Data.Char import Data.Either.Extra+import Data.Foldable import Data.List+import Data.Maybe import System.Directory import System.FilePath import Data.Functor@@ -20,10 +22,11 @@ import CmdLine import Refact import Hint.All-import Test.Util-import Test.InputOutput import Test.Annotations+import Test.InputOutput+import Test.Summary import Test.Translate+import Test.Util import System.IO.Extra import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable @@ -32,7 +35,7 @@ test CmdTest{..} main dataDir files = do     rpath <- refactorPath (if cmdWithRefactor == "" then Nothing else Just cmdWithRefactor) -    (failures, ideas) <- withBuffering stdout NoBuffering $ withTests $ do+    (failures, (ideas, builtins)) <- withBuffering stdout NoBuffering $ withTests $ do         hasSrc <- liftIO $ doesFileExist "hlint.cabal"         let useSrc = hasSrc && null files         testFiles <- if files /= [] then pure files else do@@ -63,8 +66,9 @@             progress >> testQuickCheck cmdDataDir cmdTempDir hs          when (null files && not hasSrc) $ liftIO $ putStrLn "Warning, couldn't find source code, so non-hint tests skipped"-        getIdeas+        (,) <$> getIdeas <*> getBuiltins     whenLoud $ mapM_ print ideas+    when cmdGenerateSummary $ writeFile "builtin.md" (genBuiltinSummaryMd builtins)     case rpath of         Left refactorNotFound -> putStrLn $ unlines [refactorNotFound, "Refactoring tests skipped"]         _ -> pure ()
src/Test/Annotations.hs view
@@ -66,6 +66,8 @@                 evaluate $ length $ show res                 pure res +            when ("src/Hint" `isPrefixOf` file) $ mapM_ (mapM_ (addBuiltin inp)) ideas+             -- the hints from data/Test.hs are really fake hints we don't actually deploy             -- so don't record them             when (takeFileName file /= "Test.hs") $
+ src/Test/Summary.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE RecordWildCards #-}++-- | Generate a markdown that summarizes the builtin hints.+module Test.Summary (genBuiltinSummaryMd) where++import qualified Data.Map as Map+import Config.Type+import Test.Util++genBuiltinSummaryMd :: BuiltinSummary -> String+genBuiltinSummaryMd builtins = unlines $+  [ "# Built-in Hints"+  , ""+  , "This page is auto-generated from `cabal run hlint test -- --generate-summary`"+  , "or `stack run hlint test -- --generate-summary`."+  , ""+  ]+  ++ table builtins++table :: BuiltinSummary -> [String]+table builtins =+  ["<table>"]+  ++ row ["<th>Hint</th>", "<th>Severity</th>", "<th>Support Refactoring?</th>"]+  ++ Map.foldMapWithKey showHint builtins+  ++ ["</table>"]++row :: [String] -> [String]+row xs = ["<tr>"] ++ xs ++ ["</tr>"]++-- | Render using <code> if it is single-line, otherwise using <pre>.+haskell :: String -> [String]+haskell s+  | '\n' `elem` s = ["<pre>", s, "</pre>"]+  | otherwise = ["<code>", s, "</code>", "<br>"]++showHint :: (String, Severity, Bool) -> BuiltinEx -> [String]+showHint (hint, sev, refact) BuiltinEx{..} = row1 ++ row2+  where+    row1 = row+      [ "<td rowspan=2>" ++ hint ++ "</td>"+      , "<td>" ++ show sev ++ "</td>"+      , "<td>" ++ if refact then "Yes" else "No" ++ "</td>"+      ]+    row2 = row example+    example =+      [ "<td colspan=2>"+      , "Example:"+      ]+      ++ haskell builtinInp+      ++ ["Found:"]+      ++ haskell builtinFrom+      ++ ["Suggestion:"]+      ++ haskell to+      ++ ["</td>"]+    to = case builtinTo of+      Nothing -> ""+      Just "" -> "Perhaps you should remove it."+      Just s -> s
src/Test/Util.hs view
@@ -3,7 +3,8 @@ module Test.Util(     Test, withTests,     passed, failed, progress,-    addIdeas, getIdeas+    addIdeas, getIdeas,+    BuiltinSummary, BuiltinEx(..), addBuiltin, getBuiltins,     ) where  import Idea@@ -11,12 +12,25 @@ import Control.Monad.Trans.Reader import Control.Monad.IO.Class import Data.IORef+import Data.List.Extra+import Data.Map (Map)+import qualified Data.Map.Strict as Map +-- | A map from (hint name, hint severity, does hint support refactoring) to an example.+type BuiltinSummary = Map (String, Severity, Bool) BuiltinEx +data BuiltinEx = BuiltinEx+    { builtinInp :: !String+    , builtinFrom :: !String+    , builtinTo :: !(Maybe String)+    }+ data S = S     {failures :: !Int     ,total :: !Int     ,ideas :: [[Idea]]+    ,builtinHints :: BuiltinSummary+    -- ^ A summary of builtin hints     }  newtype Test a = Test (ReaderT (IORef S) IO a)@@ -25,7 +39,7 @@ -- | Returns the number of failing tests. withTests :: Test a -> IO (Int, a) withTests (Test act) = do-    ref <- newIORef $ S 0 0 []+    ref <- newIORef $ S 0 0 [] Map.empty     res <- runReaderT act ref     S{..} <- readIORef ref     putStrLn ""@@ -43,6 +57,21 @@ getIdeas = do     ref <- Test ask     liftIO $ concat . reverse . ideas <$> readIORef ref++addBuiltin :: String -> Idea -> Test ()+addBuiltin inp idea@Idea{..} = unless ("Parse error" `isPrefixOf` ideaHint) $ do+    ref <- Test ask+    liftIO $ modifyIORef' ref $ \s ->+        let k = (ideaHint, ideaSeverity, notNull ideaRefactoring)+            v = BuiltinEx inp ideaFrom ideaTo+         -- Do not insert if the key already exists in the map. This has the effect+         -- of picking the first test case of a hint as the example in the summary.+         in s{builtinHints = Map.insertWith (curry snd) k v (builtinHints s)}++getBuiltins :: Test BuiltinSummary+getBuiltins = do+    ref <- Test ask+    liftIO $ builtinHints <$> readIORef ref  progress :: Test () progress = liftIO $ putChar '.'