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

lambdaBind :: LHsBind GhcPs -> RType -> [Idea]
lambdaBind :: LHsBind GhcPs -> RType -> [Idea]
lambdaBind
    o :: LHsBind GhcPs
o@(L _ origBind@FunBind {fun_id = funName@(L loc1 _), fun_matches =
        MG {mg_alts =
            L _ [L _ (Match _ ctxt@(FunRhs _ Prefix _) pats (GRHSs _ [L _ (GRHS _ [] origBody@(L loc2 _))] bind))]}}) RType
rtype
    | EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_ <- HsLocalBindsLR GhcPs GhcPs
bind
    , LHsExpr GhcPs -> Bool
isLambda (LHsExpr GhcPs -> Bool) -> LHsExpr GhcPs -> Bool
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
fromParen GenLocated SrcSpanAnnA (HsExpr GhcPs)
origBody
    , [HsExpr GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> [HsExpr GhcPs]
forall from to. Biplate from to => from -> [to]
universeBi [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats :: [HsExpr GhcPs])
    = let ([GenLocated SrcSpanAnnA (Pat GhcPs)]
newPats, GenLocated SrcSpanAnnA (HsExpr GhcPs)
newBody) = LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> ([GenLocated SrcSpanAnnA (Pat GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
fromLambda (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> ([GenLocated SrcSpanAnnA (Pat GhcPs)],
     GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> ([GenLocated SrcSpanAnnA (Pat GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
lambda [LPat GhcPs]
pats (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> ([GenLocated SrcSpanAnnA (Pat GhcPs)],
     GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> ([GenLocated SrcSpanAnnA (Pat GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
origBody
          ([([Char], SrcSpan)]
sub, [Char]
tpl) = [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> ([([Char], SrcSpan)], [Char])
forall a e.
[GenLocated SrcSpanAnnA (Pat GhcPs)]
-> GenLocated (SrcSpanAnn' a) e -> ([([Char], SrcSpan)], [Char])
mkSubtsAndTpl [GenLocated SrcSpanAnnA (Pat GhcPs)]
newPats GenLocated SrcSpanAnnA (HsExpr GhcPs)
newBody
          gen :: [LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)
          gen :: [LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)
gen [LPat GhcPs]
ps = ([GenLocated SrcSpanAnnA (Pat GhcPs)]
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsDecl GhcPs))
-> ([GenLocated SrcSpanAnnA (Pat GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Located (HsDecl GhcPs)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)
[GenLocated SrcSpanAnnA (Pat GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsDecl GhcPs)
reform (([GenLocated SrcSpanAnnA (Pat GhcPs)],
  GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> Located (HsDecl GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> ([GenLocated SrcSpanAnnA (Pat GhcPs)],
        GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Located (HsDecl GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> ([GenLocated SrcSpanAnnA (Pat GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
fromLambda (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> ([GenLocated SrcSpanAnnA (Pat GhcPs)],
     GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> ([GenLocated SrcSpanAnnA (Pat GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr 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 GenLocated SrcSpanAnnA (HsExpr GhcPs)
newBody of
              -- https://github.com/alanz/ghc-exactprint/issues/97
              L SrcSpanAnnA
_ HsCase{} -> []
              GenLocated SrcSpanAnnA (HsExpr GhcPs)
_ -> [RType
-> SrcSpan -> [([Char], SrcSpan)] -> [Char] -> Refactoring SrcSpan
forall a. RType -> a -> [([Char], a)] -> [Char] -> Refactoring a
Replace RType
rtype (GenLocated SrcSpanAnnA (HsBind GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsBind GhcPs
GenLocated SrcSpanAnnA (HsBind GhcPs)
o) [([Char], SrcSpan)]
sub [Char]
tpl]
       in [[Char]
-> Located (HsBind GhcPs)
-> Located (HsDecl GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
[Char] -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn [Char]
"Redundant lambda" (GenLocated SrcSpanAnnA (HsBind GhcPs) -> Located (HsBind GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsBind GhcPs
GenLocated SrcSpanAnnA (HsBind GhcPs)
o) ([LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)
gen [LPat GhcPs]
pats LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
origBody) [Refactoring SrcSpan]
refacts]

    | let ([GenLocated SrcSpanAnnA (Pat GhcPs)]
newPats, GenLocated SrcSpanAnnA (HsExpr GhcPs)
newBody) = [LPat GhcPs] -> LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
etaReduce [LPat GhcPs]
pats LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
origBody
    , [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated SrcSpanAnnA (Pat GhcPs)]
newPats Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats, [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [[Char]]
forall a. AllVars a => a -> [[Char]]
pvars (Int
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a. Int -> [a] -> [a]
drop ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated SrcSpanAnnA (Pat GhcPs)]
newPats) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats) [[Char]] -> [[Char]] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`disjoint` HsLocalBindsLR GhcPs GhcPs -> [[Char]]
forall a. AllVars a => a -> [[Char]]
varss HsLocalBindsLR GhcPs GhcPs
bind
    = let ([([Char], SrcSpan)]
sub, [Char]
tpl) = [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> ([([Char], SrcSpan)], [Char])
forall a e.
[GenLocated SrcSpanAnnA (Pat GhcPs)]
-> GenLocated (SrcSpanAnn' a) e -> ([([Char], SrcSpan)], [Char])
mkSubtsAndTpl [GenLocated SrcSpanAnnA (Pat GhcPs)]
newPats GenLocated SrcSpanAnnA (HsExpr GhcPs)
newBody
       in [[Char]
-> Located (HsDecl GhcPs)
-> Located (HsDecl 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 -> Located (HsDecl GhcPs)
reform [LPat GhcPs]
pats LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
origBody) ([LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)
reform [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
newPats LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
newBody)
            [RType
-> SrcSpan -> [([Char], SrcSpan)] -> [Char] -> Refactoring SrcSpan
forall a. RType -> a -> [([Char], a)] -> [Char] -> Refactoring a
Replace RType
rtype (Located (HsDecl GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS (Located (HsDecl GhcPs) -> SrcSpan)
-> Located (HsDecl GhcPs) -> SrcSpan
forall a b. (a -> b) -> a -> b
$ [LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)
reform [LPat GhcPs]
pats LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
origBody) [([Char], SrcSpan)]
sub [Char]
tpl]
          ]
    where
          reform :: [LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)
          reform :: [LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)
reform [LPat GhcPs]
ps LHsExpr GhcPs
b = SrcSpan -> HsDecl GhcPs -> Located (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (SrcSpanAnn' (EpAnn NameAnn) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn NameAnn)
loc1) (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc2)) (HsDecl GhcPs -> Located (HsDecl GhcPs))
-> HsDecl GhcPs -> Located (HsDecl 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 (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> Origin
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> Origin -> MatchGroup p body
MG NoExtField
XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
noExtField ([LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> LocatedAn
     AnnList
     [LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a an. a -> LocatedAn an a
noLocA [Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a an. a -> LocatedAn an a
noLocA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall ann. EpAnn ann
EpAnnNotUsed HsMatchContext (NoGhcTc GhcPs)
ctxt [LPat GhcPs]
ps (GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBindsLR GhcPs GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnnComments
emptyComments [GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Located (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall e. e -> Located e
noLoc (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> Located (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Located (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [GuardLStmt GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall ann. EpAnn ann
EpAnnNotUsed [] LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b] (HsLocalBindsLR GhcPs GhcPs
 -> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> HsLocalBindsLR GhcPs GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 :: [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> GenLocated (SrcSpanAnn' a) e -> ([([Char], SrcSpan)], [Char])
mkSubtsAndTpl [GenLocated SrcSpanAnnA (Pat GhcPs)]
newPats GenLocated (SrcSpanAnn' a) e
newBody = ([([Char], SrcSpan)]
sub, [Char]
tpl)
            where
              ([GenLocated SrcSpanAnnA (Pat GhcPs)]
origPats, [[Char]]
vars) = Maybe [Char] -> [LPat GhcPs] -> ([LPat GhcPs], [[Char]])
mkOrigPats ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (LocatedN RdrName -> [Char]
rdrNameStr LIdP GhcPs
LocatedN RdrName
funName)) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
newPats
              sub :: [([Char], SrcSpan)]
sub = ([Char]
"body", GenLocated (SrcSpanAnn' a) e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated (SrcSpanAnn' a) e
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 ((GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA [GenLocated SrcSpanAnnA (Pat GhcPs)]
newPats)
              tpl :: [Char]
tpl = Located (HsDecl GhcPs) -> [Char]
forall a. Outputable a => a -> [Char]
unsafePrettyPrint ([LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)
reform [LPat GhcPs]
[GenLocated SrcSpanAnnA (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
     ([GenLocated SrcSpanAnnA (Pat GhcPs)],
      GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. [a] -> Maybe ([a], a)
unsnoc -> Just ([GenLocated SrcSpanAnnA (Pat GhcPs)]
ps, GenLocated SrcSpanAnnA (Pat GhcPs) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ [Char]
p)) (L _ (HsApp _ x (view -> Var_ 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` GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [[Char]]
forall a. FreeVars a => a -> [[Char]]
vars LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr GhcPs -> Bool
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isQuasiQuote ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall on. Uniplate on => on -> [on]
universe LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
    = [LPat GhcPs] -> LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
etaReduce [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
ps LHsExpr GhcPs
x
etaReduce [LPat GhcPs]
ps (L loc (OpApp _ x (isDol -> True) y)) = [LPat GhcPs] -> LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
etaReduce [LPat GhcPs]
ps (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
forall ann. EpAnn ann
EpAnnNotUsed 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 _ (HsPar _ (L _ (HsApp _ oper@(L _ (HsVar _ origf@(L _ (rdrNameOcc -> f)))) y))))
    | OccName -> Bool
isSymOcc OccName
f -- is this an operator?
    , GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall a. Brackets a => a -> Bool
isAtom LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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]
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
[Char] -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest [Char]
"Use section" (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
to) [Refactoring SrcSpan
r]]
    where
        to :: LHsExpr GhcPs
        to :: LHsExpr GhcPs
to = HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar GhcPs
forall ann. EpAnn ann
EpAnnNotUsed (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr 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 XSectionL GhcPs
forall ann. EpAnn ann
EpAnnNotUsed 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 (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o) [([Char]
"x", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y)] ([Char]
"(x " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LIdP GhcPs -> [Char]
forall a. Outputable a => a -> [Char]
unsafePrettyPrint LIdP GhcPs
origf [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")

lambdaExp Maybe (LHsExpr GhcPs)
_ o :: LHsExpr GhcPs
o@(L _ (HsPar _ (view -> App2 (view -> Var_ "flip") origf@(view -> RdrName_ f) y)))
    | [Char] -> Bool
allowRightSection (LocatedN RdrName -> [Char]
rdrNameStr LocatedN 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` LocatedN RdrName -> [Char]
rdrNameStr LocatedN RdrName
f
    = [[Char]
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
[Char] -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest [Char]
"Use section" (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
to) [Refactoring SrcSpan
r]]
    where
        to :: LHsExpr GhcPs
        to :: LHsExpr GhcPs
to = HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar GhcPs
forall ann. EpAnn ann
EpAnnNotUsed (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr 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 XSectionR GhcPs
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
origf LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y
        op :: [Char]
op = if RdrName -> Bool
isSymbolRdrName (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
f)
               then LocatedN RdrName -> [Char]
forall a. Outputable a => a -> [Char]
unsafePrettyPrint LocatedN RdrName
f
               else [Char]
"`" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LocatedN RdrName -> [Char]
forall a. Outputable a => a -> [Char]
unsafePrettyPrint LocatedN RdrName
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"`"
        var :: [Char]
var = if LocatedN RdrName -> [Char]
rdrNameStr LocatedN 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 (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o) [([Char]
var, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr 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 _ HsLam{})
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr GhcPs -> Bool
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isOpApp Maybe (LHsExpr GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsExpr 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
$ (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr GhcPs -> Bool
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isQuasiQuote ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall on. Uniplate on => on -> [on]
universe LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
from = case Maybe (LHsExpr GhcPs)
p of
              -- Avoid creating redundant bracket.
              Just p :: LHsExpr GhcPs
p@(L _ (HsPar _ (L _ HsLam{})))
                | L _ HsPar{} <- LHsExpr GhcPs
res -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
p
                | L _ (HsVar _ (L _ name)) <- LHsExpr GhcPs
res, Bool -> Bool
not (RdrName -> Bool
isSymbolRdrName RdrName
name) -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
p
              Maybe (LHsExpr GhcPs)
_ -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o
    = [(if LHsExpr GhcPs -> Bool
isVar LHsExpr GhcPs
res then [Char]
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
[Char] -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn else [Char]
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
[Char] -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest) [Char]
name (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
from) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
res) (SrcSpan -> [Refactoring SrcSpan]
refact (SrcSpan -> [Refactoring SrcSpan])
-> SrcSpan -> [Refactoring SrcSpan]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr 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 SrcSpanAnnA
_ (SectionR XSectionR GhcPs
_ (LHsExpr GhcPs -> Var_
forall a b. View a b => a -> b
view -> Var_ [Char]
_) LHsExpr GhcPs
_) <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall on. Uniplate on => on -> [on]
universe LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x]

lambdaExp Maybe (LHsExpr GhcPs)
p o :: LHsExpr GhcPs
o@(SimpleLambda origPats origBody)
    | LHsExpr GhcPs -> Bool
isLambda (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
fromParen GenLocated SrcSpanAnnA (HsExpr GhcPs)
origBody)
    , [HsExpr GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> [HsExpr GhcPs]
forall from to. Biplate from to => from -> [to]
universeBi [GenLocated SrcSpanAnnA (Pat GhcPs)]
origPats :: [HsExpr GhcPs]) -- TODO: I think this checks for view patterns only, so maybe be more explicit about that?
    , Bool
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not (Bool -> Bool)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> Bool
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isLambda) Maybe (LHsExpr GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
p =
    [[Char]
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
[Char] -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest [Char]
"Collapse lambdas" (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc ([LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
lambda [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
body)) [RType
-> SrcSpan -> [([Char], SrcSpan)] -> [Char] -> Refactoring SrcSpan
forall a. RType -> a -> [([Char], a)] -> [Char] -> Refactoring a
Replace RType
Expr (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o) [([Char], SrcSpan)]
subts [Char]
template]]
    where
      ([GenLocated SrcSpanAnnA (Pat GhcPs)]
pats, GenLocated SrcSpanAnnA (HsExpr GhcPs)
body) = LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
fromLambda LHsExpr GhcPs
o
      ([GenLocated SrcSpanAnnA (Pat GhcPs)]
oPats, [[Char]]
vars) = Maybe [Char] -> [LPat GhcPs] -> ([LPat GhcPs], [[Char]])
mkOrigPats Maybe [Char]
forall a. Maybe a
Nothing [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
      subts :: [([Char], SrcSpan)]
subts = ([Char]
"body", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr 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 ((GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA [GenLocated SrcSpanAnnA (Pat GhcPs)]
pats)
      template :: [Char]
template = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Char]
forall a. Outputable a => a -> [Char]
unsafePrettyPrint ([LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
lambda [LPat GhcPs]
[GenLocated SrcSpanAnnA (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 [view -> PVar_ x] (L _ expr)) =
    case HsExpr GhcPs
expr of
        -- suggest TupleSections instead of lambdas
        ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
args Boxity
boxity
            -- is there exactly one argument that is exactly x?
            | ([HsTupArg GhcPs
_x], [HsTupArg GhcPs]
ys) <- (HsTupArg GhcPs -> Bool)
-> [HsTupArg GhcPs] -> ([HsTupArg GhcPs], [HsTupArg 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)
-> (HsTupArg GhcPs -> Maybe [Char]) -> HsTupArg GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsTupArg GhcPs -> Maybe [Char]
tupArgVar) [HsTupArg 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
$ [HsTupArg GhcPs] -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars [HsTupArg GhcPs]
ys
            -> [([Char] -> Located (HsExpr GhcPs) -> Located (HsExpr GhcPs) -> Idea
forall a. Outputable a => [Char] -> Located a -> Located a -> Idea
suggestN [Char]
"Use tuple-section" (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o) (Located (HsExpr GhcPs) -> Idea) -> Located (HsExpr GhcPs) -> Idea
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> Located (HsExpr GhcPs)
forall e. e -> Located e
noLoc (HsExpr GhcPs -> Located (HsExpr GhcPs))
-> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XExplicitTuple GhcPs -> [HsTupArg GhcPs] -> Boxity -> HsExpr GhcPs
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple GhcPs
forall ann. EpAnn ann
EpAnnNotUsed ((HsTupArg GhcPs -> HsTupArg GhcPs)
-> [HsTupArg GhcPs] -> [HsTupArg GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map HsTupArg GhcPs -> HsTupArg GhcPs
removeX [HsTupArg 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 (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Vars
forall a. AllVars a => a -> Vars
allVars MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 _ [L _ oldmatch]) Origin
_)
                   | (Located (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Bool)
-> [Located (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(L SrcSpan
_ (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [GuardLStmt GhcPs]
stmts GenLocated SrcSpanAnnA (HsExpr GhcPs)
_)) -> [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GuardLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts) (GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body. Match p body -> GRHSs p body
m_grhss Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
oldmatch)) ->
                     let patLocs :: [SrcSpan]
patLocs = (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (SrcSpanAnnA -> SrcSpan)
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpanAnnA)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc) (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> [LPat GhcPs]
forall p body. Match p body -> [LPat p]
m_pats Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
oldmatch)
                         bodyLocs :: [SrcSpan]
bodyLocs = (Located (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> [SrcSpan])
-> [Located (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [SrcSpan]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\case L SrcSpan
_ (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [GuardLStmt GhcPs]
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
body) -> [SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
body)])
                                        ([Located (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [SrcSpan])
-> [Located (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body. Match p body -> GRHSs p body
m_grhss Match GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 = (GenLocated SrcSpanAnnA (Pat GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (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)
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc) (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> [LPat GhcPs]
forall p body. Match p body -> [LPat p]
m_pats Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
oldmatch)
                      in [ [Char]
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
[Char] -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest [Char]
"Use lambda" (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o)
                             ( HsExpr GhcPs -> Located (HsExpr GhcPs)
forall e. e -> Located e
noLoc (HsExpr GhcPs -> Located (HsExpr GhcPs))
-> HsExpr GhcPs -> Located (HsExpr 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)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
oldMG
                                 { mg_alts :: XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
mg_alts = [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> LocatedAn
     AnnList
     [LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a an. a -> LocatedAn an a
noLocA
                                     [ Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a an. a -> LocatedAn an a
noLocA Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
oldmatch
                                         { m_pats :: [LPat GhcPs]
m_pats = (GenLocated SrcSpanAnnA (Pat GhcPs)
 -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
forall (p :: Pass).
IsPass p =>
LPat (GhcPass p) -> LPat (GhcPass p)
mkParPat ([GenLocated SrcSpanAnnA (Pat GhcPs)]
 -> [GenLocated SrcSpanAnnA (Pat GhcPs)])
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a b. (a -> b) -> a -> b
$ Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> [LPat GhcPs]
forall p body. Match p body -> [LPat p]
m_pats Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
oldmatch
                                         , m_ctxt :: HsMatchContext (NoGhcTc GhcPs)
m_ctxt = HsMatchContext (NoGhcTc GhcPs)
forall p. HsMatchContext p
LambdaExpr
                                         }
                                     ]
                                 }
                               :: Located (HsExpr GhcPs)
                             )
                             [Refactoring SrcSpan]
r
                         ]

                 -- otherwise we should use @LambdaCase@
                 MG XMG GhcPs (LHsExpr GhcPs)
_ (L _ _) Origin
_ ->
                     [([Char] -> Located (HsExpr GhcPs) -> Located (HsExpr GhcPs) -> Idea
forall a. Outputable a => [Char] -> Located a -> Located a -> Idea
suggestN [Char]
"Use lambda-case" (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o) (Located (HsExpr GhcPs) -> Idea) -> Located (HsExpr GhcPs) -> Idea
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> Located (HsExpr GhcPs)
forall e. e -> Located e
noLoc (HsExpr GhcPs -> Located (HsExpr GhcPs))
-> HsExpr GhcPs -> Located (HsExpr 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 XLamCase GhcPs
forall ann. EpAnn ann
EpAnnNotUsed 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 :: HsTupArg GhcPs -> HsTupArg GhcPs
        removeX :: HsTupArg GhcPs -> HsTupArg GhcPs
removeX (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' = XMissing GhcPs -> HsTupArg GhcPs
forall id. XMissing id -> HsTupArg id
Missing XMissing GhcPs
forall ann. EpAnn ann
EpAnnNotUsed
        removeX HsTupArg GhcPs
y = HsTupArg GhcPs
y
        -- | Extract the name of an argument of a tuple if it's present and a variable.
        tupArgVar :: HsTupArg GhcPs -> Maybe String
        tupArgVar :: HsTupArg GhcPs -> Maybe [Char]
tupArgVar (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 HsTupArg 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 ps1 (fromLambda . fromParen -> (ps2,x))) = ((Pat GhcPs -> Pat GhcPs)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (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
$ [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [[Char]]
forall a. AllVars a => a -> [[Char]]
pvars [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps2) [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps1 [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps2, LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)
    where f :: [String] -> Pat GhcPs -> Pat GhcPs
          f :: [[Char]] -> Pat GhcPs -> Pat GhcPs
f [[Char]]
bad (VarPat XVarPat GhcPs
_ (LIdP GhcPs -> [Char]
LocatedN 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, GenLocated SrcSpanAnnA (Pat GhcPs))
 -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> [[Char]]
-> [(Bool, GenLocated SrcSpanAnnA (Pat GhcPs))]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Char] -> (Bool, LPat GhcPs) -> LPat GhcPs
[Char]
-> (Bool, GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated SrcSpanAnnA (Pat GhcPs)
munge [[Char]]
vars [(Bool, GenLocated SrcSpanAnnA (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, GenLocated SrcSpanAnnA (Pat GhcPs))]
pats') = [(Set [Char], (Bool, GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> ([Set [Char]], [(Bool, GenLocated SrcSpanAnnA (Pat GhcPs))])
forall a b. [(a, b)] -> ([a], [b])
unzip ((GenLocated SrcSpanAnnA (Pat GhcPs)
 -> (Set [Char], (Bool, GenLocated SrcSpanAnnA (Pat GhcPs))))
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [(Set [Char], (Bool, GenLocated SrcSpanAnnA (Pat GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map LPat GhcPs -> (Set [Char], (Bool, LPat GhcPs))
GenLocated SrcSpanAnnA (Pat GhcPs)
-> (Set [Char], (Bool, GenLocated SrcSpanAnnA (Pat GhcPs)))
f [LPat GhcPs]
[GenLocated SrcSpanAnnA (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
      | (GenLocated SrcSpanAnnA (Pat GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LPat GhcPs -> Bool
GenLocated SrcSpanAnnA (Pat GhcPs) -> Bool
isWildPat (GenLocated SrcSpanAnnA (Pat GhcPs)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall on. Uniplate on => on -> [on]
universe LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p) =
          let used :: Set [Char]
used = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [LocatedN RdrName -> [Char]
rdrNameStr LIdP GhcPs
LocatedN RdrName
name | (L SrcSpanAnnA
_ (VarPat XVarPat GhcPs
_ LIdP GhcPs
name)) <- GenLocated SrcSpanAnnA (Pat GhcPs)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall on. Uniplate on => on -> [on]
universe LPat GhcPs
GenLocated SrcSpanAnnA (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 _) = SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ploc (XVarPat GhcPs -> LIdP GhcPs -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
VarPat NoExtField
XVarPat GhcPs
noExtField (RdrName -> LocatedN RdrName
forall a an. a -> LocatedAn an a
noLocA (RdrName -> LocatedN RdrName) -> RdrName -> LocatedN 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))