packages feed

hlint 1.8.52 → 1.8.53

raw patch · 13 files changed

+192/−40 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

data/Default.hs view
@@ -183,11 +183,11 @@ error = (\x y -> x) ==> const error = (\(x,y) -> y) ==> snd error = (\(x,y) -> x) ==> fst-warn "Use curry" = (\x y -> f (x,y)) ==> curry f where _ = notIn [x,y] f-warn "Use uncurry" = (\(x,y) -> f x y) ==> uncurry f where _ = notIn [x,y] f; note = IncreasesLaziness+warn "Use curry" = (\x y -> f (x,y)) ==> curry f+warn "Use uncurry" = (\(x,y) -> f x y) ==> uncurry f where note = IncreasesLaziness error "Redundant $" = (($) . f) ==> f error "Redundant $" = (f $) ==> f-warn  = (\x -> y) ==> const y where _ = isAtom y && notIn x y+warn  = (\x -> y) ==> const y where _ = isAtom y error "Redundant flip" = flip f x y ==> f y x where _ = isApp original warn  = (\a b -> g (f a) (f b)) ==> g `Data.Function.on` f @@ -238,10 +238,10 @@ error = id *** g ==> second g error = f *** id ==> first f error = zip (map f x) (map g x) ==> map (f Control.Arrow.&&& g) x-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+warn  = (\(x,y) -> (f x, g y)) ==> f Control.Arrow.*** g+warn  = (\x -> (f x, g x)) ==> f Control.Arrow.&&& g+warn  = (\(x,y) -> (f x,y)) ==> Control.Arrow.first f+warn  = (\(x,y) -> (x,f y)) ==> Control.Arrow.second f warn  = (f (fst x), g (snd x)) ==> (f Control.Arrow.*** g) x warn "Redundant pair" = (fst x, snd x) ==>  x where note = DecreasesLaziness @@ -273,8 +273,8 @@ warn = fmap (const ()) ==> void error = flip (>=>) ==> (<=<) error = flip (<=<) ==> (>=>)-error = (\x -> f x >>= g) ==> f Control.Monad.>=> g where _ = notIn x [f,g]-error = (\x -> f =<< g x) ==> f Control.Monad.<=< g where _ = notIn x [f,g]+error = (\x -> f x >>= g) ==> f Control.Monad.>=> g+error = (\x -> f =<< g x) ==> f Control.Monad.<=< g error = a >> forever a ==> forever a warn = liftM2 id ==> ap error = mapM (uncurry f) (zip l m) ==> zipWithM f l m@@ -467,7 +467,7 @@ {- -- clever hint, but not actually a good idea warn  = (do a <- f; g a) ==> f >>= g-    where _ = (isAtom f || isApp f) && notIn a g+    where _ = (isAtom f || isApp f) -}  test = hints named test are to allow people to put test code within hint files
hlint.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               hlint-version:            1.8.52+version:            1.8.53 license:            BSD3 license-file:       LICENSE category:           Development@@ -62,6 +62,7 @@         HSE.All         HSE.Bracket         HSE.Evaluate+        HSE.FreeVars         HSE.Match         HSE.NameMatch         HSE.Type
src/HSE/All.hs view
@@ -11,6 +11,7 @@ import HSE.Bracket as X import HSE.Match as X import HSE.NameMatch as X+import HSE.FreeVars as X import Util import CmdLine import Data.List
+ src/HSE/FreeVars.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE FlexibleInstances #-}++module HSE.FreeVars(FreeVars, freeVars, vars, varss, pvars, declBind) where++import HSE.Type+import Data.Monoid+import qualified Data.Set as Set+import Data.Set(Set)+++-- which names are bound by a declaration+declBind :: Decl_ -> [String]+declBind x = pvars x++vars x = Set.toList $ freeVars x++varss x = Set.toList $ free $ allVars x++pvars x = Set.toList $ bound $ allVars x+++(^+) = Set.union+(^-) = Set.difference++data Vars = Vars {bound :: Set String, free :: Set String}++instance Monoid Vars where+    mempty = Vars Set.empty Set.empty+    mappend (Vars x1 x2) (Vars y1 y2) = Vars (x1 ^+ y1) (x2 ^+ y2)+    mconcat fvs = Vars (Set.unions $ map bound fvs) (Set.unions $ map free fvs)+++class AllVars a where+    -- | Return the variables, erring on the side of more free variables+    allVars :: a -> Vars++class FreeVars a where+    -- | Return the variables, erring on the side of more free variables+    freeVars :: a -> Set String++freeVars_ :: FreeVars a => a -> Vars+freeVars_ = Vars Set.empty . freeVars++inFree :: (AllVars a, FreeVars b) => a -> b -> Set String+inFree a b = free aa ^+ (freeVars b ^- bound aa)+    where aa = allVars a++inVars :: (AllVars a, AllVars b) => a -> b -> Vars+inVars a b = Vars (bound aa ^+ bound bb) (free aa ^+ (free bb ^- bound aa))+    where aa = allVars a+          bb = allVars b+++unqualNames :: QName S -> [String]+unqualNames (UnQual _ x) = [prettyPrint x]+unqualNames _ = []++unqualOp :: QOp S -> [String]+unqualOp (QVarOp _ x) = unqualNames x+unqualOp (QConOp _ x) = unqualNames x+++instance FreeVars (Set String) where+    freeVars = id++instance AllVars Vars where+    allVars = id++instance FreeVars Exp_ where -- never has any bound variables+    freeVars (Var _ x) = Set.fromList $ unqualNames x+    freeVars (VarQuote l x) = freeVars $ Var l x+    freeVars (SpliceExp _ (IdSplice _ x)) = Set.fromList [x]+    freeVars (InfixApp _ a op b) = freeVars a ^+ Set.fromList (unqualOp op) ^+ freeVars b+    freeVars (LeftSection _ a op) = freeVars a ^+ Set.fromList (unqualOp op)+    freeVars (RightSection _ op b) = Set.fromList (unqualOp op) ^+ freeVars b+    freeVars (Lambda _ p x) = inFree p x+    freeVars (Let _ bind x) = inFree bind x+    freeVars (Case _ x alts) = freeVars x `mappend` freeVars alts+    freeVars (Do _ xs) = free $ allVars xs+    freeVars (MDo l xs) = freeVars $ Do l xs+    freeVars (ParComp _ x xs) = free xfv ^+ (freeVars x ^- bound xfv)+        where xfv = mconcat $ map allVars xs+    freeVars (ListComp l x xs) = freeVars $ ParComp l x [xs]+    freeVars x = freeVars $ children x++instance FreeVars [Exp_] where+    freeVars = Set.unions . map freeVars++instance AllVars Pat_ where+    allVars (PVar _ x) = Vars (Set.singleton $ prettyPrint x) Set.empty+    allVars (PNPlusK l x _) = allVars (PVar l x)+    allVars (PAsPat l n x) = allVars (PVar l n) `mappend` allVars x+    allVars (PWildCard _) = mempty -- explicitly cannot guess what might be bound here+    allVars (PViewPat _ e p) = freeVars_ e `mappend` allVars p+    allVars x = allVars $ children x++instance AllVars [Pat_] where+    allVars = mconcat . map allVars++instance FreeVars (Alt S) where+    freeVars (Alt _ pat alt bind) = inFree pat $ inFree bind alt++instance FreeVars [Alt S] where+    freeVars = mconcat . map freeVars++instance FreeVars (GuardedAlts S) where+    freeVars (UnGuardedAlt _ x) = freeVars x+    freeVars (GuardedAlts _ xs) = mconcat $ map freeVars xs++instance FreeVars (GuardedAlt S) where+    freeVars (GuardedAlt _ stmt exp) = inFree stmt exp++instance FreeVars (Rhs S) where+    freeVars (UnGuardedRhs _ x) = freeVars x+    freeVars (GuardedRhss _ xs) = mconcat $ map freeVars xs++instance FreeVars (GuardedRhs S) where+    freeVars (GuardedRhs _ stmt exp) = inFree stmt exp++instance AllVars (QualStmt S) where+    allVars (QualStmt _ x) = allVars x+    allVars x = freeVars_ (childrenBi x :: [Exp_])++instance AllVars [QualStmt S] where+    allVars (x:xs) = inVars x xs+    allVars [] = mempty++instance AllVars [Stmt S] where+    allVars (x:xs) = inVars x xs+    allVars [] = mempty++instance AllVars (Stmt S) where+    allVars (Generator _ pat exp) = allVars pat `mappend` freeVars_ exp+    allVars (Qualifier _ exp) = freeVars_ exp+    allVars (LetStmt _ binds) = allVars binds+    allVars (RecStmt _ stmts) = allVars stmts++instance AllVars (Maybe (Binds S)) where+    allVars = maybe mempty allVars++instance AllVars (Binds S) where+    allVars (BDecls _ decls) = allVars decls+    allVars (IPBinds _ binds) = freeVars_ binds++instance AllVars [Decl S] where+    allVars = mconcat . map allVars++instance AllVars (Decl S) where+    allVars (FunBind _ m) = allVars m+    allVars (PatBind _ pat _ rhs bind) = allVars pat `mappend` freeVars_ (inFree bind rhs)+    allVars _ = mempty++instance AllVars [Match S] where+    allVars = mconcat . map allVars++instance AllVars (Match S) where+    allVars (Match l name pat rhs binds) = allVars (PVar l name) `mappend` freeVars_ (inFree pat (inFree binds rhs))+    allVars (InfixMatch l p1 name p2 rhs binds) = allVars $ Match l name (p1:p2) rhs binds++instance FreeVars [IPBind S] where+    freeVars = mconcat . map freeVars++instance FreeVars (IPBind S) where+    freeVars (IPBind _ _ exp) = freeVars exp
src/HSE/Util.hs view
@@ -102,13 +102,7 @@ isSection RightSection{} = True isSection _ = False --- which names are bound by a declaration-declBind :: Decl_ -> [String]-declBind (FunBind _ (Match _ x _ _ _ : _)) = [prettyPrint x]-declBind (PatBind _ x _ _ _) = pvars x-declBind _ = [] - allowRightSection x = x `notElem` ["-","#"] allowLeftSection x = x /= "#" @@ -253,16 +247,6 @@  childrenS :: Biplate x (f S) => x -> [f S] childrenS = childrenBi---vars :: Biplate a Exp_ => a -> [String]-vars = concatMap f . universeS-    where f (Var _ (UnQual _ x)) = [prettyPrint x]-          f (SpliceExp _ (IdSplice _ x)) = [x]-          f _ = []--pvars :: Biplate a Pat_ => a -> [String]-pvars xs = [prettyPrint x | PVar _ x <- universeS xs]   -- return the parent along with the child
src/Hint/Extensions.hs view
@@ -63,7 +63,6 @@ import Data.Maybe import Data.List import Util-import Control.Arrow   extensionsHint :: ModuHint@@ -156,7 +155,7 @@ -- | What is derived on newtype, and on data type --   'deriving' declarations may be on either, so we approximate derives :: Module_ -> ([String],[String])-derives = (concat *** concat) . unzip . map f . childrenBi+derives = concatUnzip . map f . childrenBi     where         f :: Decl_ -> ([String], [String])         f (DataDecl _ dn _ _ _ ds) = g dn ds
src/Hint/Lambda.hs view
@@ -81,7 +81,7 @@ lambdaDecl :: Decl_ -> [Idea] lambdaDecl (toFunBind -> o@(FunBind loc [Match _ name pats (UnGuardedRhs _ bod) bind]))     | isNothing bind, isLambda $ fromParen bod = [err "Redundant lambda" o $ uncurry reform $ fromLambda $ Lambda an pats bod]-    | (pats2,bod2) <- etaReduce pats bod, length pats2 < length pats, pvars (drop (length pats2) pats) `disjoint` vars bind+    | (pats2,bod2) <- etaReduce pats bod, length pats2 < length pats, pvars (drop (length pats2) pats) `disjoint` varss bind         = [err "Eta reduce" (reform pats bod) (reform pats2 bod2)]         where reform p b = FunBind loc [Match an name p (UnGuardedRhs an b) Nothing] lambdaDecl _ = []
src/Hint/ListRec.hs view
@@ -46,7 +46,7 @@             (x, addCase) <- findCase x             (use,severity,x) <- matchListRec x             let y = addCase x-            guard $ recursiveStr `notElem` vars y+            guard $ recursiveStr `notElem` varss y             return $ idea severity ("Use " ++ use) o y
src/Hint/Match.hs view
@@ -42,6 +42,7 @@ import Control.Monad import Control.Arrow import Util+import qualified Data.Set as Set   fmapAn = fmap (const an)@@ -59,7 +60,7 @@     (:) m{lhs=lhs,side=side,rhs=rhs} $ fromMaybe [] $ do         (l,v1) <- dotVersion lhs         (r,v2) <- dotVersion rhs-        guard $ v1 == v2 && l /= [] && r /= [] && v1 `notElem` (vars side ++ vars l ++ vars r)+        guard $ v1 == v2 && l /= [] && r /= [] && Set.notMember v1 (freeVars $ maybeToList side ++ l ++ r)         return [m{lhs=dotApps l, rhs=dotApps r, side=side}                ,m{lhs=dotApps (l++[toNamed v1]), rhs=dotApps (r++[toNamed v1]), side=side}] readRule _ = []@@ -88,7 +89,9 @@     let nm = nameMatch scope s     u <- unifyExp nm True lhs x     u <- check u-    let res = addBracket parent $ unqualify scope s u $ performEval $ subst u rhs+    let e = subst u rhs+    let res = addBracket parent $ unqualify scope s u $ performEval e+    guard $ (freeVars e Set.\\ freeVars rhs) `Set.isSubsetOf` freeVars x -- check no unexpected new free variables     guard $ checkSide side $ ("original",x) : ("result",res) : u     guard $ checkDefine decl parent res     return (res,notes)@@ -179,10 +182,7 @@             | 'i':'s':typ <- fromNamed cond             = isType typ y         f (App _ (App _ cond (sub -> x)) (sub -> y))-            | cond ~= "notIn" = and [ case x of-                                          Var _ (UnQual _ x) -> prettyPrint x `notElem` vars y-                                          _ -> x `notElem` universe y-                                    | x <- list x, y <- list y]+            | cond ~= "notIn" = and [x `notElem` universe y | x <- list x, y <- list y]             | cond ~= "notEq" = x /= y         f x | x ~= "notTypeSafe" = True         f x = error $ "Hint.Match.checkSide, unknown side condition: " ++ prettyPrint x
src/Hint/Monad.hs view
@@ -83,7 +83,7 @@   monadJoin (Generator _ (view -> PVar_ p) x:Qualifier _ (view -> Var_ v):xs)-    | p == v && v `notElem` vars xs+    | p == v && v `notElem` varss xs     = Just $ Qualifier an (rebracket1 $ App an (toNamed "join") x) : fromMaybe xs (monadJoin xs) monadJoin (x:xs) = fmap (x:) $ monadJoin xs monadJoin [] = Nothing
src/Hint/Util.hs view
@@ -68,7 +68,7 @@ simplifyExp :: Exp_ -> Exp_ simplifyExp (InfixApp _ x dol y) | isDol dol = App an x (paren y) simplifyExp (Let _ (BDecls _ [PatBind _ (view -> PVar_ x) Nothing (UnGuardedRhs _ y) Nothing]) z)-    | x `notElem` vars y && x `notElem` pvars z && length (filter (== x) (vars z)) <= 1 = transform f z+    | x `notElem` vars y && length [() | UnQual _ a <- universeS z, prettyPrint a == x] <= 1 = transform f z     where f (view -> Var_ x') | x == x' = paren y           f x = x simplifyExp x = x
src/Test.hs view
@@ -121,7 +121,7 @@             ,"_eval_ = id"] ++             ["{-# LINE " ++ show (startLine $ ann rhs) ++ " " ++ show (fileName $ ann rhs) ++ " #-}\n" ++              prettyPrint (PatBind an (toNamed $ "test" ++ show i) Nothing bod Nothing)-            | (i, MatchExp _ _ _ lhs rhs side _) <- zip [1..] matches, "notTypeSafe" `notElem` vars side+            | (i, MatchExp _ _ _ lhs rhs side _) <- zip [1..] matches, "notTypeSafe" `notElem` vars (maybeToList side)             , let vs = map toNamed $ nub $ filter isUnifyVar $ vars lhs ++ vars rhs             , let inner = InfixApp an (Paren an lhs) (toNamed "==>") (Paren an rhs)             , let bod = UnGuardedRhs an $ if null vs then inner else Lambda an vs inner]
src/Util.hs view
@@ -113,6 +113,9 @@ revTake :: Int -> [a] -> [a] revTake i = reverse . take i . reverse +concatUnzip :: [([a], [b])] -> ([a], [b])+concatUnzip = (concat *** concat) . unzip+  --------------------------------------------------------------------- -- DATA.TUPLE