diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,10 @@ Changelog for HLint (* = breaking change) +2.1.13, released 2019-01-23 + #583, suggest left sections to avoid lambdas + #580, remove redundant LANGUAGE pragmas which are implied by others + #575, add fixities for lattice + #564, fix hint around withFile with AppendMode 2.1.12, released 2018-12-10 Require haskell-src-exts-1.21 2.1.11, released 2018-12-02 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Neil Mitchell 2006-2018. +Copyright Neil Mitchell 2006-2019. All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -93,6 +93,7 @@ * [HLint Source Plugin](https://github.com/ocharles/hlint-source-plugin) makes HLint available as a GHC plugin. * [Code Climate](https://docs.codeclimate.com/v1.0/docs/hlint) is a CI for analysis which integrates HLint. * [Danger](http://allocinit.io/haskell/danger-and-hlint/) can be used to automatically comment on pull requests with HLint suggestions. +* [Restyled](https://restyled.io) includes an HLint Restyler to automatically run `hlint --refactor` on files changed in GitHub Pull Requests. ### Automatically Applying Hints diff --git a/data/hlint.yaml b/data/hlint.yaml --- a/data/hlint.yaml +++ b/data/hlint.yaml @@ -64,8 +64,10 @@ - warn: {lhs: hWaitForInput a 0, rhs: hReady a} - warn: {lhs: hPutStrLn a (show b), rhs: hPrint a b} - warn: {lhs: hIsEOF stdin, rhs: isEOF} - - warn: {lhs: withFile f m (\h -> hPutStr h x), rhs: writeFile file x} - - warn: {lhs: withFile f m (\h -> hPutStrLn h x), rhs: writeFile file (x ++ "\n")} + - warn: {lhs: withFile f WriteMode (\h -> hPutStr h x), rhs: writeFile f x} + - warn: {lhs: withFile f WriteMode (\h -> hPutStrLn h x), rhs: writeFile f (x ++ "\n")} + - warn: {lhs: withFile f AppendMode (\h -> hPutStr h x), rhs: appendFile f x} + - warn: {lhs: withFile f AppendMode (\h -> hPutStrLn h x), rhs: appendFile f (x ++ "\n")} # EXIT diff --git a/hlint.cabal b/hlint.cabal --- a/hlint.cabal +++ b/hlint.cabal @@ -1,13 +1,13 @@ cabal-version: >= 1.18 build-type: Simple name: hlint -version: 2.1.12 +version: 2.1.13 license: BSD3 license-file: LICENSE category: Development author: Neil Mitchell maintainer: Neil Mitchell -copyright: Neil Mitchell 2006-2018 +copyright: Neil Mitchell 2006-2019 synopsis: Source code suggestions description: HLint gives suggestions on how to improve your source code. @@ -27,7 +27,7 @@ extra-doc-files: README.md CHANGES.txt -tested-with: GHC==8.6.1, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 +tested-with: GHC==8.6.3, GHC==8.4.4, 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 diff --git a/src/CmdLine.hs b/src/CmdLine.hs --- a/src/CmdLine.hs +++ b/src/CmdLine.hs @@ -202,7 +202,7 @@ ,CmdHSE {} &= explicit &= name "hse" ] &= program "hlint" &= verbosity - &= summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2018") + &= summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2019") where nam xs = nam_ xs &= name [head xs] nam_ xs = def &= explicit &= name xs diff --git a/src/HSE/All.hs b/src/HSE/All.hs --- a/src/HSE/All.hs +++ b/src/HSE/All.hs @@ -86,6 +86,9 @@ ,infix_ 4 ["==="] -- esqueleto ,infix_ 4 ["==."] + -- lattices + ,infixr_ 5 ["\\/"] -- \/ + ,infixr_ 6 ["/\\"] -- /\ ] -- Fixites from the `base` package which are currently diff --git a/src/HSE/Util.hs b/src/HSE/Util.hs --- a/src/HSE/Util.hs +++ b/src/HSE/Util.hs @@ -4,9 +4,11 @@ import Control.Monad import Data.Default +import Data.Tuple.Extra import Data.List import Language.Haskell.Exts.Util import Control.Monad.Trans.State +import qualified Data.Map as Map import Data.Maybe import Data.Data hiding (Fixity) import System.FilePath @@ -383,3 +385,38 @@ toInfixDecl :: Fixity -> Decl () toInfixDecl (Fixity a b c) = InfixDecl () a (Just b) $ maybeToList $ VarOp () <$> fromQual c + + + +-- | This extension implies the following extensions +extensionImplies :: Extension -> [Extension] +extensionImplies = \x -> Map.findWithDefault [] x mp + where mp = Map.fromList extensionImplications + +-- | This extension is implied by the following extensions +extensionImpliedBy :: Extension -> [Extension] +extensionImpliedBy = \x -> Map.findWithDefault [] x mp + where mp = Map.fromListWith (++) [(b, [a]) | (a,bs) <- extensionImplications, b <- bs] + +-- | (a, bs) means extension a implies all of bs +extensionImplications :: [(Extension, [Extension])] +extensionImplications = map (first EnableExtension) $ + (RebindableSyntax, [DisableExtension ImplicitPrelude]) : + map (\(k, vs) -> (k, map EnableExtension vs)) + [ (DerivingVia , [DerivingStrategies]) + , (RecordWildCards , [DisambiguateRecordFields]) + , (ExistentialQuantification, [ExplicitForAll]) + , (FlexibleInstances , [TypeSynonymInstances]) + , (FunctionalDependencies , [MultiParamTypeClasses]) + , (GADTs , [MonoLocalBinds]) + , (IncoherentInstances , [OverlappingInstances]) + , (ImplicitParams , [FlexibleContexts, FlexibleInstances]) + , (ImpredicativeTypes , [ExplicitForAll, RankNTypes]) + , (LiberalTypeSynonyms , [ExplicitForAll]) + , (PolyKinds , [KindSignatures]) + , (RankNTypes , [ExplicitForAll]) + , (ScopedTypeVariables , [ExplicitForAll]) + , (TypeOperators , [ExplicitNamespaces]) + , (TypeFamilies , [ExplicitNamespaces, KindSignatures, MonoLocalBinds]) + , (TypeFamilyDependencies , [ExplicitNamespaces, KindSignatures, MonoLocalBinds, TypeFamilies]) + ] diff --git a/src/Hint/Extensions.hs b/src/Hint/Extensions.hs --- a/src/Hint/Extensions.hs +++ b/src/Hint/Extensions.hs @@ -120,6 +120,11 @@ main = case () of {} {-# LANGUAGE EmptyCase #-} \ main = case () of x -> x -- +{-# LANGUAGE EmptyCase #-} \ +main = case () of x -> x -- +{-# LANGUAGE PolyKinds, KindSignatures #-} -- {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE PolyKinds, KindSignatures #-} \ +data Set (cxt :: * -> *) a = Set [a] -- @Note Extension KindSignatures is implied by PolyKinds -} @@ -134,31 +139,55 @@ import Data.Data import Refact.Types import Data.Semigroup +import qualified Data.Set as Set +import qualified Data.Map as Map import Prelude extensionsHint :: ModuHint -extensionsHint _ x = [rawIdea Warning "Unused LANGUAGE pragma" (srcInfoSpan sl) - (prettyPrint o) (Just newPragma) - (warnings old new) [refact] - | not $ used TemplateHaskell x -- if TH is on, can use all other extensions programmatically - , o@(LanguagePragma sl exts) <- modulePragmas x - , let old = map (parseExtension . prettyPrint) exts - , let new = minimalExtensions x old - , let newPragma = if null new then "" else prettyPrint $ LanguagePragma sl $ map (toNamed . prettyExtension) new - , let refact = ModifyComment (toSS o) newPragma - , sort new /= sort old] +extensionsHint _ x = + [ rawIdea Warning "Unused LANGUAGE pragma" + (srcInfoSpan sl) + (prettyPrint o) + (Just newPragma) + ( [RequiresExtension $ prettyExtension gone | x <- before \\ after, gone <- Map.findWithDefault [] x disappear] ++ + [ Note $ "Extension " ++ prettyExtension x ++ " is implied by " ++ prettyExtension a + | x <- before, Just a <- [Map.lookup x implied]]) + [ModifyComment (toSS o) newPragma] + | o@(LanguagePragma sl exts) <- modulePragmas x + , let before = map (parseExtension . prettyPrint) exts + , let after = filter (`Set.member` keep) before + , before /= after + , let newPragma = if null after then "" else prettyPrint $ LanguagePragma sl $ map (toNamed . prettyExtension) after + ] + where + usedTH = used TemplateHaskell x -- if TH is on, can use all other extensions programmatically + -- all the extensions defined to be used + extensions = Set.fromList [parseExtension $ fromNamed e | LanguagePragma _ exts <- modulePragmas x, e <- exts] -minimalExtensions :: Module_ -> [Extension] -> [Extension] -minimalExtensions x es = nubOrd $ concatMap f es - where f e = [e | usedExt e x] + -- those extensions we detect to be useful + useful = if usedTH then extensions else Set.filter (`usedExt` x) extensions + -- those extensions which are useful, but implied by other useful extensions + implied = Map.fromList + [ (e, a) + | e <- Set.toList useful + , a:_ <- [filter (`Set.member` useful) $ extensionImpliedBy e]] --- RecordWildCards implies DisambiguateRecordFields, but most people probably don't want it -warnings old new | wildcards `elem` old && wildcards `notElem` new = [RequiresExtension "DisambiguateRecordFields"] - where wildcards = EnableExtension RecordWildCards -warnings _ _ = [] + -- those we should keep + keep = useful `Set.difference` Map.keysSet implied + + -- (a,b) means a used to imply b, but has gone, so suggest enabling b + disappear = + Map.fromListWith (++) $ + nubOrdOn snd -- only keep one instance for each of a + [ (e, [a]) + | e <- Set.toList $ extensions `Set.difference` keep + , a <- extensionImplies e + , a `Set.notMember` useful + , usedTH || usedExt a x + ] deriveHaskell = ["Eq","Ord","Enum","Ix","Bounded","Read","Show"] diff --git a/src/Hint/Lambda.hs b/src/Hint/Lambda.hs --- a/src/Hint/Lambda.hs +++ b/src/Hint/Lambda.hs @@ -75,6 +75,7 @@ yes = blah (\ x -> (y, x, z+q)) -- (y, , z+q) yes = blah (\ x -> (y, x, z+x)) tmp = map (\ x -> runST $ action x) +yes = map (\f -> dataDir f) dataFiles -- (dataDir ) {-# 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) diff --git a/src/Hint/Util.hs b/src/Hint/Util.hs --- a/src/Hint/Util.hs +++ b/src/Hint/Util.hs @@ -43,10 +43,16 @@ niceLambdaR [x,y] (InfixApp _ (view -> Var_ x1) (opExp -> op) (view -> Var_ y1)) | x == x1, y == y1, vars op `disjoint` [x,y] = (op, \s -> [Replace Expr s [] (prettyPrint op)]) --- \x -> x + b ==> (+ b) [heuristic, b must be a single lexeme, or gets too complex] -niceLambdaR [x] (view -> App2 (expOp -> Just op) a b) - | isLexeme b, view a == Var_ x, x `notElem` vars b, allowRightSection (fromNamed op) = - let e = rebracket1 $ RightSection an op b +-- \x -> x + a ==> (+ a) [heuristic, ab must be a single lexeme, or gets too complex] +niceLambdaR [x] (view -> App2 (expOp -> Just op) xx a) + | isLexeme a, view xx == Var_ x, x `notElem` vars a, allowRightSection (fromNamed op) = + let e = rebracket1 $ RightSection an op a + in (e, \s -> [Replace Expr s [] (prettyPrint e)]) + +-- \x -> a + x ==> (a +) [heuristic, a must be a single lexeme, or gets too complex] +niceLambdaR [x] (view -> App2 (expOp -> Just op) a xx) + | isLexeme a, view xx == Var_ x, x `notElem` vars a = + let e = rebracket1 $ LeftSection an a op in (e, \s -> [Replace Expr s [] (prettyPrint e)]) -- \x y -> f y x = flip f