packages feed

hlint 1.6.11 → 1.6.12

raw patch · 17 files changed

+139/−67 lines, 17 filesdep ~haskell-src-exts

Dependency ranges changed: haskell-src-exts

Files

data/Default.hs view
@@ -26,7 +26,10 @@ error = compare x y == LT ==> x < y error = compare x y /= LT ==> x >= y error = compare x y == GT ==> x > y+error = compare (f x) (f y) ==> Data.Ord.comparing f x y+error = on compare f ==> Data.Ord.comparing f + -- READ/SHOW  error = showsPrec 0 x "" ==> show x@@ -74,6 +77,9 @@ error = (\(x,_) -> x) ==> fst error = (\x y-> f (x,y)) ==> curry f where _ = notIn [x,y] f error = (\(x,y) -> f x y) ==> uncurry f where _ = notIn [x,y] f+warn  = (\x -> f x y) ==> flip f y where _ = notIn x [f,y]+error "Redundant id" = id x ==> x+error "Redundant const" = const x y ==> x  -- BOOL @@ -93,10 +99,10 @@  error = id *** g ==> second g error = f *** id ==> first f-warn  = (\(x,y) -> (f x, g y)) ==> f *** g where _ = notIn [x,y] [f,g]-warn  = (\x -> (f x, g x)) ==> f &&& g where _ = notIn x [f,g]-warn  = (\(x,y) -> (f x,y)) ==> first f where _ = notIn [x,y] f-warn  = (\(x,y) -> (x,f y)) ==> second f where _ = notIn [x,y] f+warn  = (\(x,y) -> (f x, g y)) ==> f Control.Arrow.*** g where _ = notIn [x,y] [f,g]+warn  = (\x -> (f x, g x)) ==> f Control.Arrow.&&& g where _ = notIn x [f,g]+warn  = (\(x,y) -> (f x,y)) ==> Control.Arrow.first f where _ = notIn [x,y] f+warn  = (\(x,y) -> (x,f y)) ==> Control.Arrow.second f where _ = notIn [x,y] f  -- FUNCTOR @@ -107,24 +113,24 @@  error "Monad law, left identity" = return a >>= f ==> f a error "Monad law, right identity" = m >>= return ==> m-warn  = m >>= return . f ==> liftM f m-error = (if x then y else return ()) ==> when x $ _noParen_ y-error = (if x then return () else y) ==> unless x $ _noParen_ y+warn  = m >>= return . f ==> fmap f m+error = (if x then y else return ()) ==> Control.Monad.when x $ _noParen_ y+error = (if x then return () else y) ==> Control.Monad.unless x $ _noParen_ y error = sequence (map f x) ==> mapM f x error = sequence_ (map f x) ==> mapM_ f x-warn  = flip mapM ==> forM-warn  = flip mapM_ ==> forM_+warn  = flip mapM ==> Control.Monad.forM+warn  = flip mapM_ ==> Control.Monad.forM_ error = when (not x) ==> unless x-error = x >>= id ==> join x+error = x >>= id ==> Control.Monad.join x error = liftM f (liftM g x) ==> liftM (f . g) x  -- MONAD LIST -error = liftM unzip (mapM f x) ==> mapAndUnzipM f x-error = sequence (zipWith f x y) ==> zipWithM f x y-error = sequence_ (zipWith f x y) ==> zipWithM_ f x y-error = sequence (replicate n x) ==> replicateM n x-error = sequence_ (replicate n x) ==> replicateM_ n x+error = liftM unzip (mapM f x) ==> Control.Monad.mapAndUnzipM f x+error = sequence (zipWith f x y) ==> Control.Monad.zipWithM f x y+error = sequence_ (zipWith f x y) ==> Control.Monad.zipWithM_ f x y+error = sequence (replicate n x) ==> Control.Monad.replicateM n x+error = sequence_ (replicate n x) ==> Control.Monad.replicateM_ n x error = mapM f (map g x) ==> mapM (f . g) x error = mapM_ f (map g x) ==> mapM_ (f . g) x @@ -139,9 +145,9 @@  -- MAYBE -error = maybe x id  ==> fromMaybe x-error = maybe False (const True) ==> isJust-error = maybe True (const False) ==> isNothing+error = maybe x id  ==> Data.Maybe.fromMaybe x+error = maybe False (const True) ==> Data.Maybe.isJust+error = maybe True (const False) ==> Data.Maybe.isNothing error = catMaybes (map f x) ==> mapMaybe f x  -- MATHS@@ -197,11 +203,11 @@  -- COMPLEX -error "Use isPrefixOf" = (take i s == t) ==> _eval_ ((i == length t) && (t `isPrefixOf` s))+error "Use isPrefixOf" = (take i s == t) ==> _eval_ ((i == length t) && (t `Data.List.isPrefixOf` s))     where _ = (isList t || isLit t) && isLit i  warn  = (do a <- f; g a) ==> f >>= g-    where _ = isAtom f || isApp f+    where _ = (isAtom f || isApp f) && notIn a g   @@ -221,16 +227,16 @@ yes = not (a /= b) -- a == b yes = if a then 1 else if b then 1 else 2 -- if a || b then 1 else 2 no  = if a then 1 else if b then 3 else 2-yes = a >>= return . id -- liftM id a+yes = a >>= return . id -- fmap id a yes = (x !! 0) + (x !! 2) -- head x yes = if b < 42 then [a] else [] -- [a | b < 42]-yes = take 5 (foo xs) == "hello" -- "hello" `isPrefixOf` foo xs+yes = take 5 (foo xs) == "hello" -- "hello" `Data.List.isPrefixOf` foo xs no  = take n (foo xs) == "hello" yes = head (reverse xs) -- last xs yes = reverse xs `isPrefixOf` reverse ys -- isSuffixOf xs ys no = putStrLn $ show (length xs) ++ "Test" yes = do line <- getLine; putStrLn line -- getLine >>= putStrLn -yes = ftable ++ map (\ (c, x) -> (toUpper c, urlEncode x)) ftable -- toUpper *** urlEncode+yes = ftable ++ map (\ (c, x) -> (toUpper c, urlEncode x)) ftable -- toUpper Control.Arrow.*** urlEncode yes = map (\(a,b) -> a) xs -- fst yes = map (\(a,_) -> a) xs -- fst yes = readFile $ args !! 0 -- head args@@ -238,9 +244,24 @@ yes = if nullPS s then return False else if headPS s /= '\n' then return False else alter_input tailPS >> return True \     -- if nullPS s || (headPS s /= '\n') then return False else alter_input tailPS >> return True yes = if foo then do stuff; moreStuff; lastOfTheStuff else return () \-    -- when foo $ do stuff ; moreStuff ; lastOfTheStuff-yes = foo $ \(a, b) -> (a, y + b) -- second ((+) y)+    -- Control.Monad.when foo $ do stuff ; moreStuff ; lastOfTheStuff+yes = foo $ \(a, b) -> (a, y + b) -- Control.Arrow.second ((+) y) no  = foo $ \(a, b) -> (a, a + b) yes = map (uncurry (+)) $ zip [1 .. 5] [6 .. 10] -- zipWith (+) [1 .. 5] [6 .. 10]+no = do iter <- textBufferGetTextIter tb ; textBufferSelectRange tb iter iter+no = flip f x $ \y -> y*y+y+no = \x -> f x (g x)+yes = \x -> f x (g y) -- flip f (g y)++import Prelude \+yes = flip mapM -- Control.Monad.forM+import Control.Monad \+yes = flip mapM -- forM+import Control.Monad(forM) \+yes = flip mapM -- forM+import Control.Monad(forM_) \+yes = flip mapM -- Control.Monad.forM+import qualified Control.Monad \+yes = flip mapM -- Control.Monad.forM </TEST> -}
data/Generalise.hs view
@@ -4,4 +4,4 @@ warn = concatMap ==> (>>=) warn = liftM ==> fmap warn = map ==> fmap-warn = a ++ b ==> a `mappend` b+warn = a ++ b ==> a `Data.Monoid.mappend` b
hlint.cabal view
@@ -1,7 +1,8 @@ cabal-version:      >= 1.6 build-type:         Simple name:               hlint-version:            1.6.11+version:            1.6.12+-- license is GPL v2 only license:            GPL license-file:       LICENSE category:           Development@@ -33,7 +34,7 @@ executable hlint     build-depends:         base == 4.*, syb, filepath, directory, mtl, containers, hscolour >= 1.15, cpphs >= 1.9,-        haskell-src-exts == 1.1.*, uniplate == 1.2.* && >= 1.2.0.2+        haskell-src-exts == 1.3.*, uniplate == 1.2.* && >= 1.2.0.2      ghc-options:        -fno-warn-overlapping-patterns     if flag(threaded)
src/HSE/Match.hs view
@@ -27,13 +27,6 @@     view _ = NoApp1  -data Infix = NoInfix | Infix Exp Exp Exp deriving Show--instance View Exp Infix where-    view (fromParen -> InfixApp a b c) = Infix a (opExp b) c-    view _ = NoInfix-- (~=) :: Exp -> String -> Bool (~=) = (==) . fromNamed @@ -97,6 +90,12 @@     fromNamed (UnkindedVar x) = fromNamed x     toNamed = UnkindedVar . toNamed ++instance Named QOp where+    fromNamed (QVarOp x) = fromNamed x+    fromNamed (QConOp x) = fromNamed x+    toNamed x | isCon x = QConOp $ toNamed x+              | otherwise = QVarOp $ toNamed x  instance Named Decl where     fromNamed (TypeDecl _ name _ _) = fromNamed name
src/HSE/NameMatch.hs view
@@ -3,9 +3,9 @@  import Language.Haskell.Exts import qualified Data.Map as Map-import Control.Arrow import Data.List import Data.Function+import Util   type NameMatch = QName -> QName -> Bool@@ -27,8 +27,7 @@         -- return True if x is potentially imported by B         importedFrom :: ModuleName -> Name -> Bool         importedFrom = \modu x -> any (g x) $ Map.findWithDefault [(True,[]) | modu == ModuleName "Prelude"] modu mp-            where mp = Map.fromList $ map (fst . head &&& map snd) $-                            groupBy ((==) `on` fst) $ sortBy (compare `on` fst)+            where mp = Map.fromList $ groupSortFst                             [(importModule i, importSpecNames i) | i <- imps, not $ importQualified i]                    g x (hide,y) = hide /= (x `elem` y)
src/HSE/Util.hs view
@@ -73,12 +73,6 @@ --------------------------------------------------------------------- -- HSE FUNCTIONS --instance Eq Module where-    Module x1 x2 x3 x4 x5 x6 x7 == Module y1 y2 y3 y4 y5 y6 y7 =-        x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 == y5 && x6 == y6 && x7 == y7-- -- pick a variable that is not being used freeVar :: Data a => a -> String freeVar x = head $ allVars \\ concat [[y, drop 1 y] | Ident y <- universeBi x]
src/Hint/Extensions.hs view
@@ -14,6 +14,15 @@ main = foo ''Bar {-# LANGUAGE PatternGuards #-} \ test = case x of _ | y <- z -> w+{-# LANGUAGE TemplateHaskell,EmptyDataDecls #-} \+$(fmap return $ dataD (return []) (mkName "Void") [] [] [])+{-# LANGUAGE RecursiveDo #-} \+main = mdo x <- y; return y+{-# LANGUAGE ImplicitParams, BangPatterns #-} \+sort :: (?cmp :: a -> a -> Bool) => [a] -> [a] \+sort !f = undefined+{-# LANGUAGE KindSignatures #-} \+data Set (cxt :: * -> *) a = Set [a] </TEST> -} @@ -30,7 +39,8 @@ extensionsHint :: ModuHint extensionsHint _ x = [rawIdea Error "Unused LANGUAGE pragma" sl           (prettyPrint o) (if null new then "" else prettyPrint $ LanguagePragma sl new)-    | o@(LanguagePragma sl old) <- modulePragmas x+    | let usedTH = used TemplateHaskell x -- if TH is on, can use all other extensions programmatically+    , o@(LanguagePragma sl old) <- modulePragmas x, not usedTH     , let new = filter (flip used x . classifyExtension . prettyPrint) old     , length new /= length old] @@ -87,7 +97,6 @@  hasT t x = not $ null (universeBi x `asTypeOf` [t]) hasT2 ~(t1,t2) = hasT t1 & hasT t2-hasT3 ~(t1,t2,t3) = hasT t1 & hasT t2 & hasT t3  has f = any f . universeBi
src/Hint/Import.hs view
@@ -33,13 +33,13 @@  import HSE.All import Type+import Util import Data.List import Data.Maybe-import Data.Function   importHint :: ModuHint-importHint _ x = concatMap (wrap . map snd) $ groupBy ((==) `on` fst) $ sortBy (compare `on` fst)+importHint _ x = concatMap (wrap . snd) $ groupSortFst                  [((importModule i,importPkg i),i) | i <- universeBi x, not $ importSrc i]
src/Hint/Lambda.hs view
@@ -23,6 +23,9 @@ f x y = f (g x) (g y) f x y = g x == g y -- f = (==) `on` g a + b = foo a b -- (+) = foo+h a = f ((++) a) a -- (a ++)+h a = flip f x (y z) -- f (y z) x+h a = flip f x $ y z type Test a = Foo Char a type Test a = Foo a Char a type Test (a :: * -> *) = Foo Char a@@ -49,21 +52,25 @@  lambdaHint :: DeclHint lambdaHint _ x@TypeDecl{} = lambdaType x-lambdaHint _ x = concatMap lambdaExp (universeBi x) ++ concatMap lambdaDecl (universe x)+lambdaHint _ x = concatMap (uncurry lambdaExp) (universeExp nullSrcLoc x) ++ concatMap lambdaDecl (universe x)  -lambdaExp :: Exp -> [Idea]-lambdaExp o@(Lambda loc [v] y) | isAtom y, Just x <- f v, x `notElem` universeBi y =+lambdaExp :: SrcLoc -> Exp -> [Idea]+lambdaExp _ o@(Lambda loc [v] y) | isAtom y, Just x <- f v, x `notElem` universeBi y =         [warn "Use const" loc o res]     where         f (PVar x) = Just x         f PWildCard = Just $ Ident "_"         f _ = Nothing         res = App (toNamed "const") y-lambdaExp o@(Lambda loc vs x) | length vs /= length vs2 =+lambdaExp _ o@(Lambda loc vs x) | length vs /= length vs2 =         [warn "Eta reduce" loc o $ if null vs2 then x2 else Lambda loc vs2 x2]     where (vs2,x2) = etaReduces vs x-lambdaExp _ = []+lambdaExp loc o@(Paren (App (Var x@(UnQual (Symbol _))) y)) | isAtom y =+        [warn "Operator rotate" loc o $ LeftSection y (QVarOp x)]+lambdaExp loc o@(App (App (App flp x) y) z) | flp ~= "flip" =+        [idea Error "Redundant flip" loc o $ App (App x z) y]+lambdaExp _ _ = []   lambdaDecl :: Decl -> [Idea]@@ -76,7 +83,7 @@ lambdaDef o@(Match loc name pats typ (UnGuardedRhs bod) (BDecls []))     | Lambda loc vs y <- bod = [warn "Redundant lambda" loc o $ reform (pats++vs) y]     | [PVar x, PVar y] <- pats, Just (f,g) <- useOn x y bod =-              [warn "Use on" loc o $ reform [] (ensureBracket1 $ InfixApp f (QVarOp $ UnQual $ Ident "on") g)]+              [warn "Use on" loc o $ reform [] (ensureBracket1 $ InfixApp f (toNamed "on") g)]     | (p2,y) <- etaReduces pats bod, length p2 /= length pats = [warn "Eta reduce" loc o $ reform p2 y]     | otherwise = []         where reform pats2 bod2 = Match loc name pats2 typ (UnGuardedRhs bod2) (BDecls [])@@ -100,11 +107,11 @@ etaReduce x (App y (Var (UnQual z))) | x == z && x `notElem` universeBi y = Just y etaReduce x (InfixApp y op z) | f y z = Just $ RightSection op z                               | f z y = Just $ LeftSection y op-    where f y z = op `notElem` map (QVarOp . UnQual . Symbol . return) "+-" &&+    where f y z = op `notElem` map (toNamed . return) "+-" &&                   all (not . isInfixApp) [y,z] && var x == y && x `notElem` universeBi z etaReduce x (App y z) | not (uglyEta y z) && x `notElem` universeBi y = do     z2 <- etaReduce x z-    return $ InfixApp y (QVarOp $ UnQual $ Symbol ".") z2+    return $ InfixApp y (toNamed ".") z2 etaReduce x (view -> App2 dollar y z) | dollar ~= "$" = etaReduce x (App y z) etaReduce x (LeftSection y op) = etaReduce x $ App (opExp op) y etaReduce x y | isParen y = etaReduce x (fromParen y)
src/Hint/List.hs view
@@ -72,8 +72,8 @@   -typeListChar = TyApp (TyCon (Special ListCon)) (TyCon (UnQual (Ident "Char")))-typeString = TyCon (UnQual (Ident "String"))+typeListChar = TyList (TyCon (toNamed "Char"))+typeString = TyCon (toNamed "String")   stringType :: SrcLoc -> Type -> [Idea]
src/Hint/ListRec.hs view
@@ -181,7 +181,7 @@ lambda xs (Lambda _ [] x) = lambda xs x lambda [x] (App a b) | Var (UnQual x) == b = a lambda [x] (App a (Paren (App b c)))-    | isAtom a && isAtom b && Var (UnQual x) == c = InfixApp a (QVarOp $ UnQual $ Symbol ".") b+    | isAtom a && isAtom b && Var (UnQual x) == c = InfixApp a (toNamed ".") b lambda [x] (InfixApp a op b)     | a == Var (UnQual x) = RightSection op b     | b == Var (UnQual x) = LeftSection a op
src/Hint/Match.hs view
@@ -16,6 +16,7 @@ import HSE.All import Control.Monad import Data.Function+import Util import HSE.Evaluate(evaluate)  @@ -38,7 +39,7 @@     u <- unify nm lhs x     u <- check u     guard $ checkSide side u-    return $ dotContract $ performEval $ subst u rhs+    return $ unqualify nm $ dotContract $ performEval $ subst u rhs   -- unify a b = c, a[c] = b@@ -74,8 +75,8 @@  -- check the unification is valid check :: [(String,Exp)] -> Maybe [(String,Exp)]-check = mapM f . groupBy ((==) `on` fst) . sortBy (compare `on` fst)-    where f xs = if length (nub xs) == 1 then Just (head xs) else Nothing+check = mapM f . groupSortFst+    where f (x,ys) = if length (nub ys) == 1 then Just (x,head ys) else Nothing   checkSide :: Maybe Exp -> [(String,Exp)] -> Bool@@ -125,10 +126,19 @@     where         f x | isParen x = f $ fromParen x         f (App x y) | "?" <- fromNamed y = Just x-                    | Just z <- f y = Just $ InfixApp x (QVarOp $ UnQual $ Symbol ".") z+                    | Just z <- f y = Just $ InfixApp x (toNamed ".") z         f _ = Nothing  -- if it has _eval_ do evaluation on it performEval :: Exp -> Exp performEval (App e x) | e ~= "_eval_" = evaluate x performEval x = x+++-- contract Data.List.foo ==> foo, if Data.List is loaded+unqualify :: NameMatch -> Exp -> Exp+unqualify nm = transformBi f+    where+        f (Qual mod x) | nm (Qual mod x) (UnQual x) = UnQual x+        f x = x+
src/Hint/Monad.hs view
@@ -6,6 +6,9 @@     mapM, foldM, forM, replicateM, sequence, zipWithM     not at the last line of a do statement, or to the left of >> +    Use let x = y instead of x <- return y, unless x is contained+    within y, or bound more than once in that do block.+ <TEST> yes = do mapM print a; return b -- mapM_ print a no = mapM print a@@ -17,6 +20,10 @@ yes = do x <- bar; x -- do join bar no = do x <- bar; x; x no = mdo hook <- mkTrigger pat (act >> rmHook hook) ; return hook+yes = do x <- return y; foo x -- do let x = y; foo x+yes = do x <- return $ y + z; foo x -- do let x = y + z; foo x+no = do x <- return x; foo x+no = do x <- return y; x <- return y; foo x </TEST> -} @@ -26,6 +33,7 @@ import Control.Arrow import Control.Monad import Data.Maybe+import Data.List import HSE.All import Type @@ -42,6 +50,7 @@         Do xs -> [idea Error "Redundant return" loc x y | Just y <- [monadReturn xs]] ++                  [idea Error "Use join" loc x (Do y) | Just y <- [monadJoin xs]] ++                  [idea Error "Redundant do" loc x y | [Qualifier y] <- [xs]] +++                 [idea Error "Use let" loc x (Do y) | Just y <- [monadLet xs]] ++                  concat [f x | Qualifier x <- init xs]         _ -> []     where@@ -68,3 +77,18 @@     = Just $ Qualifier (ensureBracket1 $ App (toNamed "join") x) : fromMaybe xs (monadJoin xs) monadJoin (x:xs) = liftM (x:) $ monadJoin xs monadJoin [] = Nothing+++monadLet xs = if xs == ys then Nothing else Just ys+    where+        ys = map mkLet xs+        vars = [v | Generator _ p _ <- xs, PVar v <- universe p]+        mkLet (Generator sl (PVar p) (fromRet -> Just y))+            | p `notElem` [v | Var (UnQual v) <- universeBi y], p `notElem` delete p vars+            = LetStmt $ BDecls [PatBind sl (PVar p) Nothing (UnGuardedRhs y) (BDecls [])]+        mkLet x = x++fromRet (Paren x) = fromRet x+fromRet (InfixApp x y z) | opExp y ~= "$" = fromRet $ App x z+fromRet (App x y) | x ~= "return" = Just y+fromRet _ = Nothing
src/Hint/Naming.hs view
@@ -41,7 +41,7 @@     PatBind a b c d _ -> f (PatBind a b c) d     x -> x     where-        dots = Var $ UnQual $ Ident "..."+        dots = Var $ UnQual $ Ident "..." -- Must be an Ident, not a Symbol         f cont (UnGuardedRhs _) = cont (UnGuardedRhs dots) (BDecls [])         f cont (GuardedRhss _) = cont (GuardedRhss [GuardedRhs nullSrcLoc [Qualifier dots] dots]) (BDecls [])
src/Main.hs view
@@ -27,8 +27,9 @@         let apply :: FilePath -> IO [Idea]             apply = fmap (fmap $ classify $ settings ++ extra) . applyHint parseFlags{cpphs=Just cmdCpphs} (allHints settings)         ideas <- liftM concat $ parallel [listM' =<< apply x | x <- cmdFiles]+        let visideas = filter (\i -> cmdShowAll || rank i /= Ignore) ideas         showItem <- if cmdColor then showANSI else return show-        mapM_ putStrLn [showItem i | i <- ideas, cmdShowAll || rank i /= Ignore]+        mapM_ (putStrLn . showItem) visideas          -- figure out statistics                 let counts = map (head &&& length) $ group $ sort $ map rank ideas@@ -45,7 +46,7 @@          else do             forM_ cmdReports $ \x -> do                 putStrLn $ "Writing report to " ++ x ++ " ..."-                writeReport x ideas+                writeReport x visideas             printMsg ("Found " ++ show shown ++ " suggestion" ++ ['s'|shown/=1]) (errors++ignored)          when (err > 0) $
src/Settings.hs view
@@ -86,7 +86,7 @@  getNames :: [Pat] -> Exp -> [String] getNames ps _ | ps /= [] && all isPString ps = map fromPString ps-getNames [] (InfixApp lhs op rhs) | opExp op ~= "==>" = ["Use " ++ head names]+getNames [] (InfixApp lhs op rhs) | opExp op ~= "==>" = ["Use " ++ head (names ++ ["alternative"])]     where         lnames = map f $ childrenBi lhs         rnames = map f $ childrenBi rhs
src/Util.hs view
@@ -1,8 +1,11 @@  module Util where +import Control.Arrow import Control.Monad+import Data.Function import Data.List+import Data.Ord import System.Directory import System.FilePath @@ -45,3 +48,7 @@  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)