{-# 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 GhcPs
x
    =  ((Maybe (LHsExpr GhcPs), LHsExpr GhcPs) -> [Idea])
-> [(Maybe (LHsExpr GhcPs), LHsExpr GhcPs)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea])
-> (Maybe (LHsExpr GhcPs), LHsExpr GhcPs) -> [Idea]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
lambdaExp) (LHsDecl GhcPs -> [(Maybe (LHsExpr GhcPs), LHsExpr GhcPs)]
forall a b. (Data a, Data b) => a -> [(Maybe b, b)]
universeParentBi LHsDecl GhcPs
x)
    [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ ((LHsBind GhcPs, RType) -> [Idea])
-> [(LHsBind GhcPs, RType)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((LHsBind GhcPs -> RType -> [Idea])
-> (LHsBind GhcPs, RType) -> [Idea]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LHsBind GhcPs -> RType -> [Idea]
lambdaBind) [(LHsBind GhcPs, RType)]
binds
  where
    binds :: [(LHsBind GhcPs, RType)]
binds =
        ( case LHsDecl GhcPs
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 GhcPs
_ HsBind GhcPs
bind) -> ((SrcSpan -> HsBind GhcPs -> LHsBind GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc HsBind GhcPs
bind, RType
Decl) (LHsBind GhcPs, RType)
-> [(LHsBind GhcPs, RType)] -> [(LHsBind GhcPs, RType)]
forall a. a -> [a] -> [a]
:)
            LHsDecl GhcPs
_ -> [(LHsBind GhcPs, RType)] -> [(LHsBind GhcPs, RType)]
forall a. a -> a
id
        )
            ((,RType
Bind) (LHsBind GhcPs -> (LHsBind GhcPs, RType))
-> [LHsBind GhcPs] -> [(LHsBind GhcPs, RType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsDecl GhcPs -> [LHsBind GhcPs]
forall from to. Biplate from to => from -> [to]
universeBi LHsDecl GhcPs
x)

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

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

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

lambdaBind LHsBind GhcPs
_ RType
_ = []

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

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

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

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

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

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

                 -- otherwise we should use @LambdaCase@
                 MG XMG GhcPs (LHsExpr GhcPs)
_ (L SrcSpan
_ [LMatch GhcPs (LHsExpr GhcPs)]
_) Origin
_ ->
                     [([Char] -> LHsExpr GhcPs -> LHsExpr GhcPs -> Idea
forall a. Outputable a => [Char] -> Located a -> Located a -> Idea
suggestN [Char]
"Use lambda-case" LHsExpr GhcPs
o (LHsExpr GhcPs -> Idea) -> LHsExpr GhcPs -> Idea
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> LHsExpr GhcPs
forall e. e -> Located e
noLoc (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XLamCase GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall p. XLamCase p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase NoExtField
XLamCase GhcPs
noExtField MatchGroup GhcPs (LHsExpr GhcPs)
matchGroup)
                         {ideaNote :: [Note]
ideaNote=[[Char] -> Note
RequiresExtension [Char]
"LambdaCase"]}]
        HsExpr GhcPs
_ -> []
    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 GhcPs -> LHsTupArg GhcPs
removeX (L SrcSpan
_ (Present XPresent GhcPs
_ (LHsExpr GhcPs -> Var_
forall a b. View a b => a -> b
view -> Var_ [Char]
x')))
            | [Char]
x [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
x' = HsTupArg GhcPs -> LHsTupArg GhcPs
forall e. e -> Located e
noLoc (HsTupArg GhcPs -> LHsTupArg GhcPs)
-> HsTupArg GhcPs -> LHsTupArg GhcPs
forall a b. (a -> b) -> a -> b
$ XMissing GhcPs -> HsTupArg GhcPs
forall id. XMissing id -> HsTupArg id
Missing NoExtField
XMissing GhcPs
noExtField
        removeX LHsTupArg GhcPs
y = LHsTupArg GhcPs
y
        -- | Extract the name of an argument of a tuple if it's present and a variable.
        tupArgVar :: LHsTupArg GhcPs -> Maybe String
        tupArgVar :: LHsTupArg GhcPs -> Maybe [Char]
tupArgVar (L SrcSpan
_ (Present XPresent GhcPs
_ (LHsExpr GhcPs -> Var_
forall a b. View a b => a -> b
view -> Var_ [Char]
x))) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
x
        tupArgVar LHsTupArg GhcPs
_ = Maybe [Char]
forall a. Maybe a
Nothing

lambdaExp Maybe (LHsExpr GhcPs)
_ LHsExpr GhcPs
_ = []

varBody :: LHsExpr GhcPs
varBody :: LHsExpr GhcPs
varBody = [Char] -> LHsExpr GhcPs
strToVar [Char]
"body"

-- | Squash lambdas and replace any repeated pattern variable with @_@
fromLambda :: LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
fromLambda :: LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
fromLambda (SimpleLambda [LPat GhcPs]
ps1 (LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
LHsExpr GhcPs -> ([Located (Pat GhcPs)], LHsExpr GhcPs)
fromLambda (LHsExpr GhcPs -> ([Located (Pat GhcPs)], LHsExpr GhcPs))
-> (LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs
-> ([Located (Pat GhcPs)], LHsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> LHsExpr GhcPs
fromParen -> ([Located (Pat GhcPs)]
ps2,LHsExpr GhcPs
x))) = ((Pat GhcPs -> Pat GhcPs)
-> [Located (Pat GhcPs)] -> [Located (Pat GhcPs)]
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi ([[Char]] -> Pat GhcPs -> Pat GhcPs
f ([[Char]] -> Pat GhcPs -> Pat GhcPs)
-> [[Char]] -> Pat GhcPs -> Pat GhcPs
forall a b. (a -> b) -> a -> b
$ [Located (Pat GhcPs)] -> [[Char]]
forall a. AllVars a => a -> [[Char]]
pvars [Located (Pat GhcPs)]
ps2) [LPat GhcPs]
[Located (Pat GhcPs)]
ps1 [Located (Pat GhcPs)]
-> [Located (Pat GhcPs)] -> [Located (Pat GhcPs)]
forall a. [a] -> [a] -> [a]
++ [Located (Pat GhcPs)]
ps2, LHsExpr GhcPs
x)
    where f :: [String] -> Pat GhcPs -> Pat GhcPs
          f :: [[Char]] -> Pat GhcPs -> Pat GhcPs
f [[Char]]
bad (VarPat XVarPat GhcPs
_ (Located (IdP GhcPs) -> [Char]
Located RdrName -> [Char]
rdrNameStr -> [Char]
x))
              | [Char]
x [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
bad = XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> Pat p
WildPat NoExtField
XWildPat GhcPs
noExtField
          f [[Char]]
bad Pat GhcPs
x = Pat GhcPs
x
fromLambda LHsExpr GhcPs
x = ([], LHsExpr GhcPs
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 [Char] -> [LPat GhcPs] -> ([LPat GhcPs], [[Char]])
mkOrigPats Maybe [Char]
funName [LPat GhcPs]
pats = (([Char] -> (Bool, Located (Pat GhcPs)) -> Located (Pat GhcPs))
-> [[Char]]
-> [(Bool, Located (Pat GhcPs))]
-> [Located (Pat GhcPs)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Char] -> (Bool, LPat GhcPs) -> LPat GhcPs
[Char] -> (Bool, Located (Pat GhcPs)) -> Located (Pat GhcPs)
munge [[Char]]
vars [(Bool, Located (Pat GhcPs))]
pats', [[Char]]
vars)
  where
    ([Set [Char]] -> Set [Char]
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions -> Set [Char]
used, [(Bool, Located (Pat GhcPs))]
pats') = [(Set [Char], (Bool, Located (Pat GhcPs)))]
-> ([Set [Char]], [(Bool, Located (Pat GhcPs))])
forall a b. [(a, b)] -> ([a], [b])
unzip ((Located (Pat GhcPs) -> (Set [Char], (Bool, Located (Pat GhcPs))))
-> [Located (Pat GhcPs)]
-> [(Set [Char], (Bool, Located (Pat GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map LPat GhcPs -> (Set [Char], (Bool, LPat GhcPs))
Located (Pat GhcPs) -> (Set [Char], (Bool, Located (Pat GhcPs)))
f [LPat GhcPs]
[Located (Pat GhcPs)]
pats)

    -- Remove variables that occur in the function name or patterns with wildcards
    vars :: [[Char]]
vars = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
s -> [Char]
s [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set [Char]
used Bool -> Bool -> Bool
&& [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
s Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe [Char]
funName) [[Char]]
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 GhcPs -> (Set [Char], (Bool, LPat GhcPs))
f LPat GhcPs
p
      | (Located (Pat GhcPs) -> Bool) -> [Located (Pat GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LPat GhcPs -> Bool
Located (Pat GhcPs) -> Bool
isWildPat (Located (Pat GhcPs) -> [Located (Pat GhcPs)]
forall on. Uniplate on => on -> [on]
universe LPat GhcPs
Located (Pat GhcPs)
p) =
          let used :: Set [Char]
used = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [Located RdrName -> [Char]
rdrNameStr Located (IdP GhcPs)
Located RdrName
name | (L SrcSpan
_ (VarPat XVarPat GhcPs
_ Located (IdP GhcPs)
name)) <- Located (Pat GhcPs) -> [Located (Pat GhcPs)]
forall on. Uniplate on => on -> [on]
universe LPat GhcPs
Located (Pat GhcPs)
p]
           in (Set [Char]
used, (Bool
True, LPat GhcPs
p))
      | Bool
otherwise = (Set [Char]
forall a. Monoid a => a
mempty, (Bool
False, LPat GhcPs
p))

    isWildPat :: LPat GhcPs -> Bool
    isWildPat :: LPat GhcPs -> Bool
isWildPat = \case (L _ (WildPat _)) -> Bool
True; LPat GhcPs
_ -> Bool
False

    -- Replace the pattern with a variable pattern if the pattern doesn't contain wildcards.
    munge :: String -> (Bool, LPat GhcPs) -> LPat GhcPs
    munge :: [Char] -> (Bool, LPat GhcPs) -> LPat GhcPs
munge [Char]
_ (Bool
True, LPat GhcPs
p) = LPat GhcPs
p
    munge [Char]
ident (Bool
False, L ploc _) = SrcSpan -> Pat GhcPs -> Located (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
ploc (XVarPat GhcPs -> Located (IdP GhcPs) -> Pat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExtField
XVarPat GhcPs
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
$ [Char] -> OccName
mkVarOcc [Char]
ident))