hlint 2.1.14 → 2.1.15
raw patch · 11 files changed
+85/−38 lines, 11 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGES.txt +8/−0
- README.md +4/−12
- hlint.cabal +2/−2
- src/CmdLine.hs +3/−1
- src/Config/Type.hs +1/−1
- src/HSE/All.hs +1/−1
- src/Hint/Extensions.hs +9/−2
- src/Hint/List.hs +35/−9
- src/Hint/Monad.hs +9/−9
- src/Timing.hs +5/−0
- src/Util.hs +8/−1
CHANGES.txt view
@@ -1,5 +1,13 @@ Changelog for HLint (* = breaking change) +2.1.15, released 2019-02-27+ #593, reorder guards in list comps where possible+ #597, suggest pushing a map over a list comp inside+ Say redundant pure, when the thing you are removing is pure+ #554, add more verbosity+ Don't test with GHC 7.4 to 7.8+ #590, say which extensions should be deleted+ #591, be careful about encoding on stdin 2.1.14, released 2019-01-28 #587, fix extensions implied by ImplicitParams #588, suggest optional from attoparsec
README.md view
@@ -66,23 +66,15 @@ ### Running with Continuous Integration -On the CI you should then run `hlint .` (or `hlint src` if you only want to check the `src` directory). To avoid the cost of compilation you may wish to fetch the [latest HLint binary release](https://github.com/ndmitchell/hlint/releases/latest). For certain CI environments there are helper scripts to do that.+On CI you might wish to run `hlint .` (or `hlint src` if you only want to check the `src` directory). To avoid the cost of compilation you may wish to fetch the [latest HLint binary release](https://github.com/ndmitchell/hlint/releases/latest). -**Travis (Linux, Mac, Windows):** Execute the following command:+For the CI systems [Travis](https://travis-ci.org/), [Appveyor](https://www.appveyor.com/) and [Azure Pipelines](https://azure.microsoft.com/en-gb/services/devops/pipelines/) add the line: ```sh-curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh | sh -s .-```--The arguments after `-s` are passed to `hlint`, so modify the final `.` if you want other arguments.--**Appveyor (Windows only):** Add the following statement to `.appveyor.yml`:--```powershell-- ps: Invoke-Command ([Scriptblock]::Create((Invoke-WebRequest 'https://raw.githubusercontent.com/ndmitchell/hlint/master/misc/appveyor.ps1').Content)) -ArgumentList @('.')+curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s . ``` -The arguments inside `@()` are passed to `hlint`, so add new arguments surrounded by `'`, space separated - e.g. `@('.' '--report')`.+The arguments after `-s` are passed to `hlint`, so modify the final `.` if you want other arguments. This command works on Windows, Mac and Linux. ### Integrations
hlint.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: hlint-version: 2.1.14+version: 2.1.15 license: BSD3 license-file: LICENSE category: Development@@ -27,7 +27,7 @@ extra-doc-files: README.md CHANGES.txt-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+tested-with: GHC==8.6.3, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3 source-repository head type: git
src/CmdLine.hs view
@@ -8,6 +8,7 @@ ) where import Control.Monad.Extra+import qualified Data.ByteString as BS import Data.Char import Data.List import Data.Maybe@@ -269,7 +270,8 @@ getFile :: [FilePath] -> [String] -> Maybe FilePath -> FilePath -> IO [FilePath] getFile path _ (Just tmpfile) "-" =- getContents >>= writeFile tmpfile >> return [tmpfile]+ -- make sure we don't reencode any Unicode+ BS.getContents >>= BS.writeFile tmpfile >> return [tmpfile] getFile path _ Nothing "-" = return ["-"] getFile [] exts _ file = exitMessage $ "Couldn't find file: " ++ file getFile (p:ath) exts t file = do
src/Config/Type.hs view
@@ -102,7 +102,7 @@ {restrictType :: RestrictType ,restrictDefault :: Bool ,restrictName :: [String]- ,restrictAs :: [String] -- for RestrictModule only, what you can import it as+ ,restrictAs :: [String] -- for RestrictModule only, what module names you can import it as ,restrictWithin :: [(String, String)] } deriving Show
src/HSE/All.hs view
@@ -156,7 +156,7 @@ parseModuleEx flags file str = timedIO "Parse" file $ do str <- case str of Just x -> return x- Nothing | file == "-" -> getContents+ Nothing | file == "-" -> getContentsUTF8 | otherwise -> readFileUTF8' file str <- return $ fromMaybe str $ stripPrefix "\65279" str -- remove the BOM if it exists, see #130 ppstr <- runCpp (cppFlags flags) file str
src/Hint/Extensions.hs view
@@ -151,13 +151,16 @@ (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]])+ [ Note $ "Extension " ++ prettyExtension x ++ " is " ++ reason x+ | x <- explainedRemovals]) [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 explainedRemovals+ | null after && not (any (`Map.member` implied) before) = []+ | otherwise = before \\ after , let newPragma = if null after then "" else prettyPrint $ LanguagePragma sl $ map (toNamed . prettyExtension) after ] where@@ -189,6 +192,10 @@ , usedTH || usedExt a x ] + reason x =+ case Map.lookup x implied of+ Just a -> "implied by " ++ prettyExtension a+ Nothing -> "not used" deriveHaskell = ["Eq","Ord","Enum","Ix","Bounded","Read","Show"] deriveGenerics = ["Data","Typeable","Generic","Generic1","Lift"]
src/Hint/List.hs view
@@ -23,6 +23,13 @@ foo = [a b] ++ xs -- a b : xs foo = [myexpr | True, a] -- [myexpr | a] foo = [myexpr | False] -- []+foo = map f [x + 1 | x <- [1..10]] -- [f (x + 1) | x <- [1..10]]+foo = [x + 1 | x <- [1..10], feature] -- [x + 1 | feature, x <- [1..10]]+foo = [x + 1 | x <- [1..10], even x]+foo = [x + 1 | x <- [1..10], even x, dont_reoder_guards]+foo = [x + 1 | x <- [1..10], let y = even x, y]+foo = [x + 1 | x <- [1..10], let q = even 1, q] -- [x + 1 | let q = even 1, q, x <- [1..10]]+foo = [fooValue | Foo{..} <- y, fooField] </TEST> -} @@ -30,6 +37,7 @@ import Control.Applicative import Hint.Type+import Data.List.Extra import Data.Maybe import Prelude import Refact.Types@@ -49,13 +57,31 @@ listComp o@(ListComp a e xs) | "False" `elem` cons = [suggest "Short-circuited list comprehension" o (List an []) []] | "True" `elem` cons = [suggest "Redundant True guards" o o2 []]+ | let ys = moveGuardsForward xs, xs /= ys = [suggest "Move guards forward" o (ListComp a e ys) []] where o2 = ListComp a e $ filter ((/= Just "True") . qualCon) xs cons = mapMaybe qualCon xs qualCon (QualStmt _ (Qualifier _ (Con _ x))) = Just $ fromNamed x qualCon _ = Nothing+listComp o@(view -> App2 mp f (ListComp a e xs)) | mp ~= "map" =+ [suggest "Move map inside list comprehension" o o2 []]+ where o2 = ListComp a (App an (paren f) (paren e)) xs listComp _ = [] +-- Move all the list comp guards as far forward as they can go+moveGuardsForward :: [QualStmt S] -> [QualStmt S]+moveGuardsForward = reverse . f [] . reverse+ where+ f guards (x@(QualStmt _ (Generator _ p _)):xs) = reverse stop ++ x : f move xs+ where (move, stop) = span (if any isPFieldWildcard (universeS x) then const False else \x -> pvars p `disjoint` vars' x) guards+ f guards (x@(QualStmt _ Qualifier{}):xs) = f (x:guards) xs+ f guards (x@(QualStmt _ LetStmt{}):xs) = f (x:guards) xs+ f guards xs = reverse guards ++ xs++ -- the type QualStmt doesn't have a Var instance, so fake something that works+ vars' x = [prettyPrint a | Var _ a <- universeS x]++ -- boolean = are you in a ++ chain listExp :: Bool -> Exp_ -> [Idea] listExp b (fromParen -> x) =@@ -77,20 +103,20 @@ checks = let (*) = (,) in drop 1 -- see #174- ["Use string literal" * useString- ,"Use list literal" * useList- ,"Use :" * useCons- ]+ ["Use string literal" * useString+ ,"Use list literal" * useList+ ,"Use :" * useCons+ ] pchecks = let (*) = (,) in drop 1 -- see #174- ["Use string literal pattern" * usePString- ,"Use list literal pattern" * usePList- ]+ ["Use string literal pattern" * usePString+ ,"Use list literal pattern" * usePList+ ] usePString (PList _ xs) | xs /= [], Just s <- mapM fromPChar xs =- let literal = PLit an (Signless an) $ String an s (show s)- in Just (literal, [], prettyPrint literal)+ let literal = PLit an (Signless an) $ String an s (show s)+ in Just (literal, [], prettyPrint literal) usePString _ = Nothing usePList =
src/Hint/Monad.hs view
@@ -123,13 +123,13 @@ monadStep :: ([Stmt S] -> Exp_) -> [Stmt S] -> [Idea] -- do return x; $2 ==> do $2-monadStep wrap o@(Qualifier _ (fromRet -> Just _):x:xs) =- [warn "Redundant return" (wrap o) (wrap $ x:xs) [Delete Stmt (toSS (head o))]]+monadStep wrap o@(Qualifier _ (fromRet -> Just (ret, _)):x:xs) =+ [warn ("Redundant " ++ ret) (wrap o) (wrap $ x:xs) [Delete Stmt (toSS (head o))]] -- do a <- $1; return a ==> do $1-monadStep wrap o@[g@(Generator _ (PVar _ p) x), q@(Qualifier _ (fromRet -> Just (Var _ v)))]+monadStep wrap o@[g@(Generator _ (PVar _ p) x), q@(Qualifier _ (fromRet -> Just (ret, Var _ v)))] | fromNamed v == fromNamed p- = [warn "Redundant return" (wrap o) (wrap [Qualifier an x])+ = [warn ("Redundant " ++ ret) (wrap o) (wrap [Qualifier an x]) [Replace Stmt (toSS g) [("x", toSS x)] "x", Delete Stmt (toSS q)]] -- do x <- $1; x; $2 ==> do join $1; $2@@ -144,9 +144,9 @@ = [warn "Redundant variable capture" (wrap o) (wrap $ Qualifier an x : rest) []] -- do <return ()>; return ()-monadStep wrap o@[Qualifier an x, Qualifier _ (fromRet -> Just unit)]+monadStep wrap o@[Qualifier an x, Qualifier _ (fromRet -> Just (ret, unit))] | returnsUnit x, unit ~= "()"- = [warn "Redundant return" (wrap o) (wrap $ take 1 o) []]+ = [warn ("Redundant " ++ ret) (wrap o) (wrap $ take 1 o) []] -- do x <- $1; return $ f $ g x ==> f . g <$> x monadStep wrap@@ -175,7 +175,7 @@ where (ys, catMaybes -> rs) = unzip $ map mkLet xs vs = concatMap pvars [p | Generator _ p _ <- xs]- mkLet g@(Generator _ v@(view -> PVar_ p) (fromRet -> Just y))+ mkLet g@(Generator _ v@(view -> PVar_ p) (fromRet -> Just (_, y))) | p `notElem` vars y, p `notElem` delete p vs = (template (toNamed p) y, Just refact) where@@ -192,8 +192,8 @@ -- | Match @return x@ to @Just x@.-fromRet :: Exp_ -> Maybe Exp_+fromRet :: Exp_ -> Maybe (String, Exp_) fromRet (Paren _ x) = fromRet x fromRet (InfixApp _ x y z) | opExp y ~= "$" = fromRet $ App an x z-fromRet (App _ x y) | isReturn x = Just y+fromRet (App _ x y) | isReturn x = Just (prettyPrint x, y) fromRet _ = Nothing
src/Timing.hs view
@@ -10,6 +10,8 @@ import Data.IORef.Extra import Data.Tuple.Extra import Data.List.Extra+import Control.Monad+import System.Console.CmdArgs.Verbosity import System.Time.Extra import System.IO.Unsafe @@ -36,8 +38,11 @@ timedIO :: Category -> Item -> IO a -> IO a timedIO c i x = if not useTimings then x else do+ let quiet = c == "Hint"+ unless quiet $ whenLoud $ putStr $ "Performing " ++ c ++ " of " ++ i ++ "... " (time, x) <- duration x atomicModifyIORef' timings $ \mp -> (Map.insertWith (+) (c, i) time mp, ())+ unless quiet $ whenLoud $ putStrLn $ "took " ++ showDuration time return x startTimings :: IO ()
src/Util.hs view
@@ -4,7 +4,8 @@ defaultExtensions, forceList, gzip, universeParentBi,- exitMessage, exitMessageImpure+ exitMessage, exitMessageImpure,+ getContentsUTF8 ) where import Data.List@@ -34,6 +35,12 @@ exitMessageImpure :: String -> a exitMessageImpure = unsafePerformIO . exitMessage+++getContentsUTF8 :: IO String+getContentsUTF8 = do+ hSetEncoding stdin utf8+ getContents ---------------------------------------------------------------------