hlint 2.1.5 → 2.1.6
raw patch · 12 files changed
+169/−73 lines, 12 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGES.txt +12/−0
- README.md +31/−4
- data/hlint.yaml +12/−5
- hlint.cabal +2/−2
- src/Apply.hs +1/−1
- src/HSE/Unify.hs +1/−1
- src/HSE/Util.hs +4/−2
- src/Hint/Lambda.hs +6/−0
- src/Hint/ListRec.hs +1/−2
- src/Hint/Monad.hs +97/−55
- src/Hint/Naming.hs +1/−1
- src/Hint/NewType.hs +1/−0
CHANGES.txt view
@@ -1,5 +1,17 @@ Changelog for HLint (* = breaking change) +2.1.6, released 2018-06-16+ Match on explicit brackets at the root of a match expression+ #470, suggest TupleSections+ #496, suggest sequence/fmap ==> mapM+ #473, warn on redundant void, _ <- and return ()+ Make use of <$> more general, but in simpler cases+ Warn about returns in the middle of do blocks+ #471, suggest readTVarIO+ #468, suggest using sortOn/Down+ #458, document the restriction feature+ #494, don't suggest newtype for unboxed tuples+ #488, avoid warning about more test prefixes 2.1.5, released 2018-05-05 #478, take account of deriving strategies for extension use #477, don't warn about unit_ as tasty-discover recommends it
README.md view
@@ -1,4 +1,4 @@-# HLint [](https://hackage.haskell.org/package/hlint) [](https://www.stackage.org/package/hlint) [](https://travis-ci.org/ndmitchell/hlint) [](https://ci.appveyor.com/project/ndmitchell/hlint)+# HLint [](https://hackage.haskell.org/package/hlint) [](https://www.stackage.org/package/hlint) [](https://travis-ci.org/ndmitchell/hlint) [](https://ci.appveyor.com/project/ndmitchell/hlint) HLint is a tool for suggesting possible improvements to Haskell code. These suggestions include ideas such as using alternative functions, simplifying code and spotting redundancies. You can try HLint online at [lpaste.net](http://lpaste.net/) - suggestions are shown at the bottom. This document is structured as follows: @@ -121,7 +121,7 @@ ### Language Extensions -HLint enables most Haskell extensions, disabling only those which steal too much syntax (currently Arrows, TransformListComp, XmlSyntax and RegularPatterns). Individual extensions can be enabled or disabled with, for instance, `-XArrows`, or `-XNoMagicHash`. The flag `-XHaskell2010` selects Haskell 2010 compatibility.+HLint enables most Haskell extensions, disabling only those which steal too much syntax (currently Arrows, TransformListComp, XmlSyntax and RegularPatterns). Individual extensions can be enabled or disabled with, for instance, `-XArrows`, or `-XNoMagicHash`. The flag `-XHaskell2010` selects Haskell 2010 compatibility. You can also pass them via `.hlint.yaml` file. For example: `- arguments: [-XQuasiQuotes]`. ### Emacs Integration @@ -279,9 +279,36 @@ These hints are suitable for inclusion in a custom hint file. You can also include Haskell fixity declarations in a hint file, and these will also be extracted. If you pass only `--find` flags then the hints will be written out, if you also pass files/folders to check, then the found hints will be automatically used when checking. -### More Advanced Hints- Hints can specify more advanced aspects, with names and side conditions. To see examples and descriptions of these features look at [the default hint file](https://github.com/ndmitchell/hlint/blob/master/data/hlint.yaml) and [the hint interpretation module comments](https://github.com/ndmitchell/hlint/blob/master/src/Hint/Match.hs).++### Restricting items++HLint can restrict what Haskell code is allowed, which is particularly useful for larger projects which wish to enforce coding standards - there is a short example in the [HLint repo itself](https://github.com/ndmitchell/hlint/blob/master/.hlint.yaml#L10-L32). As an example of restricting extensions:++```yaml+- extensions:+ - default: false+ - name: [DeriveDataTypeable, GeneralizedNewtypeDeriving]+ - {name: CPP, within: CompatLayer}+```++The above block declares that GHC extensions are not allowed by default, apart from `DeriveDataTypeable` and `GeneralizedNewtypeDeriving` which are available everywhere. The `CPP` extension is only allowed in the module `CompatLayer`. Much like `extensions`, you can use `flags` to limit the `GHC_OPTIONS` flags that are allowed to occur. You can also ban certain functions:++```yaml+- functions:+ - {name: nub, within: []}+ - {name: unsafePerformIO, within: CompatLayer}+```++This declares that the `nub` function can't be used in any modules, and thus is banned from the code. That's probably a good idea, as most people should use an alternative that isn't _O(n^2)_ (e.g. [`nubOrd`](https://hackage.haskell.org/package/extra/docs/Data-List-Extra.html#v:nubOrd)). We also whitelist where `unsafePerformIO` can occur, ensuring that there can be a centrally reviewed location to declare all such instances. Finally, we can restrict the use of modules with:++```yaml+- modules:+ - {name: [Data.Set, Data.HashSet], as: Set}+ - {name: Control.Arrow, within: []}+```++This fragment requires that all imports of `Set` must be `qualified Data.Set as Set`, enforcing consistency. It also ensures the module `Control.Arrow` can't be used anywhere. ## Hacking HLint
data/hlint.yaml view
@@ -89,8 +89,11 @@ - warn: {lhs: last (sort x), rhs: maximum x} - warn: {lhs: head (sortBy f x), rhs: minimumBy f x, side: isCompare f} - warn: {lhs: last (sortBy f x), rhs: maximumBy f x, side: isCompare f}- - warn: {lhs: reverse (sort x), rhs: sortBy (flip compare) x, name: Avoid reverse} - warn: {lhs: reverse (sortBy f x), rhs: sortBy (flip f) x, name: Avoid reverse, side: isCompare f}+ - warn: {lhs: sortBy (comparing (flip f)), rhs: sortOn (Down . f)}+ - warn: {lhs: sortBy (comparing f), rhs: sortOn f}+ - warn: {lhs: reverse (sortOn f x), rhs: sortOn (Data.Ord.Down . f) x, name: Avoid reverse}+ - warn: {lhs: reverse (sort x), rhs: sortOn Data.Ord.Down x, name: Avoid reverse} - hint: {lhs: flip (g `on` h), rhs: flip g `on` h, name: Move flip} - hint: {lhs: (f `on` g) `on` h, rhs: f `on` (g . h)} @@ -249,6 +252,8 @@ - warn: {lhs: id x, rhs: x, side: not (isTypeApp x), name: Evaluate} - warn: {lhs: id . x, rhs: x, name: Redundant id} - warn: {lhs: x . id, rhs: x, name: Redundant id}+ - warn: {lhs: "((,) x)", rhs: "(_noParen_ x,)", name: Use tuple-section, note: RequiresExtension TupleSections}+ - warn: {lhs: "flip (,) x", rhs: "(,_noParen_ x)", name: Use tuple-section, note: RequiresExtension TupleSections} # CHAR @@ -333,6 +338,8 @@ - warn: {lhs: if x then return () else y, rhs: Control.Monad.unless x y, side: isAtom y} - warn: {lhs: sequence (map f x), rhs: mapM f x} - warn: {lhs: sequence_ (map f x), rhs: mapM_ f x}+ - warn: {lhs: sequence (fmap f x), rhs: mapM f x}+ - warn: {lhs: sequence_ (fmap f x), rhs: mapM_ f x} - hint: {lhs: flip mapM, rhs: Control.Monad.forM} - hint: {lhs: flip mapM_, rhs: Control.Monad.forM_} - hint: {lhs: flip forM, rhs: mapM}@@ -357,11 +364,7 @@ - hint: {lhs: liftM2 id, rhs: ap} - warn: {lhs: mapM (uncurry f) (zip l m), rhs: zipWithM f l m} - warn: {lhs: mapM_ (void . f), rhs: mapM_ f}- - warn: {lhs: mapM_ (void f), rhs: mapM_ f} - warn: {lhs: forM_ x (void . f), rhs: forM_ x f}- - warn: {lhs: forM_ x (void f), rhs: forM_ x f}- - warn: {lhs: void (mapM f x), rhs: mapM_ f x}- - warn: {lhs: void (forM x f), rhs: forM_ x f} # STATE MONAD @@ -489,6 +492,7 @@ # CONCURRENT - hint: {lhs: mapM_ (writeChan a), rhs: writeList2Chan a}+ - error: {lhs: atomically (readTVar x), rhs: readTVarIO x} # EXCEPTION @@ -526,6 +530,7 @@ - warn: {lhs: when (isJust m) (f (fromJust m)), rhs: Data.Foldable.forM_ m f} # STATE MONAD+ - warn: {lhs: f <$> Control.Monad.State.get, rhs: gets f} - warn: {lhs: fmap f Control.Monad.State.get, rhs: gets f} - warn: {lhs: f <$> Control.Monad.Reader.ask, rhs: asks f}@@ -803,6 +808,7 @@ # foo = id 12 -- 12 # yes = foldr (\ curr acc -> (+ 1) curr : acc) [] -- map (\ curr -> (+ 1) curr) # yes = foldr (\ curr acc -> curr + curr : acc) [] -- map (\ curr -> curr + curr)+# no = foo $ (,) x $ do {this is a test; and another test} # # import Prelude \ # yes = flip mapM -- Control.Monad.forM@@ -834,4 +840,5 @@ # main = hello .~ Just 12 -- hello ?~ 12 # foo = liftIO $ window `on` deleteEvent $ do a; b # no = sort <$> f input `shouldBe` sort <$> x+# sortBy (comparing snd) -- sortOn snd # </TEST>
hlint.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: hlint-version: 2.1.5+version: 2.1.6 license: BSD3 license-file: LICENSE category: Development@@ -27,7 +27,7 @@ extra-doc-files: README.md CHANGES.txt-tested-with: GHC==8.4.1, 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.4.3, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 source-repository head type: git
src/Apply.hs view
@@ -51,7 +51,7 @@ concat [order [] $ hintComment hints settings c | c <- cs] | (nm,(m,cs)) <- mns , let decHints = hintDecl hints settings nm m -- partially apply- , let order n = map (\i -> i{ideaModule= f $ moduleName m : ideaModule i, ideaDecl= f $ n ++ ideaDecl i}) . sortBy (comparing ideaSpan)+ , let order n = map (\i -> i{ideaModule= f $ moduleName m : ideaModule i, ideaDecl= f $ n ++ ideaDecl i}) . sortOn ideaSpan , let merge = mergeBy (comparing ideaSpan)] ++ [map (classify cls) (hintModules hints settings $ map (second fst) mns)] where
src/HSE/Unify.hs view
@@ -85,7 +85,7 @@ -- root = True, this is the outside of the expr -- do not expand out a dot at the root, since otherwise you get two matches because of readRule (Bug #570) unifyExp :: NameMatch -> Bool -> Exp_ -> Exp_ -> Maybe (Subst Exp_)-unifyExp nm root x y | isParen x || isParen y =+unifyExp nm root x y | not root, isParen x || isParen y = fmap (rebracket y) <$> unifyExp nm root (fromParen x) (fromParen y) where rebracket (Paren l e') e | e' == e = Paren l e
src/HSE/Util.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, ViewPatterns #-}+{-# LANGUAGE FlexibleContexts, ViewPatterns, TupleSections #-} module HSE.Util(module HSE.Util, def) where @@ -207,7 +207,7 @@ transformBracketOld op = snd . g where g = f . descendBracketOld g- f x = maybe (False,x) ((,) True) (op x)+ f x = maybe (False,x) (True,) (op x) -- | Descend, and if something changes then add/remove brackets appropriately descendBracketOld :: (Exp_ -> (Bool, Exp_)) -> Exp_ -> Exp_@@ -234,6 +234,8 @@ isKindHash (TyParen _ x) = isKindHash x isKindHash (TyApp _ x _) = isKindHash x isKindHash (TyCon _ (fromQual -> Just (Ident _ s))) = "#" `isSuffixOf` s+isKindHash (TyTuple _ Unboxed _) = True+isKindHash TyUnboxedSum{} = True isKindHash _ = False
src/Hint/Lambda.hs view
@@ -68,6 +68,8 @@ baz = bar (\x -> (x +)) -- (+) yes = blah (\ x -> case x of A -> a; B -> b) -- \ case A -> a; B -> b no = blah (\ x -> case x of A -> a x; B -> b x)+yes = blah (\ x -> (y, x, z+q)) -- (y, , z+q)+yes = blah (\ x -> (y, x, z+x)) {-# LANGUAGE QuasiQuotes #-}; authOAuth2 name = authOAuth2Widget [whamlet|Login via #{name}|] name {-# LANGUAGE QuasiQuotes #-}; authOAuth2 = foo (\name -> authOAuth2Widget [whamlet|Login via #{name}|] name) </TEST>@@ -149,6 +151,10 @@ subts = ("body", toSS body) : zipWith (\x y -> ([x],y)) ['a'..'z'] (map toSS pats) lambdaExp p o@(Lambda _ [view -> PVar_ u] (Case _ (view -> Var_ v) alts)) | u == v, u `notElem` vars alts = [(suggestN "Use lambda-case" o $ LCase an alts){ideaNote=[RequiresExtension "LambdaCase"]}]+lambdaExp p o@(Lambda _ [view -> PVar_ u] (Tuple _ boxed xs))+ | ([yes],no) <- partition (~= u) xs, u `notElem` concatMap vars no+ = [(suggestN "Use tuple-section" o $ TupleSection an boxed [if x ~= u then Nothing else Just x | x <- xs])+ {ideaNote=[RequiresExtension "TupleSections"]}] lambdaExp _ _ = []
src/Hint/ListRec.hs view
@@ -33,7 +33,6 @@ import Hint.Util import Data.List.Extra import Data.Maybe-import Data.Ord import Data.Either.Extra import Control.Monad import Refact.Types hiding (RType(Match))@@ -119,7 +118,7 @@ Branch name1 ps1 p1 c1 b1 <- findBranch x1 Branch name2 ps2 p2 c2 b2 <- findBranch x2 guard (name1 == name2 && ps1 == ps2 && p1 == p2)- [(BNil, b1), (BCons x xs, b2)] <- return $ sortBy (comparing fst) [(c1,b1), (c2,b2)]+ [(BNil, b1), (BCons x xs, b2)] <- return $ sortOn fst [(c1,b1), (c2,b2)] b2 <- transformAppsM (delCons name1 p1 xs) b2 (ps,b2) <- return $ eliminateArgs ps1 b2
src/Hint/Monad.hs view
@@ -33,8 +33,8 @@ no = do x <- return x; foo x no = do x <- return y; x <- return y; foo x yes = do forM files $ \x -> return (); return () -- forM_ files $ \x -> return ()-yes = do if a then forM x y else sequence z q; return () -- if a then forM_ x y else sequence_ z q-yes = do case a of {_ -> forM x y; x:xs -> forM x xs}; return () -- case a of _ -> forM_ x y ; x:xs -> forM_ x xs+yes = do if a then forM x y else return (); return 12 -- forM_ x y+yes = do case a of {_ -> forM x y; x:xs -> foo xs}; return () -- forM_ x y foldM_ f a xs = foldM f a xs >> return () folder f a xs = foldM f a xs >> return () -- foldM_ f a xs folder f a xs = foldM f a xs >>= \_ -> return () -- foldM_ f a xs@@ -42,6 +42,12 @@ main = "wait" ~> do f a $ sleep 10 main = f $ do g a $ sleep 10 -- g a $ sleep 10 main = do f a $ sleep 10 -- f a $ sleep 10+main = do foo x; return 3; bar z -- do foo x; bar z+main = void $ forM_ f xs -- forM_ f xs+main = void $ forM f xs -- void $ forM_ f xs+main = do _ <- forM_ f xs; bar -- do forM_ f xs; bar+main = do bar; forM_ f xs; return () -- do bar; forM_ f xs+main = do a; when b c; return () -- do a; when b c </TEST> -} @@ -51,7 +57,7 @@ import Control.Applicative import Data.Tuple.Extra import Data.Maybe-import Data.List+import Data.List.Extra import Hint.Type import Refact.Types import qualified Refact.Types as R@@ -59,84 +65,111 @@ badFuncs = ["mapM","foldM","forM","replicateM","sequence","zipWithM","traverse","for","sequenceA"]+unitFuncs = ["when","unless","void"] monadHint :: DeclHint monadHint _ _ d = concatMap (monadExp d) $ universeParentExp d monadExp :: Decl_ -> (Maybe (Int, Exp_), Exp_) -> [Idea]-monadExp decl (parent, x) = case x of+monadExp (fromNamed -> decl) (parent, x) = case x of (view -> App2 op x1 x2) | op ~= ">>" -> f x1 (view -> App2 op x1 (view -> LamConst1 _)) | op ~= ">>=" -> f x1- Do _ xs -> [warn "Redundant return" x (Do an y) rs | Just (y, rs) <- [monadReturn xs]] ++- [warn "Use join" x (Do an y) rs | Just (y, rs) <- [monadJoin xs ['a'..'z']]] ++- [warn "Use <$>" x (Do an y) rs | Just (y, rs) <- [monadFmap xs]] ++- [warn "Redundant do" x y [Replace Expr (toSS x) [("y", toSS y)] "y"]- | [Qualifier _ y] <- [xs], not $ doOperator parent y] ++- [suggest "Use let" x (Do an y) rs | Just (y, rs) <- [monadLet xs]] ++- concat [f x | Qualifier _ x <- init xs] ++- concat [f x | Generator _ (PWildCard _) x <- init xs]+ App an op x | op ~= "void" -> seenVoid (App an op) x+ InfixApp an op dol x | op ~= "void", isDol dol -> seenVoid (InfixApp an op dol) x+ Do an [Qualifier _ y] -> [warn "Redundant do" x y [Replace Expr (toSS x) [("y", toSS y)] "y"] | not $ doOperator parent y]+ Do an xs ->+ monadSteps (Do an) xs +++ [suggest "Use let" x (Do an y) rs | Just (y, rs) <- [monadLet xs]] +++ concat [f x | Qualifier _ x <- init xs] +++ concat [f x | Generator _ (PWildCard _) x <- init xs] _ -> [] where- f x = [warn ("Use " ++ name) x y r | Just (name,y, r) <- [monadCall x], fromNamed decl /= name]+ f = monadNoResult decl id+ seenVoid wrap x = monadNoResult decl wrap x ++ [warn "Redundant void" (wrap x) x [] | returnsUnit x] ++ -- Sometimes people write a * do a + b, to avoid brackets doOperator (Just (1, InfixApp _ _ op _)) InfixApp{} | not $ isDol op = True doOperator _ _ = False -middle :: (b -> d) -> (a, b, c) -> (a, d, c)-middle f (a,b,c) = (a, f b, c) +returnsUnit :: Exp_ -> Bool+returnsUnit (Paren _ x) = returnsUnit x+returnsUnit (App _ x _) = returnsUnit x+returnsUnit (InfixApp _ x op _) | isDol op = returnsUnit x+returnsUnit (Var _ x) = any (x ~=) $ map (++ "_") badFuncs ++ unitFuncs+returnsUnit _ = False + -- see through Paren and down if/case etc -- return the name to use in the hint, and the revised expression-monadCall :: Exp_ -> Maybe (String,Exp_, [Refactoring R.SrcSpan])-monadCall (Paren l x) = middle (Paren l) <$> monadCall x-monadCall (App l x y) = middle (\x -> App l x y) <$> monadCall x-monadCall (InfixApp l x op y)- | isDol op = middle (\x -> InfixApp l x op y) <$> monadCall x- | op ~= ">>=" = middle (InfixApp l x op) <$> monadCall y-monadCall (replaceBranches -> (bs@(_:_), gen)) | all isJust res- = Just ("Use simple functions", gen $ map (\(Just (a,b,c)) -> b) res, rs)- where res = map monadCall bs- rs = concatMap (\(Just (a,b,c)) -> c) res-monadCall x | x2:_ <- filter (x ~=) badFuncs = let x3 = x2 ++ "_" in Just (x3, toNamed x3, [Replace Expr (toSS x) [] x3])-monadCall _ = Nothing+monadNoResult :: String -> (Exp_ -> Exp_) -> Exp_ -> [Idea]+monadNoResult inside wrap (Paren l x) = monadNoResult inside (wrap . Paren l) x+monadNoResult inside wrap (App l x y) = monadNoResult inside (\x -> wrap $ App l x y) x+monadNoResult inside wrap (InfixApp l x op y)+ | isDol op = monadNoResult inside (\x -> wrap $ InfixApp l x op y) x+ | op ~= ">>=" = monadNoResult inside (wrap . InfixApp l x op) y+monadNoResult inside wrap x+ | x2:_ <- filter (x ~=) badFuncs+ , let x3 = x2 ++ "_"+ = [warn ("Use " ++ x3) (wrap x) (wrap $ toNamed x3) [Replace Expr (toSS x) [] x3] | inside /= x3]+monadNoResult inside wrap (replaceBranches -> (bs, rewrap)) =+ map (\x -> x{ideaNote=nubOrd $ Note "May require adding void to other branches" : ideaNote x}) $ concat+ [monadNoResult inside id b | b <- bs] -monadFmap :: [Stmt S] -> Maybe ([Stmt S], [Refactoring R.SrcSpan])-monadFmap (reverse -> q@(Qualifier _ (let go (App _ f x) = first (f:) $ go (fromParen x)- go (InfixApp _ f (isDol -> True) x) = first (f:) $ go x- go x = ([], x)- in go -> (ret:f:fs, view -> Var_ v))):g@(Generator _ (view -> PVar_ u) x):rest)- | isReturn ret, notDol x, u == v, null rest, v `notElem` vars (f:fs)- = Just (reverse (Qualifier an (InfixApp an (foldl' (flip (InfixApp an) (toNamed ".")) f fs) (toNamed "<$>") x):rest),- [Replace Stmt (toSS g) (("x", toSS x):zip vs (toSS <$> f:fs)) (intercalate " . " (take (length fs + 1) vs) ++ " <$> x"), Delete Stmt (toSS q)])- where vs = ('f':) . show <$> [0..]- notDol (InfixApp _ _ op _) = not $ isDol op- notDol _ = True-monadFmap _ = Nothing -monadReturn :: [Stmt S] -> Maybe ([Stmt S], [Refactoring R.SrcSpan])-monadReturn (reverse -> q@(Qualifier _ (App _ ret (Var _ v))):g@(Generator _ (PVar _ p) x):rest)- | isReturn ret, fromNamed v == fromNamed p- = Just (reverse (Qualifier an x : rest),- [Replace Stmt (toSS g) [("x", toSS x)] "x", Delete Stmt (toSS q)])-monadReturn _ = Nothing+monadStep :: ([Stmt S] -> Exp_) -> [Stmt S] -> [Idea] -monadJoin :: [Stmt S] -> String -> Maybe ([Stmt S], [Refactoring R.SrcSpan])-monadJoin (g@(Generator _ (view -> PVar_ p) x):q@(Qualifier _ (view -> Var_ v)):xs) (c:cs)+-- 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))]]++-- do a <- $1; return a ==> do $1+monadStep wrap o@[g@(Generator _ (PVar _ p) x), q@(Qualifier _ (fromRet -> Just (Var _ v)))]+ | fromNamed v == fromNamed p+ = [warn "Redundant return" (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+monadStep wrap o@(g@(Generator _ (view -> PVar_ p) x):q@(Qualifier _ (view -> Var_ v)):xs) | p == v && v `notElem` varss xs- = Just . f $ fromMaybe def (monadJoin xs cs)+ = [warn "Use join" (wrap o) (wrap $ Qualifier an (rebracket1 $ App an (toNamed "join") x):xs) r]+ where r = [Replace Stmt (toSS g) [("x", toSS x)] "join x", Delete Stmt (toSS q)]++-- do _ <- <return ()>; $1 ==> do <return ()>; $1+monadStep wrap o@(Generator an PWildCard{} x:rest)+ | returnsUnit x+ = [warn "Redundant variable capture" (wrap o) (wrap $ Qualifier an x : rest) []]++-- do <return ()>; return ()+monadStep wrap o@[Qualifier an x, Qualifier _ (fromRet -> Just unit)]+ | returnsUnit x, unit ~= "()"+ = [warn "Redundant return" (wrap o) (wrap $ take 1 o) []]++-- do x <- $1; return $ f $ g x ==> f . g <$> x+monadStep wrap+ o@[g@(Generator _ (view -> PVar_ u) x)+ ,q@(Qualifier _ (fromApplies -> (ret:f:fs, view -> Var_ v)))]+ | isReturn ret, notDol x, u == v, length fs < 3, all isSimple (f:fs), v `notElem` vars (f:fs)+ = [warn "Use <$>" (wrap o) (wrap [Qualifier an (InfixApp an (foldl' (flip (InfixApp an) (toNamed ".")) f fs) (toNamed "<$>") x)])+ [Replace Stmt (toSS g) (("x", toSS x):zip vs (toSS <$> f:fs)) (intercalate " . " (take (length fs + 1) vs) ++ " <$> x"), Delete Stmt (toSS q)]] where- gen expr = Qualifier (ann x) (rebracket1 $ App an (toNamed "join") expr)- def = (xs, [])- f (ss, rs) = (s:ss, r ++ rs)- s = gen x- r = [Replace Stmt (toSS g) [("x", toSS x)] "join x", Delete Stmt (toSS q)]+ isSimple (fromApps -> xs) = all isAtom (x:xs)+ vs = ('f':) . show <$> [0..]+ notDol (InfixApp _ _ op _) = not $ isDol op+ notDol _ = True -monadJoin (x:xs) cs = first (x:) <$> monadJoin xs cs-monadJoin [] _ = Nothing+monadStep _ _ = [] +-- Suggest removing a return+monadSteps :: ([Stmt S] -> Exp_) -> [Stmt S] -> [Idea]+monadSteps wrap (x:xs) = monadStep wrap (x:xs) ++ monadSteps (wrap . (x :)) xs+monadSteps _ _ = []+++-- | do ...; x <- return y; ... ==> do ...; let x = y; ... monadLet :: [Stmt S] -> Maybe ([Stmt S], [Refactoring R.SrcSpan]) monadLet xs = if null rs then Nothing else Just (ys, rs) where@@ -151,6 +184,15 @@ mkLet x = (x, Nothing) template lhs rhs = LetStmt an $ BDecls an [PatBind an lhs (UnGuardedRhs an rhs) Nothing] ++fromApplies :: Exp_ -> ([Exp_], Exp_)+fromApplies (App _ f x) = first (f:) $ fromApplies (fromParen x)+fromApplies (InfixApp _ f (isDol -> True) x) = first (f:) $ fromApplies x+fromApplies x = ([], x)+++-- | Match @return x@ to @Just x@.+fromRet :: Exp_ -> Maybe 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
src/Hint/Naming.hs view
@@ -87,7 +87,7 @@ suggestName :: String -> Maybe String suggestName x | isSym x || good || not (any isLower x) || any isDigit x ||- any (`isPrefixOf` x) ["prop_","case_","unit_","test_"] = Nothing+ any (`isPrefixOf` x) ["prop_","case_","unit_","test_","spec_","scprop_","hprop_"] = Nothing | otherwise = Just $ f x where good = all isAlphaNum $ drp '_' $ drp '#' $ drp '\'' $ reverse $ drp '_' x
src/Hint/NewType.hs view
@@ -16,6 +16,7 @@ data X = Y {-# UNPACK #-} !Int -- newtype X = Y Int data A = A {b :: !C} -- newtype A = A {b :: C} data A = A Int#+{-# LANGUAGE UnboxedTuples #-}; data WithAnn x = WithAnn (# Ann, x #) data A = A () -- newtype A = A () </TEST> -}