{-# LANGUAGE LambdaCase, PatternGuards, TupleSections, ViewPatterns #-}

{-
    Concept:
    Remove all the lambdas you can be inserting only sections
    Never create a right section with +-# as the operator (they are misparsed)

    Rules:
    fun a = \x -> y  -- promote lambdas, provided no where's outside the lambda
    fun x = y x  -- eta reduce, x /= mr and foo /= symbol
    \x -> y x ==> y -- eta reduce
    ((#) x) ==> (x #)  -- rotate operators
    (flip op x) ==> (`op` x)  -- rotate operators
    \x y -> x + y ==> (+)  -- insert operator
    \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 -- lambda compression
    \x -> (x +) ==> (+) -- operator reduction

<TEST>
f a = \x -> x + x -- f a x = x + x
f a = \a -> a + a -- f _ a = a + a
a = \x -> x + x -- a x = x + x
f (Just a) = \a -> a + a -- f (Just _) a = a + a
f (Foo a b c) = \c -> c + c -- f (Foo a b _) c = c + c
f a = \x -> x + x where _ = test
f (test -> a) = \x -> x + x
f = \x -> x + x -- f x = x + x
fun x y z = f x y z -- fun = f
fun x y z = f x x y z -- fun x = f x x
fun x y z = f g z -- fun x y = f g
fun x = f . g $ x -- fun = f . g
fun a b = f a b c where g x y = h x y -- g = h
fun a b = let g x y = h x y in f a b c -- g = h
f = foo (\y -> g x . h $ y) -- g x . h
f = foo (\y -> g x . h $ y) -- @Message Avoid lambda
f = foo ((*) x) -- (x *)
f = foo ((Prelude.*) x) -- (x Prelude.*)
f = (*) x
f = foo (flip op x) -- (`op` x)
f = foo (flip op x) -- @Message Use section
f = foo (flip x y) -- (`x` y)
foo x = bar (\ d -> search d table) -- (`search` table)
foo x = bar (\ d -> search d table) -- @Message Avoid lambda using `infix`
f = flip op x
f = foo (flip (*) x) -- (* x)
f = foo (flip (Prelude.*) x) -- (Prelude.* x)
f = foo (flip (-) x)
f = foo (\x y -> fun x y) -- @Warning fun
f = foo (\x y z -> fun x y z) -- @Warning fun
f = foo (\z -> f x $ z) -- f x
f = foo (\x y -> x + y) -- (+)
f = foo (\x -> x * y) -- @Suggestion (* 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 -> foo x x
f = foo (\(foo -> x) -> \y -> x x y y)
f = foo (\(x:xs) -> \x -> foo x x) -- \(_:xs) x -> foo x x
f = foo (\x -> \y -> \z -> x x y y z z) -- \x y z -> x x y y z z
x ! y = fromJust $ lookup x y
f = foo (\i -> writeIdea (getClass i) i)
f = bar (flip Foo.bar x) -- (`Foo.bar` x)
f = a b (\x -> c x d)  -- (`c` d)
yes = \x -> a x where -- a
yes = \x y -> op y x where -- flip op
yes = \x y -> op z y x where -- flip (op z)
f = \y -> nub $ reverse y where -- nub . reverse
f = \z -> foo $ bar $ baz z where -- foo . bar . baz
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)
foo = [\column -> set column [treeViewColumnTitle := printf "%s (match %d)" name (length candidnates)]]
foo = [\x -> x]
foo = [\m x -> insert x x m]
foo a b c = bar (flux ++ quux) c where flux = a -- foo a b = bar (flux ++ quux)
foo a b c = bar (flux ++ quux) c where flux = c
yes = foo (\x -> Just x) -- @Warning Just
foo = bar (\x -> (x `f`)) -- f
foo = bar (\x -> shakeRoot </> "src" </> x)
baz = bar (\x -> (x +)) -- (+)
xs `withArgsFrom` args = f args
foo = bar (\x -> case x of Y z -> z) -- \(Y z) -> z
foo = bar (\x -> case x of [y, z] -> z) -- \[y, z] -> z
yes = blah (\ x -> case x of A -> a; B -> b) -- \ case A -> a; B -> b
yes = blah (\ x -> case x of A -> a; B -> b) -- @Note may require `{-# LANGUAGE LambdaCase #-}` adding to the top of the file
no = blah (\ x -> case x of A -> a x; B -> b x)
foo = bar (\x -> case x of Y z | z > 0 -> z) -- \case Y z | z > 0 -> z
yes = blah (\ x -> (y, x)) -- (y,)
yes = blah (\ x -> (y, x, z+q)) -- (y, , z+q)
yes = blah (\ x -> (y, x, y, u, v)) -- (y, , y, u, v)
yes = blah (\ x -> (y, x, z+q)) -- @Note may require `{-# LANGUAGE TupleSections #-}` adding to the top of the file
yes = blah (\ x -> (y, x, z+x))
tmp = map (\ x -> runST $ action x)
yes = map (\f -> dataDir </> f) dataFiles -- (dataDir </>)
{-# LANGUAGE TypeApplications #-}; noBug545 = coerce ((<>) @[a])
{-# LANGUAGE QuasiQuotes #-}; authOAuth2 name = authOAuth2Widget [whamlet|Login via #{name}|] name
{-# LANGUAGE QuasiQuotes #-}; authOAuth2 = foo (\name -> authOAuth2Widget [whamlet|Login via #{name}|] name)
f = {- generates a hint using hlint.yaml only -} map (flip (,) "a") "123"
f = {- generates a hint using hlint.yaml only -} map ((,) "a") "123"
f = map (\s -> MkFoo s 0 s) ["a","b","c"]
</TEST>
-}


module Hint.Lambda(lambdaHint) where

import Hint.Type (DeclHint, Idea, Note(RequiresExtension), suggest, warn, toSS, suggestN, ideaNote, substVars, toRefactSrcSpan)
import Util
import Data.List.Extra
import Data.Set (Set)
import qualified Data.Set as Set
import Refact.Types hiding (Match)
import Data.Generics.Uniplate.DataOnly (universe, universeBi, transformBi)

import GHC.Types.Basic
import GHC.Hs
import GHC.Types.Name.Occurrence
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr (isTypeApp, isOpApp, isLambda, isQuasiQuote, isVar, isDol, strToVar)
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
import GHC.Util.Brackets (isAtom)
import GHC.Util.FreeVars (free, allVars, freeVars, pvars, vars, varss)
import GHC.Util.HsExpr (allowLeftSection, allowRightSection, niceLambdaR, lambda)
import GHC.Util.View

lambdaHint :: DeclHint
lambdaHint :: DeclHint
lambdaHint Scope
_ ModuleEx
_ LHsDecl (GhcPass 'Parsed)
x
    =  ((Maybe (LHsExpr (GhcPass 'Parsed)), LHsExpr (GhcPass 'Parsed))
 -> [Idea])
-> [(Maybe (LHsExpr (GhcPass 'Parsed)), LHsExpr (GhcPass 'Parsed))]
-> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Maybe (LHsExpr (GhcPass 'Parsed))
 -> LHsExpr (GhcPass 'Parsed) -> [Idea])
-> (Maybe (LHsExpr (GhcPass 'Parsed)), LHsExpr (GhcPass 'Parsed))
-> [Idea]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe (LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> [Idea]
lambdaExp) (LHsDecl (GhcPass 'Parsed)
-> [(Maybe (LHsExpr (GhcPass 'Parsed)), LHsExpr (GhcPass 'Parsed))]
forall a b. (Data a, Data b) => a -> [(Maybe b, b)]
universeParentBi LHsDecl (GhcPass 'Parsed)
x)
    [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ ((LHsBind (GhcPass 'Parsed), RType) -> [Idea])
-> [(LHsBind (GhcPass 'Parsed), RType)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((LHsBind (GhcPass 'Parsed) -> RType -> [Idea])
-> (LHsBind (GhcPass 'Parsed), RType) -> [Idea]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LHsBind (GhcPass 'Parsed) -> RType -> [Idea]
lambdaBind) [(LHsBind (GhcPass 'Parsed), RType)]
binds
  where
    binds :: [(LHsBind (GhcPass 'Parsed), RType)]
binds =
        ( case LHsDecl (GhcPass 'Parsed)
x of
            -- Turn a top-level HsBind under a ValD into an LHsBind.
            -- Also, its refact type needs to be Decl.
            L SrcSpan
loc (ValD XValD (GhcPass 'Parsed)
_ HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
bind) -> ((SrcSpan
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
bind, RType
Decl) (LHsBind (GhcPass 'Parsed), RType)
-> [(LHsBind (GhcPass 'Parsed), RType)]
-> [(LHsBind (GhcPass 'Parsed), RType)]
forall a. a -> [a] -> [a]
:)
            LHsDecl (GhcPass 'Parsed)
_ -> [(LHsBind (GhcPass 'Parsed), RType)]
-> [(LHsBind (GhcPass 'Parsed), RType)]
forall a. a -> a
id
        )
            ((,RType
Bind) (LHsBind (GhcPass 'Parsed) -> (LHsBind (GhcPass 'Parsed), RType))
-> [LHsBind (GhcPass 'Parsed)]
-> [(LHsBind (GhcPass 'Parsed), RType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsDecl (GhcPass 'Parsed) -> [LHsBind (GhcPass 'Parsed)]
forall from to. Biplate from to => from -> [to]
universeBi LHsDecl (GhcPass 'Parsed)
x)

lambdaBind :: LHsBind GhcPs -> RType -> [Idea]
lambdaBind :: LHsBind (GhcPass 'Parsed) -> RType -> [Idea]
lambdaBind
    o :: LHsBind (GhcPass 'Parsed)
o@(L SrcSpan
_ origBind :: HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
origBind@FunBind {fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id = funName :: Located (IdP (GhcPass 'Parsed))
funName@(L SrcSpan
loc1 IdP (GhcPass 'Parsed)
_), fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches =
        MG {mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts =
            L SrcSpan
_ [L SrcSpan
_ (Match XCMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ ctxt :: HsMatchContext (NoGhcTc (GhcPass 'Parsed))
ctxt@(FunRhs LIdP (NoGhcTc (GhcPass 'Parsed))
_ LexicalFixity
Prefix SrcStrictness
_) [LPat (GhcPass 'Parsed)]
pats (GRHSs XCGRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ [L SrcSpan
_ (GRHS XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ [] origBody :: LHsExpr (GhcPass 'Parsed)
origBody@(L SrcSpan
loc2 HsExpr (GhcPass 'Parsed)
_))] LHsLocalBinds (GhcPass 'Parsed)
bind))]}}) RType
rtype
    | L SrcSpan
_ (EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
_) <- LHsLocalBinds (GhcPass 'Parsed)
bind
    , LHsExpr (GhcPass 'Parsed) -> Bool
isLambda (LHsExpr (GhcPass 'Parsed) -> Bool)
-> LHsExpr (GhcPass 'Parsed) -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
fromParen LHsExpr (GhcPass 'Parsed)
origBody
    , [HsExpr (GhcPass 'Parsed)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Located (Pat (GhcPass 'Parsed))] -> [HsExpr (GhcPass 'Parsed)]
forall from to. Biplate from to => from -> [to]
universeBi [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
pats :: [HsExpr GhcPs])
    = let ([Located (Pat (GhcPass 'Parsed))]
newPats, LHsExpr (GhcPass 'Parsed)
newBody) = LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
fromLambda (LHsExpr (GhcPass 'Parsed)
 -> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed)))
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
lambda [LPat (GhcPass 'Parsed)]
pats (LHsExpr (GhcPass 'Parsed)
 -> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
origBody
          ([(String, SrcSpan)]
sub, String
tpl) = [Located (Pat (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed) -> ([(String, SrcSpan)], String)
forall {a}.
[Located (Pat (GhcPass 'Parsed))]
-> Located a -> ([(String, SrcSpan)], String)
mkSubtsAndTpl [Located (Pat (GhcPass 'Parsed))]
newPats LHsExpr (GhcPass 'Parsed)
newBody
          gen :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsDecl GhcPs
          gen :: [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
gen [LPat (GhcPass 'Parsed)]
ps = ([Located (Pat (GhcPass 'Parsed))]
 -> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed))
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
-> LHsDecl (GhcPass 'Parsed)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
[Located (Pat (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
reform (([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
 -> LHsDecl (GhcPass 'Parsed))
-> (LHsExpr (GhcPass 'Parsed)
    -> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> LHsDecl (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
fromLambda (LHsExpr (GhcPass 'Parsed)
 -> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed)))
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
lambda [LPat (GhcPass 'Parsed)]
ps
          refacts :: [Refactoring SrcSpan]
refacts = case LHsExpr (GhcPass 'Parsed)
newBody of
              -- https://github.com/alanz/ghc-exactprint/issues/97
              L SrcSpan
_ HsCase{} -> []
              LHsExpr (GhcPass 'Parsed)
_ -> [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
rtype (LHsBind (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsBind (GhcPass 'Parsed)
o) [(String, SrcSpan)]
sub String
tpl]
       in [String
-> LHsBind (GhcPass 'Parsed)
-> LHsDecl (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant lambda" LHsBind (GhcPass 'Parsed)
o ([LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
gen [LPat (GhcPass 'Parsed)]
pats LHsExpr (GhcPass 'Parsed)
origBody) [Refactoring SrcSpan]
refacts]

    | let ([Located (Pat (GhcPass 'Parsed))]
newPats, LHsExpr (GhcPass 'Parsed)
newBody) = [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
etaReduce [LPat (GhcPass 'Parsed)]
pats LHsExpr (GhcPass 'Parsed)
origBody
    , [Located (Pat (GhcPass 'Parsed))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Located (Pat (GhcPass 'Parsed))]
newPats Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Located (Pat (GhcPass 'Parsed))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
pats, [Located (Pat (GhcPass 'Parsed))] -> [String]
forall a. AllVars a => a -> [String]
pvars (Int
-> [Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))]
forall a. Int -> [a] -> [a]
drop ([Located (Pat (GhcPass 'Parsed))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Located (Pat (GhcPass 'Parsed))]
newPats) [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
pats) [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`disjoint` LHsLocalBinds (GhcPass 'Parsed) -> [String]
forall a. AllVars a => a -> [String]
varss LHsLocalBinds (GhcPass 'Parsed)
bind
    = let ([(String, SrcSpan)]
sub, String
tpl) = [Located (Pat (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed) -> ([(String, SrcSpan)], String)
forall {a}.
[Located (Pat (GhcPass 'Parsed))]
-> Located a -> ([(String, SrcSpan)], String)
mkSubtsAndTpl [Located (Pat (GhcPass 'Parsed))]
newPats LHsExpr (GhcPass 'Parsed)
newBody
       in [String
-> LHsDecl (GhcPass 'Parsed)
-> LHsDecl (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Eta reduce" ([LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
reform [LPat (GhcPass 'Parsed)]
pats LHsExpr (GhcPass 'Parsed)
origBody) ([LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
reform [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
newPats LHsExpr (GhcPass 'Parsed)
newBody)
            [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
rtype (LHsDecl (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS (LHsDecl (GhcPass 'Parsed) -> SrcSpan)
-> LHsDecl (GhcPass 'Parsed) -> SrcSpan
forall a b. (a -> b) -> a -> b
$ [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
reform [LPat (GhcPass 'Parsed)]
pats LHsExpr (GhcPass 'Parsed)
origBody) [(String, SrcSpan)]
sub String
tpl]
          ]
    where reform :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsDecl GhcPs
          reform :: [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
reform [LPat (GhcPass 'Parsed)]
ps LHsExpr (GhcPass 'Parsed)
b = SrcSpan -> HsDecl (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
loc1 SrcSpan
loc2) (HsDecl (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed))
-> HsDecl (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XValD (GhcPass 'Parsed)
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsDecl (GhcPass 'Parsed)
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD (GhcPass 'Parsed)
NoExtField
noExtField (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
 -> HsDecl (GhcPass 'Parsed))
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
            HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
origBind
              {fun_matches :: MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
fun_matches = XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> GenLocated
     SrcSpan [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> Origin
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body.
XMG p body
-> Located [LMatch p body] -> Origin -> MatchGroup p body
MG XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField ([LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> GenLocated
     SrcSpan [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
forall e. e -> Located e
noLoc [Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall e. e -> Located e
noLoc (Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
 -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XCMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> HsMatchContext (NoGhcTc (GhcPass 'Parsed))
-> [LPat (GhcPass 'Parsed)]
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField HsMatchContext (NoGhcTc (GhcPass 'Parsed))
ctxt [LPat (GhcPass 'Parsed)]
ps (GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
 -> Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XCGRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsLocalBinds (GhcPass 'Parsed)
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField [GRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall e. e -> Located e
noLoc (GRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
 -> LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> GRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [GuardLStmt (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> GRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField [] LHsExpr (GhcPass 'Parsed)
b] (LHsLocalBinds (GhcPass 'Parsed)
 -> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> LHsLocalBinds (GhcPass 'Parsed)
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ HsLocalBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> LHsLocalBinds (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsLocalBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
 -> LHsLocalBinds (GhcPass 'Parsed))
-> HsLocalBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> LHsLocalBinds (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsLocalBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
NoExtField
noExtField]) Origin
Generated}

          mkSubtsAndTpl :: [Located (Pat (GhcPass 'Parsed))]
-> Located a -> ([(String, SrcSpan)], String)
mkSubtsAndTpl [Located (Pat (GhcPass 'Parsed))]
newPats Located a
newBody = ([(String, SrcSpan)]
sub, String
tpl)
            where
              ([Located (Pat (GhcPass 'Parsed))]
origPats, [String]
vars) = Maybe String
-> [LPat (GhcPass 'Parsed)] -> ([LPat (GhcPass 'Parsed)], [String])
mkOrigPats (String -> Maybe String
forall a. a -> Maybe a
Just (Located RdrName -> String
rdrNameStr Located (IdP (GhcPass 'Parsed))
Located RdrName
funName)) [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
newPats
              sub :: [(String, SrcSpan)]
sub = (String
"body", Located a -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located a
newBody) (String, SrcSpan) -> [(String, SrcSpan)] -> [(String, SrcSpan)]
forall a. a -> [a] -> [a]
: [String] -> [SrcSpan] -> [(String, SrcSpan)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
vars ((Located (Pat (GhcPass 'Parsed)) -> SrcSpan)
-> [Located (Pat (GhcPass 'Parsed))] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat (GhcPass 'Parsed)) -> SrcSpan
forall a. Located a -> SrcSpan
toSS [Located (Pat (GhcPass 'Parsed))]
newPats)
              tpl :: String
tpl = LHsDecl (GhcPass 'Parsed) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint ([LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
reform [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
origPats LHsExpr (GhcPass 'Parsed)
varBody)

lambdaBind LHsBind (GhcPass 'Parsed)
_ RType
_ = []

etaReduce :: [LPat GhcPs] -> LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
etaReduce :: [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
etaReduce ([LPat (GhcPass 'Parsed)]
-> Maybe
     ([Located (Pat (GhcPass 'Parsed))],
      Located (Pat (GhcPass 'Parsed)))
forall a. [a] -> Maybe ([a], a)
unsnoc -> Just ([Located (Pat (GhcPass 'Parsed))]
ps, Located (Pat (GhcPass 'Parsed)) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
p)) (L SrcSpan
_ (HsApp XApp (GhcPass 'Parsed)
_ LHsExpr (GhcPass 'Parsed)
x (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
y)))
    | String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y
    , String
y String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` LHsExpr (GhcPass 'Parsed) -> [String]
forall a. FreeVars a => a -> [String]
vars LHsExpr (GhcPass 'Parsed)
x
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (LHsExpr (GhcPass 'Parsed) -> Bool)
-> [LHsExpr (GhcPass 'Parsed)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr (GhcPass 'Parsed) -> Bool
isQuasiQuote ([LHsExpr (GhcPass 'Parsed)] -> Bool)
-> [LHsExpr (GhcPass 'Parsed)] -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
forall on. Uniplate on => on -> [on]
universe LHsExpr (GhcPass 'Parsed)
x
    = [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
etaReduce [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
ps LHsExpr (GhcPass 'Parsed)
x
etaReduce [LPat (GhcPass 'Parsed)]
ps (L SrcSpan
loc (OpApp XOpApp (GhcPass 'Parsed)
_ LHsExpr (GhcPass 'Parsed)
x (LHsExpr (GhcPass 'Parsed) -> Bool
isDol -> Bool
True) LHsExpr (GhcPass 'Parsed)
y)) = [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
etaReduce [LPat (GhcPass 'Parsed)]
ps (SrcSpan -> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XApp (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp (GhcPass 'Parsed)
NoExtField
noExtField LHsExpr (GhcPass 'Parsed)
x LHsExpr (GhcPass 'Parsed)
y))
etaReduce [LPat (GhcPass 'Parsed)]
ps LHsExpr (GhcPass 'Parsed)
x = ([LPat (GhcPass 'Parsed)]
ps, LHsExpr (GhcPass 'Parsed)
x)

lambdaExp :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
lambdaExp :: Maybe (LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> [Idea]
lambdaExp Maybe (LHsExpr (GhcPass 'Parsed))
_ o :: LHsExpr (GhcPass 'Parsed)
o@(L SrcSpan
_ (HsPar XPar (GhcPass 'Parsed)
_ (L SrcSpan
_ (HsApp XApp (GhcPass 'Parsed)
_ oper :: LHsExpr (GhcPass 'Parsed)
oper@(L SrcSpan
_ (HsVar XVar (GhcPass 'Parsed)
_ origf :: Located (IdP (GhcPass 'Parsed))
origf@(L SrcSpan
_ (IdP (GhcPass 'Parsed) -> OccName
RdrName -> OccName
rdrNameOcc -> OccName
f)))) LHsExpr (GhcPass 'Parsed)
y))))
    | OccName -> Bool
isSymOcc OccName
f -- is this an operator?
    , LHsExpr (GhcPass 'Parsed) -> Bool
forall a. Brackets a => a -> Bool
isAtom LHsExpr (GhcPass 'Parsed)
y
    , String -> Bool
allowLeftSection (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString OccName
f
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> Bool
isTypeApp LHsExpr (GhcPass 'Parsed)
y
    = [String
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use section" LHsExpr (GhcPass 'Parsed)
o LHsExpr (GhcPass 'Parsed)
to [Refactoring SrcSpan
r]]
    where
        to :: LHsExpr GhcPs
        to :: LHsExpr (GhcPass 'Parsed)
to = HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XPar (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar (GhcPass 'Parsed)
NoExtField
noExtField (LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XSectionL (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XSectionL p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionL XSectionL (GhcPass 'Parsed)
NoExtField
noExtField LHsExpr (GhcPass 'Parsed)
y LHsExpr (GhcPass 'Parsed)
oper
        r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
o) [(String
"x", LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
y)] (String
"(x " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Located RdrName -> String
forall a. Outputable a => a -> String
unsafePrettyPrint Located (IdP (GhcPass 'Parsed))
Located RdrName
origf String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")

lambdaExp Maybe (LHsExpr (GhcPass 'Parsed))
_ o :: LHsExpr (GhcPass 'Parsed)
o@(L SrcSpan
_ (HsPar XPar (GhcPass 'Parsed)
_ (LHsExpr (GhcPass 'Parsed) -> App2
forall a b. View a b => a -> b
view -> App2 (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
"flip") origf :: LHsExpr (GhcPass 'Parsed)
origf@(LHsExpr (GhcPass 'Parsed) -> RdrName_
forall a b. View a b => a -> b
view -> RdrName_ Located RdrName
f) LHsExpr (GhcPass 'Parsed)
y)))
    | String -> Bool
allowRightSection (Located RdrName -> String
rdrNameStr Located RdrName
f), Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Located RdrName -> String
rdrNameStr Located RdrName
f
    = [String
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use section" LHsExpr (GhcPass 'Parsed)
o LHsExpr (GhcPass 'Parsed)
to [Refactoring SrcSpan
r]]
    where
        to :: LHsExpr GhcPs
        to :: LHsExpr (GhcPass 'Parsed)
to = HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XPar (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar (GhcPass 'Parsed)
NoExtField
noExtField (LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XSectionR (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR XSectionR (GhcPass 'Parsed)
NoExtField
noExtField LHsExpr (GhcPass 'Parsed)
origf LHsExpr (GhcPass 'Parsed)
y
        op :: String
op = if RdrName -> Bool
isSymbolRdrName (Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc Located RdrName
f)
               then Located RdrName -> String
forall a. Outputable a => a -> String
unsafePrettyPrint Located RdrName
f
               else String
"`" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Located RdrName -> String
forall a. Outputable a => a -> String
unsafePrettyPrint Located RdrName
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"`"
        var :: String
var = if Located RdrName -> String
rdrNameStr Located RdrName
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x" then String
"y" else String
"x"
        r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
o) [(String
var, LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
y)] (String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
lambdaExp Maybe (LHsExpr (GhcPass 'Parsed))
p o :: LHsExpr (GhcPass 'Parsed)
o@(L SrcSpan
_ HsLam{})
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (LHsExpr (GhcPass 'Parsed) -> Bool)
-> Maybe (LHsExpr (GhcPass 'Parsed)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr (GhcPass 'Parsed) -> Bool
isOpApp Maybe (LHsExpr (GhcPass 'Parsed))
p
    , (LHsExpr (GhcPass 'Parsed)
res, SrcSpan -> [Refactoring SrcSpan]
refact) <- [String]
-> LHsExpr (GhcPass 'Parsed)
-> (LHsExpr (GhcPass 'Parsed), SrcSpan -> [Refactoring SrcSpan])
niceLambdaR [] LHsExpr (GhcPass 'Parsed)
o
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> Bool
isLambda LHsExpr (GhcPass 'Parsed)
res
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (LHsExpr (GhcPass 'Parsed) -> Bool)
-> [LHsExpr (GhcPass 'Parsed)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr (GhcPass 'Parsed) -> Bool
isQuasiQuote ([LHsExpr (GhcPass 'Parsed)] -> Bool)
-> [LHsExpr (GhcPass 'Parsed)] -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
forall on. Uniplate on => on -> [on]
universe LHsExpr (GhcPass 'Parsed)
res
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
"runST" String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` (OccName -> String) -> Set OccName -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map OccName -> String
occNameString (LHsExpr (GhcPass 'Parsed) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr (GhcPass 'Parsed)
o)
    , let name :: String
name = String
"Avoid lambda" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if LHsExpr (GhcPass 'Parsed) -> Int
countRightSections LHsExpr (GhcPass 'Parsed)
res Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> LHsExpr (GhcPass 'Parsed) -> Int
countRightSections LHsExpr (GhcPass 'Parsed)
o then String
" using `infix`" else String
"")
    -- If the lambda's parent is an HsPar, and the result is also an HsPar, the span should include the parentheses.
    , let from :: LHsExpr (GhcPass 'Parsed)
from = case Maybe (LHsExpr (GhcPass 'Parsed))
p of
              -- Avoid creating redundant bracket.
              Just p :: LHsExpr (GhcPass 'Parsed)
p@(L SrcSpan
_ (HsPar XPar (GhcPass 'Parsed)
_ (L SrcSpan
_ HsLam{})))
                | L SrcSpan
_ HsPar{} <- LHsExpr (GhcPass 'Parsed)
res -> LHsExpr (GhcPass 'Parsed)
p
                | L SrcSpan
_ (HsVar XVar (GhcPass 'Parsed)
_ (L SrcSpan
_ IdP (GhcPass 'Parsed)
name)) <- LHsExpr (GhcPass 'Parsed)
res, Bool -> Bool
not (RdrName -> Bool
isSymbolRdrName IdP (GhcPass 'Parsed)
RdrName
name) -> LHsExpr (GhcPass 'Parsed)
p
              Maybe (LHsExpr (GhcPass 'Parsed))
_ -> LHsExpr (GhcPass 'Parsed)
o
    = [(if LHsExpr (GhcPass 'Parsed) -> Bool
isVar LHsExpr (GhcPass 'Parsed)
res then String
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn else String
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest) String
name LHsExpr (GhcPass 'Parsed)
from LHsExpr (GhcPass 'Parsed)
res (SrcSpan -> [Refactoring SrcSpan]
refact (SrcSpan -> [Refactoring SrcSpan])
-> SrcSpan -> [Refactoring SrcSpan]
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
from)]
    where
        countRightSections :: LHsExpr GhcPs -> Int
        countRightSections :: LHsExpr (GhcPass 'Parsed) -> Int
countRightSections LHsExpr (GhcPass 'Parsed)
x = [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | L SrcSpan
_ (SectionR XSectionR (GhcPass 'Parsed)
_ (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
_) LHsExpr (GhcPass 'Parsed)
_) <- LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
forall on. Uniplate on => on -> [on]
universe LHsExpr (GhcPass 'Parsed)
x]

lambdaExp Maybe (LHsExpr (GhcPass 'Parsed))
p o :: LHsExpr (GhcPass 'Parsed)
o@(SimpleLambda [LPat (GhcPass 'Parsed)]
origPats LHsExpr (GhcPass 'Parsed)
origBody)
    | LHsExpr (GhcPass 'Parsed) -> Bool
isLambda (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
fromParen LHsExpr (GhcPass 'Parsed)
origBody)
    , [HsExpr (GhcPass 'Parsed)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Located (Pat (GhcPass 'Parsed))] -> [HsExpr (GhcPass 'Parsed)]
forall from to. Biplate from to => from -> [to]
universeBi [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
origPats :: [HsExpr GhcPs]) -- TODO: I think this checks for view patterns only, so maybe be more explicit about that?
    , Bool
-> (LHsExpr (GhcPass 'Parsed) -> Bool)
-> Maybe (LHsExpr (GhcPass 'Parsed))
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not (Bool -> Bool)
-> (LHsExpr (GhcPass 'Parsed) -> Bool)
-> LHsExpr (GhcPass 'Parsed)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr (GhcPass 'Parsed) -> Bool
isLambda) Maybe (LHsExpr (GhcPass 'Parsed))
p =
    [String
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Collapse lambdas" LHsExpr (GhcPass 'Parsed)
o ([LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
lambda [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
pats LHsExpr (GhcPass 'Parsed)
body) [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
o) [(String, SrcSpan)]
subts String
template]]
    where
      ([Located (Pat (GhcPass 'Parsed))]
pats, LHsExpr (GhcPass 'Parsed)
body) = LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
fromLambda LHsExpr (GhcPass 'Parsed)
o
      ([Located (Pat (GhcPass 'Parsed))]
oPats, [String]
vars) = Maybe String
-> [LPat (GhcPass 'Parsed)] -> ([LPat (GhcPass 'Parsed)], [String])
mkOrigPats Maybe String
forall a. Maybe a
Nothing [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
pats
      subts :: [(String, SrcSpan)]
subts = (String
"body", LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
body) (String, SrcSpan) -> [(String, SrcSpan)] -> [(String, SrcSpan)]
forall a. a -> [a] -> [a]
: [String] -> [SrcSpan] -> [(String, SrcSpan)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
vars ((Located (Pat (GhcPass 'Parsed)) -> SrcSpan)
-> [Located (Pat (GhcPass 'Parsed))] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat (GhcPass 'Parsed)) -> SrcSpan
forall a. Located a -> SrcSpan
toSS [Located (Pat (GhcPass 'Parsed))]
pats)
      template :: String
template = LHsExpr (GhcPass 'Parsed) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint ([LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
lambda [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
oPats LHsExpr (GhcPass 'Parsed)
varBody)

-- match a lambda with a variable pattern, with no guards and no where clauses
lambdaExp Maybe (LHsExpr (GhcPass 'Parsed))
_ o :: LHsExpr (GhcPass 'Parsed)
o@(SimpleLambda [LPat (GhcPass 'Parsed) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
x] (L SrcSpan
_ HsExpr (GhcPass 'Parsed)
expr)) =
    case HsExpr (GhcPass 'Parsed)
expr of
        -- suggest TupleSections instead of lambdas
        ExplicitTuple XExplicitTuple (GhcPass 'Parsed)
_ [LHsTupArg (GhcPass 'Parsed)]
args Boxity
boxity
            -- is there exactly one argument that is exactly x?
            | ([LHsTupArg (GhcPass 'Parsed)
_x], [LHsTupArg (GhcPass 'Parsed)]
ys) <- (LHsTupArg (GhcPass 'Parsed) -> Bool)
-> [LHsTupArg (GhcPass 'Parsed)]
-> ([LHsTupArg (GhcPass 'Parsed)], [LHsTupArg (GhcPass 'Parsed)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
==String -> Maybe String
forall a. a -> Maybe a
Just String
x) (Maybe String -> Bool)
-> (LHsTupArg (GhcPass 'Parsed) -> Maybe String)
-> LHsTupArg (GhcPass 'Parsed)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTupArg (GhcPass 'Parsed) -> Maybe String
tupArgVar) [LHsTupArg (GhcPass 'Parsed)]
args
            -- the other arguments must not have a nested x somewhere in them
            , String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember String
x (Set String -> Bool) -> Set String -> Bool
forall a b. (a -> b) -> a -> b
$ (OccName -> String) -> Set OccName -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map OccName -> String
occNameString (Set OccName -> Set String) -> Set OccName -> Set String
forall a b. (a -> b) -> a -> b
$ [LHsTupArg (GhcPass 'Parsed)] -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars [LHsTupArg (GhcPass 'Parsed)]
ys
            -> [(String
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed) -> Idea
forall a. Outputable a => String -> Located a -> Located a -> Idea
suggestN String
"Use tuple-section" LHsExpr (GhcPass 'Parsed)
o (LHsExpr (GhcPass 'Parsed) -> Idea)
-> LHsExpr (GhcPass 'Parsed) -> Idea
forall a b. (a -> b) -> a -> b
$ HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XExplicitTuple (GhcPass 'Parsed)
-> [LHsTupArg (GhcPass 'Parsed)]
-> Boxity
-> HsExpr (GhcPass 'Parsed)
forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple (GhcPass 'Parsed)
NoExtField
noExtField ((LHsTupArg (GhcPass 'Parsed) -> LHsTupArg (GhcPass 'Parsed))
-> [LHsTupArg (GhcPass 'Parsed)] -> [LHsTupArg (GhcPass 'Parsed)]
forall a b. (a -> b) -> [a] -> [b]
map LHsTupArg (GhcPass 'Parsed) -> LHsTupArg (GhcPass 'Parsed)
removeX [LHsTupArg (GhcPass 'Parsed)]
args) Boxity
boxity)
                  {ideaNote :: [Note]
ideaNote = [String -> Note
RequiresExtension String
"TupleSections"]}]

        -- suggest @LambdaCase@/directly matching in a lambda instead of doing @\x -> case x of ...@
        HsCase XCase (GhcPass 'Parsed)
_ (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
x') MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
matchGroup
            -- is the case being done on the variable from our original lambda?
            | String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x'
            -- x must not be used in some other way inside the matches
            , String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember String
x (Set String -> Bool) -> Set String -> Bool
forall a b. (a -> b) -> a -> b
$ (OccName -> String) -> Set OccName -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map OccName -> String
occNameString (Set OccName -> Set String) -> Set OccName -> Set String
forall a b. (a -> b) -> a -> b
$ Vars -> Set OccName
free (Vars -> Set OccName) -> Vars -> Set OccName
forall a b. (a -> b) -> a -> b
$ MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)) -> Vars
forall a. AllVars a => a -> Vars
allVars MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
matchGroup
            -> case MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
matchGroup of
                 -- is there a single match? - suggest match inside the lambda
                 --
                 -- we need to
                 --     * add brackets to the match, because matches in lambdas require them
                 --     * mark match as being in a lambda context so that it's printed properly
                 oldMG :: MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldMG@(MG XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ (L SrcSpan
_ [L SrcSpan
_ Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch]) Origin
_)
                   | (LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)) -> Bool)
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(L SrcSpan
_ (GRHS XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ [GuardLStmt (GhcPass 'Parsed)]
stmts LHsExpr (GhcPass 'Parsed)
_)) -> [GuardLStmt (GhcPass 'Parsed)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GuardLStmt (GhcPass 'Parsed)]
stmts) (GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs (Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body. Match p body -> GRHSs p body
m_grhss Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch)) ->
                     let patLocs :: [SrcSpan]
patLocs = (Located (Pat (GhcPass 'Parsed)) -> SrcSpan)
-> [Located (Pat (GhcPass 'Parsed))] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (Pat (GhcPass 'Parsed)) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LPat (GhcPass 'Parsed)]
forall p body. Match p body -> [LPat p]
m_pats Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch)
                         bodyLocs :: [SrcSpan]
bodyLocs = (LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)) -> [SrcSpan])
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> [SrcSpan]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\case L SrcSpan
_ (GRHS XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ [GuardLStmt (GhcPass 'Parsed)]
_ LHsExpr (GhcPass 'Parsed)
body) -> [LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr (GhcPass 'Parsed)
body])
                                        ([LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
 -> [SrcSpan])
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs (Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body. Match p body -> GRHSs p body
m_grhss Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch)
                         r :: [Refactoring SrcSpan]
r | [SrcSpan] -> Bool
forall a. [a] -> Bool
notNull [SrcSpan]
patLocs Bool -> Bool -> Bool
&& [SrcSpan] -> Bool
forall a. [a] -> Bool
notNull [SrcSpan]
bodyLocs =
                             let xloc :: SrcSpan
xloc = (SrcSpan -> SrcSpan -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall a. (a -> a -> a) -> [a] -> a
foldl1' SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans [SrcSpan]
patLocs
                                 yloc :: SrcSpan
yloc = (SrcSpan -> SrcSpan -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall a. (a -> a -> a) -> [a] -> a
foldl1' SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans [SrcSpan]
bodyLocs
                              in [ RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
o) [(String
"x", SrcSpan -> SrcSpan
toRefactSrcSpan SrcSpan
xloc), (String
"y", SrcSpan -> SrcSpan
toRefactSrcSpan SrcSpan
yloc)]
                                     ((if Bool
needParens then String
"\\(x)" else String
"\\x") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> y")
                                 ]
                           | Bool
otherwise = []
                         needParens :: Bool
needParens = (Located (Pat (GhcPass 'Parsed)) -> Bool)
-> [Located (Pat (GhcPass 'Parsed))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (PprPrec -> Pat (GhcPass 'Parsed) -> Bool
forall (p :: Pass). IsPass p => PprPrec -> Pat (GhcPass p) -> Bool
patNeedsParens PprPrec
appPrec (Pat (GhcPass 'Parsed) -> Bool)
-> (Located (Pat (GhcPass 'Parsed)) -> Pat (GhcPass 'Parsed))
-> Located (Pat (GhcPass 'Parsed))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Pat (GhcPass 'Parsed)) -> Pat (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc) (Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LPat (GhcPass 'Parsed)]
forall p body. Match p body -> [LPat p]
m_pats Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch)
                      in [ String
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use lambda" LHsExpr (GhcPass 'Parsed)
o
                             ( HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XLam (GhcPass 'Parsed)
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam (GhcPass 'Parsed)
NoExtField
noExtField MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldMG
                                 { mg_alts :: GenLocated
  SrcSpan [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
mg_alts = [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> GenLocated
     SrcSpan [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
forall e. e -> Located e
noLoc
                                     [ Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall e. e -> Located e
noLoc Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch
                                         { m_pats :: [LPat (GhcPass 'Parsed)]
m_pats = (Located (Pat (GhcPass 'Parsed))
 -> Located (Pat (GhcPass 'Parsed)))
-> [Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat (GhcPass 'Parsed)) -> Located (Pat (GhcPass 'Parsed))
forall (p :: Pass).
IsPass p =>
LPat (GhcPass p) -> LPat (GhcPass p)
mkParPat ([Located (Pat (GhcPass 'Parsed))]
 -> [Located (Pat (GhcPass 'Parsed))])
-> [Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> a -> b
$ Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LPat (GhcPass 'Parsed)]
forall p body. Match p body -> [LPat p]
m_pats Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch
                                         , m_ctxt :: HsMatchContext (NoGhcTc (GhcPass 'Parsed))
m_ctxt = HsMatchContext (NoGhcTc (GhcPass 'Parsed))
forall p. HsMatchContext p
LambdaExpr
                                         }
                                     ]
                                 }
                               :: LHsExpr GhcPs
                             )
                             [Refactoring SrcSpan]
r
                         ]

                 -- otherwise we should use @LambdaCase@
                 MG XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ (L SrcSpan
_ [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
_) Origin
_ ->
                     [(String
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed) -> Idea
forall a. Outputable a => String -> Located a -> Located a -> Idea
suggestN String
"Use lambda-case" LHsExpr (GhcPass 'Parsed)
o (LHsExpr (GhcPass 'Parsed) -> Idea)
-> LHsExpr (GhcPass 'Parsed) -> Idea
forall a b. (a -> b) -> a -> b
$ HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XLamCase (GhcPass 'Parsed)
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p. XLamCase p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase (GhcPass 'Parsed)
NoExtField
noExtField MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
matchGroup)
                         {ideaNote :: [Note]
ideaNote=[String -> Note
RequiresExtension String
"LambdaCase"]}]
        HsExpr (GhcPass 'Parsed)
_ -> []
    where
        -- | Filter out tuple arguments, converting the @x@ (matched in the lambda) variable argument
        -- to a missing argument, so that we get the proper section.
        removeX :: LHsTupArg GhcPs -> LHsTupArg GhcPs
        removeX :: LHsTupArg (GhcPass 'Parsed) -> LHsTupArg (GhcPass 'Parsed)
removeX (L SrcSpan
_ (Present XPresent (GhcPass 'Parsed)
_ (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
x')))
            | String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x' = HsTupArg (GhcPass 'Parsed) -> LHsTupArg (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsTupArg (GhcPass 'Parsed) -> LHsTupArg (GhcPass 'Parsed))
-> HsTupArg (GhcPass 'Parsed) -> LHsTupArg (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XMissing (GhcPass 'Parsed) -> HsTupArg (GhcPass 'Parsed)
forall id. XMissing id -> HsTupArg id
Missing XMissing (GhcPass 'Parsed)
NoExtField
noExtField
        removeX LHsTupArg (GhcPass 'Parsed)
y = LHsTupArg (GhcPass 'Parsed)
y
        -- | Extract the name of an argument of a tuple if it's present and a variable.
        tupArgVar :: LHsTupArg GhcPs -> Maybe String
        tupArgVar :: LHsTupArg (GhcPass 'Parsed) -> Maybe String
tupArgVar (L SrcSpan
_ (Present XPresent (GhcPass 'Parsed)
_ (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
x))) = String -> Maybe String
forall a. a -> Maybe a
Just String
x
        tupArgVar LHsTupArg (GhcPass 'Parsed)
_ = Maybe String
forall a. Maybe a
Nothing

lambdaExp Maybe (LHsExpr (GhcPass 'Parsed))
_ LHsExpr (GhcPass 'Parsed)
_ = []

varBody :: LHsExpr GhcPs
varBody :: LHsExpr (GhcPass 'Parsed)
varBody = String -> LHsExpr (GhcPass 'Parsed)
strToVar String
"body"

-- | Squash lambdas and replace any repeated pattern variable with @_@
fromLambda :: LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
fromLambda :: LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
fromLambda (SimpleLambda [LPat (GhcPass 'Parsed)]
ps1 (LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
fromLambda (LHsExpr (GhcPass 'Parsed)
 -> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed)))
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
fromParen -> ([Located (Pat (GhcPass 'Parsed))]
ps2,LHsExpr (GhcPass 'Parsed)
x))) = ((Pat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed))
-> [Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))]
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi ([String] -> Pat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
f ([String] -> Pat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed))
-> [String] -> Pat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ [Located (Pat (GhcPass 'Parsed))] -> [String]
forall a. AllVars a => a -> [String]
pvars [Located (Pat (GhcPass 'Parsed))]
ps2) [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
ps1 [Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))]
forall a. [a] -> [a] -> [a]
++ [Located (Pat (GhcPass 'Parsed))]
ps2, LHsExpr (GhcPass 'Parsed)
x)
    where f :: [String] -> Pat GhcPs -> Pat GhcPs
          f :: [String] -> Pat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
f [String]
bad (VarPat XVarPat (GhcPass 'Parsed)
_ (Located (IdP (GhcPass 'Parsed)) -> String
Located RdrName -> String
rdrNameStr -> String
x))
              | String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
bad = XWildPat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall p. XWildPat p -> Pat p
WildPat XWildPat (GhcPass 'Parsed)
NoExtField
noExtField
          f [String]
bad Pat (GhcPass 'Parsed)
x = Pat (GhcPass 'Parsed)
x
fromLambda LHsExpr (GhcPass 'Parsed)
x = ([], LHsExpr (GhcPass 'Parsed)
x)

-- | For each pattern, if it does not contain wildcards, replace it with a variable pattern.
--
-- The second component of the result is a list of substitution variables, which are guaranteed
-- to not occur in the function name or patterns with wildcards. For example, given
-- 'f (Foo a b _) = ...', 'f', 'a' and 'b' are not usable as substitution variables.
mkOrigPats :: Maybe String -> [LPat GhcPs] -> ([LPat GhcPs], [String])
mkOrigPats :: Maybe String
-> [LPat (GhcPass 'Parsed)] -> ([LPat (GhcPass 'Parsed)], [String])
mkOrigPats Maybe String
funName [LPat (GhcPass 'Parsed)]
pats = ((String
 -> (Bool, Located (Pat (GhcPass 'Parsed)))
 -> Located (Pat (GhcPass 'Parsed)))
-> [String]
-> [(Bool, Located (Pat (GhcPass 'Parsed)))]
-> [Located (Pat (GhcPass 'Parsed))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> (Bool, LPat (GhcPass 'Parsed)) -> LPat (GhcPass 'Parsed)
String
-> (Bool, Located (Pat (GhcPass 'Parsed)))
-> Located (Pat (GhcPass 'Parsed))
munge [String]
vars [(Bool, Located (Pat (GhcPass 'Parsed)))]
pats', [String]
vars)
  where
    ([Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions -> Set String
used, [(Bool, Located (Pat (GhcPass 'Parsed)))]
pats') = [(Set String, (Bool, Located (Pat (GhcPass 'Parsed))))]
-> ([Set String], [(Bool, Located (Pat (GhcPass 'Parsed)))])
forall a b. [(a, b)] -> ([a], [b])
unzip ((Located (Pat (GhcPass 'Parsed))
 -> (Set String, (Bool, Located (Pat (GhcPass 'Parsed)))))
-> [Located (Pat (GhcPass 'Parsed))]
-> [(Set String, (Bool, Located (Pat (GhcPass 'Parsed))))]
forall a b. (a -> b) -> [a] -> [b]
map LPat (GhcPass 'Parsed)
-> (Set String, (Bool, LPat (GhcPass 'Parsed)))
Located (Pat (GhcPass 'Parsed))
-> (Set String, (Bool, Located (Pat (GhcPass 'Parsed))))
f [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
pats)

    -- Remove variables that occur in the function name or patterns with wildcards
    vars :: [String]
vars = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
s -> String
s String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set String
used Bool -> Bool -> Bool
&& String -> Maybe String
forall a. a -> Maybe a
Just String
s Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe String
funName) [String]
substVars

    -- Returns (chars in the pattern if the pattern contains wildcards, (whether the pattern contains wildcards, the pattern))
    f :: LPat GhcPs -> (Set String, (Bool, LPat GhcPs))
    f :: LPat (GhcPass 'Parsed)
-> (Set String, (Bool, LPat (GhcPass 'Parsed)))
f LPat (GhcPass 'Parsed)
p
      | (Located (Pat (GhcPass 'Parsed)) -> Bool)
-> [Located (Pat (GhcPass 'Parsed))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LPat (GhcPass 'Parsed) -> Bool
Located (Pat (GhcPass 'Parsed)) -> Bool
isWildPat (Located (Pat (GhcPass 'Parsed))
-> [Located (Pat (GhcPass 'Parsed))]
forall on. Uniplate on => on -> [on]
universe LPat (GhcPass 'Parsed)
Located (Pat (GhcPass 'Parsed))
p) =
          let used :: Set String
used = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [Located RdrName -> String
rdrNameStr Located (IdP (GhcPass 'Parsed))
Located RdrName
name | (L SrcSpan
_ (VarPat XVarPat (GhcPass 'Parsed)
_ Located (IdP (GhcPass 'Parsed))
name)) <- Located (Pat (GhcPass 'Parsed))
-> [Located (Pat (GhcPass 'Parsed))]
forall on. Uniplate on => on -> [on]
universe LPat (GhcPass 'Parsed)
Located (Pat (GhcPass 'Parsed))
p]
           in (Set String
used, (Bool
True, LPat (GhcPass 'Parsed)
p))
      | Bool
otherwise = (Set String
forall a. Monoid a => a
mempty, (Bool
False, LPat (GhcPass 'Parsed)
p))

    isWildPat :: LPat GhcPs -> Bool
    isWildPat :: LPat (GhcPass 'Parsed) -> Bool
isWildPat = \case (L SrcSpan
_ (WildPat XWildPat (GhcPass 'Parsed)
_)) -> Bool
True; LPat (GhcPass 'Parsed)
_ -> Bool
False

    -- Replace the pattern with a variable pattern if the pattern doesn't contain wildcards.
    munge :: String -> (Bool, LPat GhcPs) -> LPat GhcPs
    munge :: String -> (Bool, LPat (GhcPass 'Parsed)) -> LPat (GhcPass 'Parsed)
munge String
_ (Bool
True, LPat (GhcPass 'Parsed)
p) = LPat (GhcPass 'Parsed)
p
    munge String
ident (Bool
False, L SrcSpan
ploc Pat (GhcPass 'Parsed)
_) = SrcSpan -> Pat (GhcPass 'Parsed) -> Located (Pat (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpan
ploc (XVarPat (GhcPass 'Parsed)
-> Located (IdP (GhcPass 'Parsed)) -> Pat (GhcPass 'Parsed)
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat XVarPat (GhcPass 'Parsed)
NoExtField
noExtField (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
ploc (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc String
ident))