Allow Avoid lambda to trigger in more cases (#1660)

Author: zliu41

src/Hint/All.hs

@@ -74,7 +74,7 @@ builtin x = case x of
         wrap = timed "Hint" (drop 4 $ show x) . forceList
         decl f = mempty{hintDecl=const $ \a b c -> wrap $ f a b c}
         modu f = mempty{hintModule=const $ \a b -> wrap $ f a b}
-        mods f = mempty{hintModules=const $ \a -> wrap $ f a}
+        mods f = mempty{hintModules=const $ wrap . f}
 
 -- | A list of builtin hints, currently including entries such as @\"List\"@ and @\"Bracket\"@.
 builtinHints :: [(String, Hint)]

src/Hint/Lambda.hs

@@ -77,6 +77,8 @@ f = \z -> foo $ bar x $ baz z where -- foo . bar x . baz
 f = \z -> foo $ z $ baz z where
 f = \x -> bar map (filter x) where -- bar map . filter
 f = bar &+& \x -> f (g x)
+f = bar &+& \x -> f x -- f
+f = bar $ \x -> f (g x) -- f . g
 foo = [\column -> set column [treeViewColumnTitle := printf "%s (match %d)" name (length candidnates)]]
 foo = [\x -> x]
 foo = [\m x -> insert x x m]
@@ -221,9 +223,14 @@ lambdaExp _ o@(L _ (HsPar _ (view -> App2 (view -> Var_ "flip") origf@(view -> R
         r = Replace Expr (toSSA o) [(var, toSSA y)] ("(" ++ op ++ " " ++ var ++ ")")
 
 lambdaExp p o@(L _ (HsLam _ LamSingle _))
-    | not $ any isOpApp p
-    , (res, refact) <- niceLambdaR p [] o
+    | (res, refact) <- niceLambdaR p [] o
     , not $ isLambda res
+    -- Do not suggest "Avoid lambda" if both the parent and the result are `OpApps`.
+    -- For example, this should be avoided: `bar &+& \x -> f (g x)` ==> `bar &+& f . g`,
+    -- since it may not be valid depending on the precedence of `&+&`.
+    -- An exception is when the parent is `$`. Since `$` has the lowest precedence, it is
+    -- always safe to apply this hint.
+    , not (any isOpApp p) || not (isOpApp res) || any isDollarApp p
     , not $ any isQuasiQuoteExpr $ universe res
     , not $ "runST" `Set.member` Set.map occNameString (freeVars o)
     , let name = "Avoid lambda" ++ (if countRightSections res > countRightSections o then " using `infix`" else "")
@@ -322,6 +329,11 @@ lambdaExp _ _ = []
 varBody :: LHsExpr GhcPs
 varBody = strToVar "body"
 
+isDollarApp :: LHsExpr GhcPs -> Bool
+isDollarApp = \case
+  (L _ (OpApp _ _ op _)) -> isDol op
+  _ -> False
+
 -- | Squash lambdas and replace any repeated pattern variable with @_@
 fromLambda :: LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
 fromLambda (SimpleLambda ps1 (fromLambda . fromParen -> (ps2,x))) = (transformBi (f $ pvars ps2) ps1 ++ ps2, x)

src/Hint/Monad.hs

@@ -135,7 +135,7 @@ monadExp decl parentDo parentExpr x =
     _ -> []
   where
     f = monadNoResult (fromMaybe "" decl) id
-    seenVoid wrap (L l (HsPar x y)) = seenVoid (wrap . L l . \y -> HsPar x y) y
+    seenVoid wrap (L l (HsPar x y)) = seenVoid (wrap . L l . HsPar x) y
     seenVoid wrap x =
       -- Suggest `traverse_ f x` given `void $ traverse_ f x`
       [warn "Redundant void" (reLoc (wrap x)) (reLoc x) [Replace Expr (toSSA (wrap x)) [("a", toSSA x)] "a"] | returnsUnit x]
@@ -189,7 +189,7 @@ modifyAppHead :: forall a. (LIdP GhcPs -> (LIdP GhcPs, a)) -> LHsExpr GhcPs -> (
 modifyAppHead f = go id
   where
     go :: (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)
-    go wrap (L l (HsPar _ x)) = go (wrap . L l . \y -> HsPar noAnn y) x
+    go wrap (L l (HsPar _ x)) = go (wrap . L l . HsPar noAnn) x
     go wrap (L l (HsApp _ x y)) = go (\x -> wrap $ L l (HsApp noExtField x y)) x
     go wrap (L l (OpApp _ x op y)) | isDol op = go (\x -> wrap $ L l (OpApp noExtField x op y)) x
     go wrap (L l (HsVar _ x)) = (wrap (L l (HsVar NoExtField x')), Just a)