hlint 1.6.19 → 1.6.20

raw patch · 12 files changed

+69/−97 lines, 12 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• data/Default.hs +5/−1
• hlint.cabal +2/−2
• hlint.htm +1/−1
• src/HSE/All.hs +1/−2
• src/HSE/Bracket.hs +2/−0
• src/HSE/Eq.hs +0/−55
• src/HSE/Util.hs +1/−0
• src/Hint/Bracket.hs +1/−0
• src/Hint/Lambda.hs +10/−3
• src/Hint/Match.hs +34/−31
• src/Hint/Util.hs +1/−1
• src/Util.hs +11/−1

@@ -27,6 +27,8 @@ 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+error = x == y || x == z ==> x `elem` [y,z]+error = x /= y || x /= z ==> x `notElem` [y,z]  -- READ/SHOW @@ -60,7 +62,6 @@ 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  = foldr1 f (map g x) ==> foldr1 (f . g) x  -- FOLDS @@ -160,6 +161,8 @@ error = catMaybes (map f x) ==> mapMaybe f x error = concatMap (maybeToList . f) ==> Data.Maybe.mapMaybe f error = concatMap maybeToList ==> catMaybes+warn  = (case x of Nothing -> y; Just a -> a)  ==> fromMaybe y x+warn  = (case x of Just a -> a; Nothing -> y)  ==> fromMaybe y x  -- INFIX @@ -289,6 +292,7 @@ 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 no = const . ok . toResponse $ "saved"+yes = case x z of Nothing -> y z; Just pattern -> pattern -- fromMaybe (y z) (x z)   import Prelude \

@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               hlint-version:            1.6.19+version:            1.6.20 -- license is GPL v2 only license:            GPL license-file:       LICENSE@@ -46,6 +46,7 @@     exposed-modules:         Language.Haskell.HLint     other-modules:+        Paths_hlint         CmdLine         FindHints         Hint@@ -58,7 +59,6 @@         Parallel         HSE.All         HSE.Bracket-        HSE.Eq         HSE.Evaluate         HSE.Match         HSE.NameMatch

@@ -74,7 +74,7 @@ <h3>Acknowledgements</h3>  <p>-	This program has only been made possible by the presence of the <a href="http://www.cs.chalmers.se/~d00nibro/haskell-src-exts/">haskell-src-exts</a> package, and many useful improvements have been made by <a href="http://www.cs.chalmers.se/~d00nibro/">Niklas Broberg</a> in response to feature requests.+	This program has only been made possible by the presence of the <a href="http://www.cs.chalmers.se/~d00nibro/haskell-src-exts/">haskell-src-exts</a> package, and many useful improvements have been made by <a href="http://www.cs.chalmers.se/~d00nibro/">Niklas Broberg</a> in response to feature requests. Additionally, many people have provided help and patches, including Lennart Augustsson, Malcolm Wallace, Henk-Jan van Tuyl, Gwern Branwen, Alex Ott and others. </p>  <h3>Bugs and limitations</h3>

@@ -2,7 +2,7 @@ module HSE.All(     module HSE.Util, module HSE.Evaluate,     module HSE.Bracket, module HSE.Match,-    module HSE.Type, module HSE.Eq,+    module HSE.Type,     module HSE.NameMatch,     ParseFlags(..), parseFlags, parseFlagsNoLocations,     parseFile, parseFile_, parseString@@ -12,7 +12,6 @@ import Data.List import HSE.Util import HSE.Evaluate-import HSE.Eq import HSE.Type import HSE.Bracket import HSE.Match

@@ -55,6 +55,8 @@         | ExpTypeSig{} <- parent, i == 0 = False         | Paren{} <- parent = False         | isDotApp parent, isDotApp child, i == 1 = False+        | RecConstr{} <- parent = False+        | RecUpdate{} <- parent, i /= 0 = False         | otherwise = True  

@@ -1,55 +0,0 @@--module HSE.Eq(eqExpShell) where--import HSE.Type-import HSE.Util-import Data.Function-import Data.Data----- A small expression-ex :: Exp_-ex = Do an []---eqExpShell :: Exp_ -> Exp_ -> Bool-eqExpShell x y = eqExpShellFast x y && eqExpShellSlow x y--eqExpShellFast x y = toConstr x == toConstr y--eqExpShellSlow = (==) `on` descend (const ex)---{---- The following eqExpShell method is based on the SYB functions.--- It performs roughly the same as eqExpShell above, but is more--- complex so is not used by default.--- It is possible some overhead could be removed by optimising the--- SYB calls.--data Box = forall a . Data a => Box a--eqExpShellSYB :: Exp_ -> Exp_ -> Bool-eqExpShellSYB = f-    where-        f :: (Data a, Data b) => a -> b -> Bool-        f x y =-            toConstr x == toConstr y &&-            andZipWith g (gmapQ Box x) (gmapQ Box y)--        g (Box x) (Box y)-            | let tx = typeOf x in tx == typeAnn || tx == typeExp = True-            | otherwise = f x y---typeAnn = typeOf an-typeExp = typeOf ex---andZipWith :: (a -> b -> Bool) -> [a] -> [b] -> Bool-andZipWith op = f-    where-        f (x:xs) (y:ys) = op x y && f xs ys-        f [] [] = True-        f _ _ = error "Internal error: andZipWith on unequal lengths"--}

@@ -14,6 +14,7 @@ opExp (QVarOp s op) = Var s op opExp (QConOp s op) = Con s op + moduleDecls :: Module_ -> [Decl_] moduleDecls (Module _ _ _ _ xs) = xs 

@@ -16,6 +16,7 @@ yes = (a foo) :: Int -- @Warning a foo :: Int yes = [(foo bar)] -- @Warning [foo bar] yes = foo ((x y), z) -- @Warning (x y, z)+yes = C { f = (e h) } -- @Warning C {f = e h}  -- type bracket reduction foo :: (Int -> Int) -> Int

@@ -15,7 +15,8 @@     \x y -> op y x ==> flip op     \x -> x + y ==> (+ y)  -- insert section,      \x -> op x y ==> (`op` y)  -- insert section -    \x -> y + x ==> (y +)  -- insert section +    \x -> y + x ==> (y +)  -- insert section+    \x -> \y -> ... ==> \x y -- lambda compression  <TEST> f a = \x -> x + x -- f a x = x + x@@ -34,8 +35,11 @@ f = foo (\x y -> x + y) -- (+) f = foo (\x -> x * y) -- (* y) f = foo (\x -> x # y)+f = foo (\x -> \y -> x x y y) -- \x y -> x x y y+f = foo (\x -> \x -> foo x x) x ! y = fromJust $ lookup x y f = foo (\i -> writeIdea (getClass i) i)+f = bar (flip Foo.bar x) -- (`Foo.bar` x) </TEST> -} @@ -46,6 +50,7 @@ import Hint.Util import Type import Hint+import Util   lambdaHint :: DeclHint@@ -70,8 +75,10 @@ lambdaExp :: Exp_ -> [Idea] lambdaExp o@(Paren _ (App _ (Var _ (UnQual _ (Symbol _ x))) y)) | isAtom y, allowLeftSection x =     [warn "Use section" o $ LeftSection an y (toNamed x)]-lambdaExp o@(Paren _ (App _ (App _ (view -> Var_ "flip") (Var _ (fromNamed -> x))) y)) | allowRightSection x =-    [warn "Use section" o $ RightSection an (toNamed x) y]+lambdaExp o@(Paren _ (App _ (App _ (view -> Var_ "flip") (Var _ x)) y)) | allowRightSection $ fromNamed x =+    [warn "Use section" o $ RightSection an (QVarOp an x) y] lambdaExp o@Lambda{} | res <- niceLambda [] o, not $ isLambda res =     [warn "Avoid lambda" o res]+lambdaExp o@(Lambda _ ps1 (fromParen -> Lambda _ ps2 bod)) | pvars ps1 `disjoint` pvars ps2 =+    [warn "Collapse lambdas" o $ Lambda an (ps1++ps2) bod] lambdaExp _ = []

@@ -1,4 +1,4 @@-{-# LANGUAGE PatternGuards, ViewPatterns #-}+{-# LANGUAGE PatternGuards, ViewPatterns, RelaxedPolyRec #-}  {- The matching does a fairly simple unification between the two terms, treating@@ -35,12 +35,13 @@  import Data.List import Data.Maybe+import Data.Data+import Unsafe.Coerce import Type import Hint import HSE.All import Control.Monad import Control.Arrow-import Data.Function import Util  @@ -84,7 +85,7 @@  matchIdea :: NameMatch -> Decl_ -> Setting -> Maybe (Int, Exp_) -> Exp_ -> Maybe Exp_ matchIdea nm decl MatchExp{lhs=lhs,rhs=rhs,side=side} parent x = do-    u <- unify nm lhs x+    u <- unifyExp nm lhs x     u <- check u     let res = addBracket parent $ unqualify nm $ performEval $ subst u rhs     guard $ checkSide side $ ("original",x) : ("result",res) : u@@ -96,40 +97,42 @@ -- UNIFICATION  -- unify a b = c, a[c] = b--- note: App is unrolled because it's really common (performance reasons)-unify :: NameMatch -> Exp_ -> Exp_ -> Maybe [(String,Exp_)]-unify nm (Do _ xs) (Do _ ys) | length xs == length ys = concatZipWithM (unifyStmt nm) xs ys-unify nm (Lambda _ xs x) (Lambda _ ys y) | length xs == length ys = liftM2 (++) (unify nm x y) (concatZipWithM unifyPat xs ys)-unify nm x y | isParen x || isParen y = unify nm (fromParen x) (fromParen y)-unify nm (Var _ (fromNamed -> v)) y | isUnifyVar v = Just [(v,y)]-unify nm (Var _ x) (Var _ y) | nm x y = Just []-unify nm (App _ x1 x2) (App _ y1 y2) = liftM2 (++) (unify nm x1 y1) (unify nm x2 y2)-unify nm x y | isOther x && isOther y && eqExpShell x y = concatZipWithM (unify nm) (children x) (children y)-unify nm x (InfixApp _ lhs op rhs)-    | isDol op = unify nm x $ App an lhs rhs-    | otherwise = unify nm x $ App an (App an (opExp op) lhs) rhs-unify nm _ _ = Nothing+unify :: Data a => NameMatch -> a -> a -> Maybe [(String,Exp_)]+unify nm x y | Just x <- cast x = unifyExp nm x (unsafeCoerce y)+             | Just x <- cast x = unifyPat nm x (unsafeCoerce y)+             | otherwise = unifyDef nm x y ++unifyDef :: Data a => NameMatch -> a -> a -> Maybe [(String,Exp_)]+unifyDef nm x y = fmap concat . sequence =<< gzip (unify nm) x y+++-- App/InfixApp are analysed specially for performance reasons+unifyExp :: NameMatch -> Exp_ -> Exp_ -> Maybe [(String,Exp_)]+unifyExp nm x y | isParen x || isParen y = unifyExp nm (fromParen x) (fromParen y)+unifyExp nm (Var _ (fromNamed -> v)) y | isUnifyVar v = Just [(v,y)]+unifyExp nm (Var _ x) (Var _ y) | nm x y = Just []+unifyExp nm (App _ x1 x2) (App _ y1 y2) = liftM2 (++) (unifyExp nm x1 y1) (unifyExp nm x2 y2)+unifyExp nm x (InfixApp _ lhs2 op2 rhs2)+    | InfixApp _ lhs1 op1 rhs1 <- x = guard (op1 == op2) >> liftM2 (++) (unifyExp nm lhs1 lhs2) (unifyExp nm rhs1 rhs2)+    | isDol op2 = unifyExp nm x $ App an lhs2 rhs2+    | otherwise = unifyExp nm x $ App an (App an (opExp op2) lhs2) rhs2+unifyExp nm x y | isOther x, isOther y = unifyDef nm x y+unifyExp nm _ _ = Nothing+++unifyPat :: NameMatch -> Pat_ -> Pat_ -> Maybe [(String,Exp_)]+unifyPat nm (PVar _ x) (PVar _ y) = Just [(fromNamed x, toNamed $ fromNamed y)]+unifyPat nm PWildCard{} PVar{} = Just []+unifyPat nm x y = unifyDef nm x y ++ -- types that are not already handled in unify {-# INLINE isOther #-}-isOther Do{} = False-isOther Lambda{} = False isOther Var{} = False isOther App{} = False+isOther InfixApp{} = False isOther _ = True---unifyStmt :: NameMatch -> Stmt S -> Stmt S -> Maybe [(String,Exp_)]-unifyStmt nm (Generator _ p1 x1) (Generator _ p2 x2) = liftM2 (++) (unifyPat p1 p2) (unify nm x1 x2)-unifyStmt nm x y | ((==) `on` descendBi (const (toNamed "_" :: Exp_))) x y = concatZipWithM (unify nm) (childrenBi x) (childrenBi y)-unifyStmt nm _ _ = Nothing---unifyPat :: Pat_ -> Pat_ -> Maybe [(String,Exp_)]-unifyPat (PVar _ x) (PVar _ y) = Just [(fromNamed x, toNamed $ fromNamed y)]-unifyPat PWildCard{} PVar{} = Just []-unifyPat x y | ((==) `on` descend (const $ PWildCard an)) x y = concatZipWithM unifyPat (children x) (children y)-unifyPat _ _ = Nothing   ---------------------------------------------------------------------

@@ -8,7 +8,7 @@ -- generate a lambda, but prettier (if possible) niceLambda :: [String] -> Exp_ -> Exp_ niceLambda xs (Paren _ x) = niceLambda xs x-niceLambda xs (Lambda _ ((view -> PVar_ v):vs) x) = niceLambda (xs++[v]) (Lambda an vs x)+niceLambda xs (Lambda _ ((view -> PVar_ v):vs) x) | v `notElem` xs = niceLambda (xs++[v]) (Lambda an vs x) niceLambda xs (Lambda _ [] x) = niceLambda xs x niceLambda [x] (App _ a (view -> Var_ b)) | x == b, x `notElem` vars a = a niceLambda [x] (App _ a (Paren _ (App _ b (view -> Var_ c))))

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, ExistentialQuantification, Rank2Types #-}  module Util where @@ -13,6 +13,8 @@ import System.FilePath import System.IO import System.IO.Unsafe+import Unsafe.Coerce+import Data.Data   getDirectoryContentsRecursive :: FilePath -> IO [FilePath]@@ -106,3 +108,11 @@  trimBy :: (a -> Bool) -> [a] -> [a] trimBy f = reverse . dropWhile f . reverse . dropWhile f+++data Box = forall a . Data a => Box a++gzip :: Data a => (forall b . Data b => b -> b -> c) -> a -> a -> Maybe [c]+gzip f x y | toConstr x /= toConstr y = Nothing+           | otherwise = Just $ zipWith op (gmapQ Box x) (gmapQ Box y)+    where op (Box x) (Box y) = f x (unsafeCoerce y)