packages feed

hlint 1.6.12 → 1.6.13

raw patch · 19 files changed

+138/−32 lines, 19 files

Files

data/Default.hs view
@@ -62,11 +62,21 @@ error = map (uncurry f) (zip x y) ==> zipWith f x y error = not (elem x y) ==> notElem x y +warn  = foldr f z (map g x) ==> foldr (f . g) z x+warn  = foldl f z (map g x) ==> foldl  (f . g) z x+warn  = foldl' f z (map g x) ==> foldl' (f . g) z x+warn  = foldl1 f (map g x) ==> foldl1  (f . g) x+warn  = foldl1' f (map g x) ==> foldl1' (f . g) x+warn  = foldr1' f (map g x) ==> foldr1' (f . g) x+warn  = foldr1 f (map g x) ==> foldr1 (f . g) x+ -- FOLDS  error = foldr (&&) True ==> and-error = foldr (>>) (return ()) ==> sequence_+error = foldl (&&) True ==> and error = foldr (||) False ==> or+error = foldl (||) False ==> or+error = foldr (>>) (return ()) ==> sequence_ error = foldl (+) 0 ==> sum warn  = foldl (*) 1 ==> product @@ -252,6 +262,7 @@ no = flip f x $ \y -> y*y+y no = \x -> f x (g x) yes = \x -> f x (g y) -- flip f (g y)+no = foo (\ v -> f v . g)  import Prelude \ yes = flip mapM -- Control.Monad.forM
data/HLint.hs view
@@ -2,3 +2,13 @@ module HLint.HLint where  import HLint.Default+import HLint.Builtin.List+import HLint.Builtin.ListRec+import HLint.Builtin.Monad+import HLint.Builtin.Lambda+import HLint.Builtin.Bracket+import HLint.Builtin.Naming+import HLint.Builtin.Structure+import HLint.Builtin.Import+import HLint.Builtin.Pragma+import HLint.Builtin.Extensions
hlint.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               hlint-version:            1.6.12+version:            1.6.13 -- license is GPL v2 only license:            GPL license-file:       LICENSE
src/CmdLine.hs view
@@ -35,6 +35,7 @@           | Color           | Define String           | Include String+          | Ext String             deriving Eq  @@ -45,6 +46,7 @@        ,Option "c" ["color","colour"] (NoArg Color) "Color the output (requires ANSI terminal)"        ,Option "i" ["ignore"] (ReqArg Skip "message") "Ignore a particular hint"        ,Option "s" ["show"] (NoArg ShowAll) "Show all ignored ideas"+       ,Option "e" ["extension"] (ReqArg Ext "ext") "File extensions to search (defaults to hs and lhs)"        ,Option "t" ["test"] (NoArg Test) "Run in test mode"        ,Option ""  ["cpp-define"] (ReqArg Define "name[=value]") "CPP #define"        ,Option ""  ["cpp-include"] (ReqArg Include "dir") "CPP include path"@@ -68,7 +70,8 @@         putStr helpText         exitWith ExitSuccess -    files <- concatMapM getFile files+    let exts = [x | Ext x <- opt]+    files <- concatMapM (getFile $ if null exts then ["hs","lhs"] else exts) files          let hintFiles = [x | Hints x <- opt]     hints <- mapM getHintFile $ hintFiles ++ ["HLint" | null hintFiles]@@ -106,12 +109,12 @@     ]  -getFile :: FilePath -> IO [FilePath]-getFile file = do+getFile :: [String] -> FilePath -> IO [FilePath]+getFile exts file = do     b <- doesDirectoryExist file     if b then do         xs <- getDirectoryContentsRecursive file-        return [x | x <- xs, takeExtension x `elem` [".hs",".lhs"]]+        return [x | x <- xs, drop 1 (takeExtension x) `elem` exts]      else do         b <- doesFileExist file         unless b $ error $ "Couldn't find file: " ++ file
src/HSE/Bracket.hs view
@@ -40,6 +40,7 @@     | isAtom child = False     | InfixApp{} <- parent, isApp child = False     | ListComp{} <- parent = False+    | List{} <- parent = False     | If{} <- parent, isAnyApp child = False     | App{} <- parent, i == 0, isApp child = False     | ExpTypeSig{} <- parent, i == 0 = False
src/HSE/Util.hs view
@@ -57,6 +57,7 @@ isInfixApp InfixApp{} = True; isInfixApp _ = False isAnyApp x = isApp x || isInfixApp x isParen Paren{} = True; isParen _ = False+isLambda Lambda{} = True; isLambda _ = False isMDo MDo{} = True; isMDo _ = False isBoxed Boxed{} = True; isBoxed _ = False isDerivDecl DerivDecl{} = True; isDerivDecl _ = False@@ -69,6 +70,13 @@ isParComp ParComp{} = True; isParComp _ = False isPatTypeSig PatTypeSig{} = True; isPatTypeSig _ = False isQuasiQuote QuasiQuote{} = True; isQuasiQuote _ = False+++-- which names are bound by a declaration+declBind :: Decl -> [Name]+declBind (FunBind (Match _ x _ _ _ _ : _)) = [x]+declBind (PatBind _ x _ _ _) = [x | PVar x <- universe x]+declBind _ = []  --------------------------------------------------------------------- -- HSE FUNCTIONS
src/Hint/All.hs view
@@ -2,6 +2,8 @@ module Hint.All where  import Type+import Data.List+import Data.Maybe  import Hint.Match import Hint.List@@ -36,4 +38,6 @@   allHints :: [Setting] -> [Hint]-allHints xs = dynamicHints xs : map snd staticHints+allHints xs = dynamicHints xs : map f builtin+    where builtin = nub [x | Builtin x <- xs]+          f x = fromMaybe (error $ "Unknown builtin hints: HLint.Builtin." ++ x) $ lookup x staticHints
src/Hint/Bracket.hs view
@@ -2,6 +2,7 @@ <TEST> yes = (f x) x -- f x x no = f (x x)+yes = (foo) -- foo yes = (f x) ||| y -- f x ||| y yes = if (f x) then y else z -- if f x then y else z yes = if x then (f y) else z -- if x then f y else z@@ -15,6 +16,7 @@ yes = (b $ c d) ++ e -- b (c d) ++ e yes = (a b $ c d) ++ e -- a b (c d) ++ e no = (f . g $ a) ++ e+yes = [(foo bar)] -- [foo bar] </TEST> -} @@ -27,7 +29,7 @@   bracketHint :: DeclHint-bracketHint _ = concatMap bracketExp . children0Exp nullSrcLoc+bracketHint _ _ = concatMap bracketExp . children0Exp nullSrcLoc  bracketExp :: (SrcLoc,Exp) -> [Idea] bracketExp (loc,x) =
src/Hint/Lambda.hs view
@@ -51,8 +51,8 @@   lambdaHint :: DeclHint-lambdaHint _ x@TypeDecl{} = lambdaType x-lambdaHint _ x = concatMap (uncurry lambdaExp) (universeExp nullSrcLoc x) ++ concatMap lambdaDecl (universe x)+lambdaHint _ _ x@TypeDecl{} = lambdaType x+lambdaHint _ _ x = concatMap (uncurry lambdaExp) (universeExp nullSrcLoc x) ++ concatMap lambdaDecl (universe x)   lambdaExp :: SrcLoc -> Exp -> [Idea]
src/Hint/List.hs view
@@ -28,7 +28,7 @@   listHint :: DeclHint-listHint _ = listDecl+listHint _ _ = listDecl  listDecl :: Decl -> [Idea] listDecl x = concatMap (listExp False) (children0Exp nullSrcLoc x) ++
src/Hint/ListRec.hs view
@@ -36,7 +36,7 @@   listRecHint :: DeclHint-listRecHint _ = concatMap f . universe+listRecHint _ _ = concatMap f . universe     where         f o = maybeToList $ do             let x = o
src/Hint/Match.hs view
@@ -27,8 +27,8 @@ readMatch = findIdeas . filter isMatchExp  -findIdeas :: [Setting] -> NameMatch -> Decl -> [Idea]-findIdeas matches nm decl =+findIdeas :: [Setting] -> NameMatch -> Module -> Decl -> [Idea]+findIdeas matches nm _ decl =   [ idea (rankS m) (hintS m) loc x y   | (loc, x) <- universeExp nullSrcLoc decl, not $ isParen x   , m <- matches, Just y <- [matchIdea nm m x]]@@ -39,7 +39,9 @@     u <- unify nm lhs x     u <- check u     guard $ checkSide side u-    return $ unqualify nm $ dotContract $ performEval $ subst u rhs+    let rhs2 = subst u rhs+    guard $ checkDot lhs rhs2+    return $ unqualify nm $ dotContract $ performEval rhs2   -- unify a b = c, a[c] = b@@ -102,6 +104,12 @@             x2 <- lookup (fromNamed x) bind             y2 <- lookup (fromNamed y) bind             return $ x2 `notElem` universe y2+++-- If they have have a lambda in the pattern+-- don't allow dot contraction to happen, as it's usually wrong+checkDot :: Exp -> Exp -> Bool+checkDot lhs rhs2 = not $ any isLambda (universeBi lhs) && toNamed "?" `elem` universe rhs2   -- perform a substitution
src/Hint/Monad.hs view
@@ -42,7 +42,7 @@   monadHint :: DeclHint-monadHint _ = concatMap monadExp . universeExp nullSrcLoc+monadHint _ _ = concatMap monadExp . universeExp nullSrcLoc  monadExp :: (SrcLoc,Exp) -> [Idea] monadExp (loc,x) = case x of
src/Hint/Naming.hs view
@@ -5,7 +5,8 @@     _*[A-Za-z]*_?'?      Apply this to things that would get exported by default only-    Also disallow prop_ as it's a standard QuickCheck idiom+    Also allow prop_ as it's a standard QuickCheck idiom+    Also don't suggest anything mentioned elsewhere in the module  <TEST> data Yes = Foo | Bar'Test -- data Yes = Foo | BarTest@@ -16,22 +17,27 @@ yes_foo = yes_foo + yes_foo -- yesFoo = ... no = 1 where yes_foo = 2 a -== b = 1+myTest = 1; my_test = 1 </TEST> -}  -module Hint.Naming where+module Hint.Naming(namingHint) where  import HSE.All import Type import Data.List import Data.Char import Data.Maybe+import qualified Data.Set as Set   namingHint :: DeclHint-namingHint _ x = [warn "Use camelCase" (declSrcLoc x) x2 (replaceNames res x2) | not $ null res]-    where res = [(n,y) | n <- nub $ getNames x, Just y <- [suggestName n]]+namingHint _ modu = naming $ Set.fromList [x | Ident x <- universeBi modu]++naming :: Set.Set String -> Decl -> [Idea]+naming seen x = [warn "Use camelCase" (declSrcLoc x) x2 (replaceNames res x2) | not $ null res]+    where res = [(n,y) | n <- nub $ getNames x, Just y <- [suggestName n], not $ y `Set.member` seen]           x2 = shorten x
src/Hint/Structure.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ViewPatterns, PatternGuards #-}  {-     Improve the structure of code@@ -8,6 +8,13 @@ no x y = if a then b else c yes x = case x of {True -> a ; False -> b} -- if x then a else b yes x = case x of {False -> a ; _ -> b} -- if x then b else a+foo b | c <- f b = c -- foo (f -> c) = c+foo x y b z | c:cs <- f g b = c -- foo x y (f g -> c:cs) z = c+foo b | c <- f b = c + b+foo b | c <- f b = c where f = here+foo b | c <- f b = c where foo = b+foo b | c <- f b = c \+      | c <- f b = c </TEST> -} @@ -16,13 +23,14 @@  import HSE.All import Type+import Util import Data.List import Data.Maybe   structureHint :: DeclHint-structureHint _ x = concat [concatMap useGuards xs | FunBind xs <- [x]] ++-                    concatMap useIf (universeExp nullSrcLoc x)+structureHint _ _ x = concat [concatMap useGuards xs | FunBind xs <- [x]] +++                      concatMap useIf (universeExp nullSrcLoc x)   useGuards :: Match -> [Idea]@@ -31,6 +39,19 @@     where         guards = asGuards bod         x2 = Match a b c d (GuardedRhss guards) e++useGuards o@(Match sl b pats d (GuardedRhss [GuardedRhs _ [Generator _ pat (App op (Var (UnQual p)))] bod]) (BDecls decs))+    | Just i <- findIndex (== PVar p) pats+    , p `notElem` (vr bod ++ vr decs)+    , vr op `disjoint` decsBind, pvr pats `disjoint` vr op, pvr pat `disjoint` pvr pats+    = [warn "Use view patterns" sl o $+       Match sl b (take i pats ++ [PParen $ PViewPat op pat] ++ drop (i+1) pats) d (UnGuardedRhs bod) (BDecls decs)]+    where+        decsBind = nub $ concatMap declBind decs++        vr x = [y | Var (UnQual y) <- universeBi x]+        pvr x = [y | PVar y <- universeBi x]+ useGuards _ = []
src/Main.hs view
@@ -1,3 +1,21 @@+{-+HLint, Haskell source code suggestions+Copyright (C) 2006-2009, Neil Mitchell++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; version 2 of the License.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA+-}+ {-# LANGUAGE RecordWildCards #-}  module Main where
src/Settings.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE PatternGuards, ViewPatterns #-} -module Settings where+module Settings(readSettings, classify) where  import HSE.All import Paths_hlint@@ -16,20 +16,21 @@ -- Return the list of settings commands readSettings :: [FilePath] -> IO [Setting] readSettings xs = do-    mods <- concatMapM readHints xs-    return $ concatMap (concatMap readSetting . concatMap getEquations . moduleDecls) mods+    (builtin,mods) <- fmap unzipEither $ concatMapM readHints xs+    return $ map Builtin builtin ++ concatMap (concatMap readSetting . concatMap getEquations . moduleDecls) mods   -- read all the files -- in future this should also do import chasing, but -- currently it doesn't-readHints :: FilePath -> IO [Module]+readHints :: FilePath -> IO [Either String Module] readHints file = do     y <- fromParseResult `fmap` parseFile parseFlags{implies=True} file     ys <- concatMapM (f . fromNamed . importModule) $ moduleImports y-    return $ y:ys+    return $ Right y:ys     where-        f x | "HLint." `isPrefixOf` x = do+        f x | "HLint.Builtin." `isPrefixOf` x = return [Left $ drop 14 x]+            | "HLint." `isPrefixOf` x = do                 dat <- getDataDir                 readHints $ dat </> drop 6 x <.> "hs"             | otherwise = readHints $ x <.> "hs"
src/Type.hs view
@@ -30,6 +30,7 @@ data Setting     = Classify {rankS :: Rank, hintS :: String, funcS :: FuncName}     | MatchExp {rankS :: Rank, hintS :: String, lhs :: Exp, rhs :: Exp, side :: Maybe Exp}+    | Builtin String -- use a builtin hint set       deriving Show  data Idea@@ -76,8 +77,8 @@ --------------------------------------------------------------------- -- HINTS -type DeclHint = NameMatch -> Decl   -> [Idea]-type ModuHint = NameMatch -> Module -> [Idea]+type DeclHint = NameMatch -> Module -> Decl -> [Idea]+type ModuHint = NameMatch -> Module         -> [Idea]  data Hint = DeclHint {declHint :: DeclHint} | ModuHint {moduHint :: ModuHint} @@ -101,4 +102,4 @@                 nm = nameMatch $ moduleImports m                 order n = map (\i -> i{func = (name,n)}) . sortBy (comparing loc)             in order "" [i | ModuHint h <- h, i <- h nm m] ++-               concat [order (fromNamed d) [i | DeclHint h <- h, i <- h nm d] | d <- moduleDecls m]+               concat [order (fromNamed d) [i | DeclHint h <- h, i <- h nm m d] | d <- moduleDecls m]
src/Util.hs view
@@ -46,9 +46,21 @@ isRight = not . isLeft  +unzipEither :: [Either a b] -> ([a], [b])+unzipEither (x:xs) = case x of+    Left y -> (y:a,b)+    Right y -> (a,y:b)+    where (a,b) = unzipEither xs+unzipEither [] = ([], [])++ listM' :: Monad m => [a] -> m [a] listM' x = length x `seq` return x   groupSortFst :: Ord a => [(a,b)] -> [(a,[b])] groupSortFst = map (fst . head &&& map snd) . groupBy ((==) `on` fst) . sortBy (comparing fst)+++disjoint :: Eq a => [a] -> [a] -> Bool+disjoint xs = null . intersect xs