hlint 1.9.37 → 1.9.38

raw patch · 14 files changed

+166/−42 lines, 14 filesdep ~haskell-src-extsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskell-src-exts

API changes (from Hackage documentation)

Files

• CHANGES.txt +10/−0
• README.md +23/−0
• data/Default.hs +12/−0
• hlint.cabal +6/−3
• src/CmdLine.hs +3/−1
• src/HLint.hs +44/−29
• src/HSE/Util.hs +2/−0
• src/Hint/All.hs +3/−1
• src/Hint/Bracket.hs +12/−6
• src/Hint/Extensions.hs +6/−1
• src/Hint/NewType.hs +35/−0
• src/Hint/Pattern.hs +8/−0
• src/Language/Haskell/HLint3.hs +1/−1
• src/Util.hs +1/−0

@@ -1,5 +1,15 @@ Changelog for HLint +1.9.38+    #279, suggest newtype instead of data+    #262, add rules to detect redundant castPtr calls+    Detect unused TypeApplications extension+    #277, don't enable TypeApplications extension by default+    Allow haskell-src-exts-1.19+    #276, remove multiple redundant parens in one go+    #160, add a --only CLI option+    #237, fix incorrect quasi quotes extension warning+    #257, better bang pattern hints 1.9.37     #255, don't suggest id @Int ==> @Int     #252, avoid clashes with GHCJS in the interim

@@ -5,6 +5,7 @@ * [Installing and running HLint](#installing-and-running-hlint) * [FAQ](#faq) * [Customizing the hints](#customizing-the-hints)+* [Hacking HLint](#hacking-hlint)  ### Acknowledgements @@ -220,3 +221,25 @@     infixr 5 !:  These hints are suitable for inclusion in a custom hint file. You can also include Haskell fixity declarations in a hint file, and these will also be extracted. If you pass only `--find` flags then the hints will be written out, if you also pass files/folders to check, then the found hints will be automatically used when checking.++## Hacking HLint++### Tests++Tests can be run either from within a `ghci` session by typing `:test` or by running the standalone binary's tests via `stack exec hlint test`.++New tests for individual hints can be added directly to source and hint files by adding annotations bracketed in `<TEST></TEST>` code comment blocks. As some examples:++```haskell+{-+    Tests to check the zipFrom hint works++<TEST>+zip [1..length x] x -- zipFrom 1 x+zip [1..length y] x+zip [1..length x] x -- ??? @Warning+</TEST>+-}+```++The general syntax is `lhs -- rhs` with `lhs` being the expression you expect to be rewritten as `rhs`. The absence of `rhs` means you expect no hints to fire. In addition `???` lets you assert a warning without a particular suggestion, while `@` tags require a specific severity -- both these features are used less commonly.

@@ -302,6 +302,7 @@ warn "Monad law, right identity" = m >>= return ==> m where _ = noQuickCheck warn "Monad law, right identity" = return =<< m ==> m where _ = noQuickCheck warn = liftM ==> fmap+warn = liftA ==> fmap hint = m >>= return . f ==> fmap f m where _ = noQuickCheck -- cannot be fmap, because is in Functor not Monad hint = return . f =<< m ==> fmap f m where _ = noQuickCheck warn = (if x then y else return ()) ==> Control.Monad.when x $ _noParen_ y where _ = not (isAtom y) && noQuickCheck@@ -465,6 +466,16 @@ warn = toException NonTermination ==> nonTermination warn = toException NestedAtomically ==> nestedAtomically +-- STOREABLE/PTR++hint = castPtr nullPtr ==> nullPtr+hint = castPtr (castPtr x) ==> castPtr x+hint = plusPtr (castPtr x) ==> plusPtr x+hint = minusPtr (castPtr x) ==> minusPtr x+hint = minusPtr x (castPtr y) ==> minusPtr x y+hint = peekByteOff (castPtr x) ==> peekByteOff x+hint = pokeByteOff (castPtr x) ==> pokeByteOff x+ -- WEAK POINTERS  warn = mkWeak a a b ==> mkWeakPtr a b@@ -708,6 +719,7 @@ foo = zipWith SymInfo [0 ..] (repeat ty) -- map (\ x -> SymInfo x ty) [0 ..] f rec = rec mean x = fst $ foldl (\(m, n) x' -> (m+(x'-m)/(n+1),n+1)) (0,0) x+{-# LANGUAGE TypeApplications #-} \ foo = id @Int foo = id 12 -- 12 

@@ -1,7 +1,7 @@-cabal-version:      >= 1.8+cabal-version:      >= 1.18 build-type:         Simple name:               hlint-version:            1.9.37+version:            1.9.38 license:            BSD3 license-file:       LICENSE category:           Development@@ -44,12 +44,13 @@     description: Use GPL libraries, specifically hscolour  library+    default-language:   Haskell2010     build-depends:         base == 4.*, process, filepath, directory, containers,         transformers,         cpphs >= 1.20.1,         cmdargs >= 0.10,-        haskell-src-exts >= 1.18 && < 1.19,+        haskell-src-exts >= 1.18 && < 1.20,         uniplate >= 1.5,         ansi-terminal >= 0.6.2,         extra >= 1.4.9,@@ -98,6 +99,7 @@         Hint.Match         Hint.Monad         Hint.Naming+        Hint.NewType         Hint.Pattern         Hint.Pragma         Hint.Type@@ -112,6 +114,7 @@   executable hlint+    default-language:   Haskell2010     build-depends:      base, hlint     main-is:            src/Main.hs 

@@ -93,6 +93,7 @@         ,cmdCppAnsi :: Bool         ,cmdJson :: Bool                -- ^ display hint data as JSON         ,cmdNoSummary :: Bool           -- ^ do not show the summary info+        ,cmdOnly :: [String]            -- ^ specify which hints explicitly         ,cmdNoExitCode :: Bool         ,cmdSerialise :: Bool           -- ^ Display hints in serialisation format         ,cmdRefactor :: Bool            -- ^ Run the `refactor` executable to automatically perform hints@@ -115,7 +116,7 @@         }     | CmdTest         {cmdProof :: [FilePath]          -- ^ a proof script to check against-        ,cmdGivenHints :: [FilePath]     -- ^ which settignsfiles were explicitly given+        ,cmdGivenHints :: [FilePath]     -- ^ which settings files were explicitly given         ,cmdDataDir :: FilePath          -- ^ the data directory         ,cmdReports :: [FilePath]        -- ^ where to generate reports         ,cmdWithHints :: [String]        -- ^ hints that are given on the command line@@ -153,6 +154,7 @@         ,cmdCppAnsi = nam_ "cpp-ansi" &= help "Use CPP in ANSI compatibility mode"         ,cmdJson = nam_ "json" &= help "Display hint data as JSON"         ,cmdNoSummary = nam_ "no-summary" &= help "Do not show summary information"+        ,cmdOnly = nam "only" &= typ "HINT" &= help "Specify which hints explicitly"         ,cmdNoExitCode = nam_ "no-exit-code" &= help "Do not give a negative exit if hints"         ,cmdSerialise = nam_ "serialise" &= help "Serialise hint data for consumption by apply-refact"         ,cmdRefactor = nam_ "refactor" &= help "Automatically invoke `refactor` to apply hints"

@@ -128,45 +128,60 @@ runHints cmd@CmdMain{..} flags = do     let outStrLn = whenNormal . putStrLn     settings <- readAllSettings cmd flags--    ideas <- if cmdCross-        then applyHintFiles flags settings cmdFiles-        else concat <$> parallel [evaluateList =<< applyHintFile flags settings x Nothing | x <- cmdFiles]+    ideas <- getIdeas cmd settings flags     let (showideas,hideideas) = partition (\i -> cmdShowAll || ideaSeverity i /= Ignore) ideas-    usecolour <- cmdUseColour cmd-    showItem <- if usecolour then showANSI else return show     if cmdJson         then putStrLn . showIdeasJson $ showideas         else if cmdSerialise then do           hSetBuffering stdout NoBuffering           print $ map (show &&& ideaRefactoring) showideas         else if cmdRefactor then-          case cmdFiles of-            [file] -> do-              -- Ensure that we can find the executable-              path <- checkRefactor (if cmdWithRefactor == "" then Nothing else Just cmdWithRefactor)-              -- writeFile "hlint.refact"-              let hints =  show $ map (show &&& ideaRefactoring) showideas-              withTempFile $ \f -> do-                writeFile f hints-                runRefactoring path file f cmdRefactorOptions-                -- Exit with the exit code from 'refactor'-                >>= exitWith-            _ -> error "Refactor flag can only be used with an individual file"-+          handleRefactoring showideas cmdFiles cmd         else do+            usecolour <- cmdUseColour cmd+            showItem <- if usecolour then showANSI else return show             mapM_ (outStrLn . showItem) showideas-            if null showideas then-                when (cmdReports /= []) $ outStrLn "Skipping writing reports"-             else-                forM_ cmdReports $ \x -> do-                    outStrLn $ "Writing report to " ++ x ++ " ..."-                    writeReport cmdDataDir x showideas-            unless cmdNoSummary $-                outStrLn $-                    (let i = length showideas in if i == 0 then "No hints" else show i ++ " hint" ++ ['s' | i/=1]) ++-                    (let i = length hideideas in if i == 0 then "" else " (" ++ show i ++ " ignored)")+            handleReporting showideas hideideas cmd     return showideas++getIdeas :: Cmd -> [Setting] -> ParseFlags -> IO [Idea]+getIdeas cmd@CmdMain{..} settings flags = do+  ideas <- if cmdCross+    then applyHintFiles flags settings cmdFiles+    else concat <$> parallel [evaluateList =<< applyHintFile flags settings x Nothing | x <- cmdFiles]+  return $ if not (null cmdOnly)+    then [i | i <- ideas, ideaHint i `elem` cmdOnly]+    else ideas++handleRefactoring :: [Idea] -> [String] -> Cmd -> IO ()+handleRefactoring showideas files cmd@CmdMain{..} =+  case cmdFiles of+    [file] -> do+      -- Ensure that we can find the executable+      path <- checkRefactor (if cmdWithRefactor == "" then Nothing else Just cmdWithRefactor)+      -- writeFile "hlint.refact"+      let hints =  show $ map (show &&& ideaRefactoring) showideas+      withTempFile $ \f -> do+        writeFile f hints+        runRefactoring path file f cmdRefactorOptions+        -- Exit with the exit code from 'refactor'+        >>= exitWith+    _ -> error "Refactor flag can only be used with an individual file"+++handleReporting :: [Idea] -> [Idea] -> Cmd -> IO ()+handleReporting showideas hideideas cmd@CmdMain{..} = do+  let outStrLn = whenNormal . putStrLn+  if null showideas then+    when (cmdReports /= []) $ outStrLn "Skipping writing reports"+  else+    forM_ cmdReports $ \x -> do+      outStrLn $ "Writing report to " ++ x ++ " ..."+      writeReport cmdDataDir x showideas+  unless cmdNoSummary $+    outStrLn $+      (let i = length showideas in if i == 0 then "No hints" else show i ++ " hint" ++ ['s' | i/=1]) +++      (let i = length hideideas in if i == 0 then "" else " (" ++ show i ++ " ignored)")  runRefactoring :: FilePath -> FilePath -> FilePath -> String -> IO ExitCode runRefactoring rpath fin hints opts =  do

@@ -95,8 +95,10 @@ isFieldWildcard FieldWildcard{} = True; isFieldWildcard _ = False isPViewPat PViewPat{} = True; isPViewPat _ = False isParComp ParComp{} = True; isParComp _ = False+isTypeApp TypeApp{} = True; isTypeApp _ = False isPatTypeSig PatTypeSig{} = True; isPatTypeSig _ = False isQuasiQuote QuasiQuote{} = True; isQuasiQuote _ = False+isTyQuasiQuote TyQuasiQuote{} = True; isTyQuasiQuote _ = False isSpliceDecl SpliceDecl{} = True; isSpliceDecl _ = False isNewType NewType{} = True; isNewType _ = False isRecStmt RecStmt{} = True; isRecStmt _ = False

@@ -25,6 +25,7 @@ import Hint.Duplicate import Hint.Comment import Hint.Unsafe+import Hint.NewType  -- | A list of the builtin hints wired into HLint. --   This list is likely to grow over time.@@ -32,7 +33,7 @@     HintList | HintListRec | HintMonad | HintLambda |     HintBracket | HintNaming | HintPattern | HintImport |     HintPragma | HintExtensions | HintUnsafe | HintDuplicate |-    HintComment+    HintComment | HintNewType     deriving (Show,Eq,Ord,Bounded,Enum)  @@ -51,6 +52,7 @@     HintUnsafe     -> modu unsafeHint     HintDuplicate  -> mods duplicateHint     HintComment    -> comm commentHint+    HintNewType    -> decl newtypeHint     where         decl x = mempty{hintDecl=x}         modu x = mempty{hintModule=x}

@@ -9,7 +9,7 @@ yes = (foo) -- foo yes = (foo bar) -- @Suggestion foo bar yes = foo (bar) -- @Warning bar-yes = foo ((x x)) -- @Warning (x x)+yes = foo ((x x)) -- @Suggestion (x x) yes = (f x) ||| y -- @Suggestion f x ||| y yes = if (f x) then y else z -- @Suggestion if f x then y else z yes = if x then (f y) else z -- @Suggestion if x then f y else z@@ -20,6 +20,7 @@ yes = \ x -> (x && x) -- @Suggestion \x -> x && x no = \(x -> y) -> z yes = (`foo` (bar baz)) -- @Suggestion (`foo` bar baz)+yes = f ((x)) -- @Warning x main = do f; (print x) -- @Suggestion do f print x  -- type bracket reduction@@ -31,7 +32,7 @@ -- pattern bracket reduction foo (x:xs) = 1 foo (True) = 1 -- @Warning True-foo ((True)) = 1 -- @Warning (True)+foo ((True)) = 1 -- @Warning True foo (A{}) = True -- A{} f x = case x of (Nothing) -> 1; _ -> 2 -- Nothing @@ -93,7 +94,12 @@ findType :: (Data a) => a -> RType findType = tyConToRtype . dataTypeName . dataTypeOf -+-- Just if at least one paren was removed+-- Nothing if zero parens were removed+remParens :: Brackets a => a -> Maybe a+remParens = fmap go . remParen+  where+    go e = maybe e go (remParen e)  bracket :: (Data (a S), Uniplate (a S), ExactP a, Pretty (a S), Brackets (a S)) => Bool -> a S -> [Idea] bracket bad = f Nothing@@ -102,9 +108,9 @@          -- f (Maybe (index, parent, gen)) child         f :: (Data (a S), Uniplate (a S), ExactP a, Pretty (a S), Brackets (a S)) => Maybe (Int,a S,a S -> a S) -> a S -> [Idea]-        f Just{} o@(remParen -> Just x) | isAtom x = bracketError msg o x : g x-        f Nothing o@(remParen -> Just x) | bad || isAtom x = (if isAtom x then bracketError else bracketWarning) msg o x : g x-        f (Just (i,o,gen)) v@(remParen -> Just x) | not $ needBracket i o x =+        f Just{} o@(remParens -> Just x) | isAtom x = bracketError msg o x : g x+        f Nothing o@(remParens -> Just x) | bad || isAtom x = (if isAtom x then bracketError else bracketWarning) msg o x : g x+        f (Just (i,o,gen)) v@(remParens -> Just x) | not $ needBracket i o x =           suggest msg o (gen x) [r] : g x           where             typ = findType v

@@ -69,6 +69,10 @@ class Val a where; val :: a -- {-# LANGUAGE DefaultSignatures #-} \ class Val a where; val :: a; default val :: Int+{-# LANGUAGE TypeApplications #-} \+foo = id --+{-# LANGUAGE TypeApplications #-} \+foo = id @Int </TEST> -} @@ -120,6 +124,7 @@ used ParallelListComp = hasS isParComp used FunctionalDependencies = hasT (un :: FunDep S) used ImplicitParams = hasT (un :: IPName S)+used TypeApplications = hasS isTypeApp used EmptyDataDecls = hasS f     where f (DataDecl _ _ _ _ [] _) = True           f (GDataDecl _ _ _ _ _ [] _) = True@@ -142,7 +147,7 @@ used RecordPuns = hasS isPFieldPun & hasS isFieldPun used UnboxedTuples = has (not . isBoxed) used PackageImports = hasS (isJust . importPkg)-used QuasiQuotes = hasS isQuasiQuote+used QuasiQuotes = hasS isQuasiQuote & hasS isTyQuasiQuote used ViewPatterns = hasS isPViewPat used DefaultSignatures = hasS isClsDefSig used DeriveDataTypeable = hasDerive ["Data","Typeable"]

@@ -0,0 +1,35 @@+{-+    Suggest newtype instead of data for type declarations that have+    only one field. Don't suggest newtype for existentially+    quantified data types because it is not valid.++<TEST>+data Foo = Foo Int -- newtype Foo = Foo Int+data Foo = Foo Int deriving (Show, Eq) -- newtype Foo = Foo Int deriving (Show, Eq)+data Foo = Foo { field :: Int } deriving Show -- newtype Foo = Foo { field :: Int } deriving Show+data Foo a b = Foo a -- newtype Foo a b = Foo a+data S a = forall b . Show b => S b+data Color a = Red a | Green a | Blue a+data Pair a b = Pair a b+data Foo = Bar+</TEST>+-}+module Hint.NewType (newtypeHint) where++import Hint.Type++newtypeHint :: DeclHint+newtypeHint _ _ = newtypeHintDecl++newtypeHintDecl :: Decl_ -> [Idea]+newtypeHintDecl d@(DataDecl sp (DataType dtA) ctx dclH+                   [qcD@(QualConDecl _ tvb _ cd)] der) =+  case tvb of+    Just _  -> []+    Nothing -> case cd of+                 (ConDecl _ _ [_]) -> wrn+                 (RecDecl _ _ [_]) -> wrn+                 _ -> []+  where suggestion = DataDecl sp (NewType dtA) ctx dclH [qcD] der+        wrn = [(suggestN "Use newtype instead of data" d suggestion){ideaNote = [DecreasesLaziness]}]+newtypeHintDecl _ = []

@@ -43,6 +43,10 @@ foo otherwise = 1 -- _ foo ~x = y -- x {-# LANGUAGE Strict #-} foo ~x = y+foo !(x, y) = x -- (x, y)+foo ![x] = x -- [x]+foo !Bar { bar = x } = x -- Bar { bar = x }+l !(() :: ()) = x -- (() :: ()) </TEST> -} @@ -162,6 +166,10 @@           f PLit{} = True           f PApp{} = True           f PInfixApp{} = True+          f PTuple{} = True+          f PList{} = True+          f PRec{} = True+          f (PatTypeSig _ x _) = f x           f _ = False           r = Replace R.Pattern (toSS o) [("x", toSS x)] "x" patHint False strict o@(PIrrPat _ x) | f x = [warn "Redundant irrefutable pattern" o x [r]]

@@ -68,7 +68,7 @@  -- | A version of 'autoSettings' which respects some of the arguments supported by HLint. --   If arguments unrecognised by HLint are used it will result in an error.---   Arugments which have no representation in the return type are silently ignored.+--   Arguments which have no representation in the return type are silently ignored. argsSettings :: [String] -> IO (ParseFlags, [Classify], Hint) argsSettings args = do     cmd <- getCmd args

@@ -133,4 +133,5 @@     ,UnboxedTuples -- breaks (#) lens operator     ,QuasiQuotes -- breaks [x| ...], making whitespace free list comps break     ,DoRec, RecursiveDo -- breaks rec+    ,TypeApplications -- HSE fails on @ patterns     ]