{-# LANGUAGE LambdaCase, PatternGuards, TupleSections, ViewPatterns #-}
module Hint.Lambda(lambdaHint) where
import Hint.Type (DeclHint, Idea, Note(RequiresExtension), suggest, warn, toSS, suggestN, ideaNote, substVars, toRefactSrcSpan)
import Util
import Data.List.Extra
import Data.Set (Set)
import qualified Data.Set as Set
import Refact.Types hiding (Match)
import Data.Generics.Uniplate.DataOnly (universe, universeBi, transformBi)
import GHC.Types.Basic
import GHC.Hs
import GHC.Types.Name.Occurrence
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr (isTypeApp, isOpApp, isLambda, isQuasiQuote, isVar, isDol, strToVar)
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
import GHC.Util.Brackets (isAtom)
import GHC.Util.FreeVars (free, allVars, freeVars, pvars, vars, varss)
import GHC.Util.HsExpr (allowLeftSection, allowRightSection, niceLambdaR, lambda)
import GHC.Util.View
lambdaHint :: DeclHint
lambdaHint :: DeclHint
lambdaHint Scope
_ ModuleEx
_ LHsDecl (GhcPass 'Parsed)
x
= ((Maybe (LHsExpr (GhcPass 'Parsed)), LHsExpr (GhcPass 'Parsed))
-> [Idea])
-> [(Maybe (LHsExpr (GhcPass 'Parsed)), LHsExpr (GhcPass 'Parsed))]
-> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Maybe (LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> [Idea])
-> (Maybe (LHsExpr (GhcPass 'Parsed)), LHsExpr (GhcPass 'Parsed))
-> [Idea]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe (LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> [Idea]
lambdaExp) (LHsDecl (GhcPass 'Parsed)
-> [(Maybe (LHsExpr (GhcPass 'Parsed)), LHsExpr (GhcPass 'Parsed))]
forall a b. (Data a, Data b) => a -> [(Maybe b, b)]
universeParentBi LHsDecl (GhcPass 'Parsed)
x)
[Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ ((LHsBind (GhcPass 'Parsed), RType) -> [Idea])
-> [(LHsBind (GhcPass 'Parsed), RType)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((LHsBind (GhcPass 'Parsed) -> RType -> [Idea])
-> (LHsBind (GhcPass 'Parsed), RType) -> [Idea]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LHsBind (GhcPass 'Parsed) -> RType -> [Idea]
lambdaBind) [(LHsBind (GhcPass 'Parsed), RType)]
binds
where
binds :: [(LHsBind (GhcPass 'Parsed), RType)]
binds =
( case LHsDecl (GhcPass 'Parsed)
x of
L SrcSpan
loc (ValD XValD (GhcPass 'Parsed)
_ HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
bind) -> ((SrcSpan
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
bind, RType
Decl) (LHsBind (GhcPass 'Parsed), RType)
-> [(LHsBind (GhcPass 'Parsed), RType)]
-> [(LHsBind (GhcPass 'Parsed), RType)]
forall a. a -> [a] -> [a]
:)
LHsDecl (GhcPass 'Parsed)
_ -> [(LHsBind (GhcPass 'Parsed), RType)]
-> [(LHsBind (GhcPass 'Parsed), RType)]
forall a. a -> a
id
)
((,RType
Bind) (LHsBind (GhcPass 'Parsed) -> (LHsBind (GhcPass 'Parsed), RType))
-> [LHsBind (GhcPass 'Parsed)]
-> [(LHsBind (GhcPass 'Parsed), RType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsDecl (GhcPass 'Parsed) -> [LHsBind (GhcPass 'Parsed)]
forall from to. Biplate from to => from -> [to]
universeBi LHsDecl (GhcPass 'Parsed)
x)
lambdaBind :: LHsBind GhcPs -> RType -> [Idea]
lambdaBind :: LHsBind (GhcPass 'Parsed) -> RType -> [Idea]
lambdaBind
o :: LHsBind (GhcPass 'Parsed)
o@(L SrcSpan
_ origBind :: HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
origBind@FunBind {fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id = funName :: Located (IdP (GhcPass 'Parsed))
funName@(L SrcSpan
loc1 IdP (GhcPass 'Parsed)
_), fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches =
MG {mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts =
L SrcSpan
_ [L SrcSpan
_ (Match XCMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ ctxt :: HsMatchContext (NoGhcTc (GhcPass 'Parsed))
ctxt@(FunRhs LIdP (NoGhcTc (GhcPass 'Parsed))
_ LexicalFixity
Prefix SrcStrictness
_) [LPat (GhcPass 'Parsed)]
pats (GRHSs XCGRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ [L SrcSpan
_ (GRHS XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ [] origBody :: LHsExpr (GhcPass 'Parsed)
origBody@(L SrcSpan
loc2 HsExpr (GhcPass 'Parsed)
_))] LHsLocalBinds (GhcPass 'Parsed)
bind))]}}) RType
rtype
| L SrcSpan
_ (EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
_) <- LHsLocalBinds (GhcPass 'Parsed)
bind
, LHsExpr (GhcPass 'Parsed) -> Bool
isLambda (LHsExpr (GhcPass 'Parsed) -> Bool)
-> LHsExpr (GhcPass 'Parsed) -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
fromParen LHsExpr (GhcPass 'Parsed)
origBody
, [HsExpr (GhcPass 'Parsed)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Located (Pat (GhcPass 'Parsed))] -> [HsExpr (GhcPass 'Parsed)]
forall from to. Biplate from to => from -> [to]
universeBi [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
pats :: [HsExpr GhcPs])
= let ([Located (Pat (GhcPass 'Parsed))]
newPats, LHsExpr (GhcPass 'Parsed)
newBody) = LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
fromLambda (LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed)))
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
lambda [LPat (GhcPass 'Parsed)]
pats (LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
origBody
([(String, SrcSpan)]
sub, String
tpl) = [Located (Pat (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed) -> ([(String, SrcSpan)], String)
forall {a}.
[Located (Pat (GhcPass 'Parsed))]
-> Located a -> ([(String, SrcSpan)], String)
mkSubtsAndTpl [Located (Pat (GhcPass 'Parsed))]
newPats LHsExpr (GhcPass 'Parsed)
newBody
gen :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsDecl GhcPs
gen :: [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
gen [LPat (GhcPass 'Parsed)]
ps = ([Located (Pat (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed))
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
-> LHsDecl (GhcPass 'Parsed)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
[Located (Pat (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
reform (([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
-> LHsDecl (GhcPass 'Parsed))
-> (LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> LHsDecl (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
fromLambda (LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed)))
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
lambda [LPat (GhcPass 'Parsed)]
ps
refacts :: [Refactoring SrcSpan]
refacts = case LHsExpr (GhcPass 'Parsed)
newBody of
L SrcSpan
_ HsCase{} -> []
LHsExpr (GhcPass 'Parsed)
_ -> [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
rtype (LHsBind (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsBind (GhcPass 'Parsed)
o) [(String, SrcSpan)]
sub String
tpl]
in [String
-> LHsBind (GhcPass 'Parsed)
-> LHsDecl (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant lambda" LHsBind (GhcPass 'Parsed)
o ([LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
gen [LPat (GhcPass 'Parsed)]
pats LHsExpr (GhcPass 'Parsed)
origBody) [Refactoring SrcSpan]
refacts]
| let ([Located (Pat (GhcPass 'Parsed))]
newPats, LHsExpr (GhcPass 'Parsed)
newBody) = [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
etaReduce [LPat (GhcPass 'Parsed)]
pats LHsExpr (GhcPass 'Parsed)
origBody
, [Located (Pat (GhcPass 'Parsed))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Located (Pat (GhcPass 'Parsed))]
newPats Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Located (Pat (GhcPass 'Parsed))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
pats, [Located (Pat (GhcPass 'Parsed))] -> [String]
forall a. AllVars a => a -> [String]
pvars (Int
-> [Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))]
forall a. Int -> [a] -> [a]
drop ([Located (Pat (GhcPass 'Parsed))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Located (Pat (GhcPass 'Parsed))]
newPats) [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
pats) [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`disjoint` LHsLocalBinds (GhcPass 'Parsed) -> [String]
forall a. AllVars a => a -> [String]
varss LHsLocalBinds (GhcPass 'Parsed)
bind
= let ([(String, SrcSpan)]
sub, String
tpl) = [Located (Pat (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed) -> ([(String, SrcSpan)], String)
forall {a}.
[Located (Pat (GhcPass 'Parsed))]
-> Located a -> ([(String, SrcSpan)], String)
mkSubtsAndTpl [Located (Pat (GhcPass 'Parsed))]
newPats LHsExpr (GhcPass 'Parsed)
newBody
in [String
-> LHsDecl (GhcPass 'Parsed)
-> LHsDecl (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Eta reduce" ([LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
reform [LPat (GhcPass 'Parsed)]
pats LHsExpr (GhcPass 'Parsed)
origBody) ([LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
reform [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
newPats LHsExpr (GhcPass 'Parsed)
newBody)
[RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
rtype (LHsDecl (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS (LHsDecl (GhcPass 'Parsed) -> SrcSpan)
-> LHsDecl (GhcPass 'Parsed) -> SrcSpan
forall a b. (a -> b) -> a -> b
$ [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
reform [LPat (GhcPass 'Parsed)]
pats LHsExpr (GhcPass 'Parsed)
origBody) [(String, SrcSpan)]
sub String
tpl]
]
where reform :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsDecl GhcPs
reform :: [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
reform [LPat (GhcPass 'Parsed)]
ps LHsExpr (GhcPass 'Parsed)
b = SrcSpan -> HsDecl (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
loc1 SrcSpan
loc2) (HsDecl (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed))
-> HsDecl (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XValD (GhcPass 'Parsed)
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsDecl (GhcPass 'Parsed)
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD (GhcPass 'Parsed)
NoExtField
noExtField (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsDecl (GhcPass 'Parsed))
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
origBind
{fun_matches :: MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
fun_matches = XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> GenLocated
SrcSpan [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> Origin
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body.
XMG p body
-> Located [LMatch p body] -> Origin -> MatchGroup p body
MG XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField ([LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> GenLocated
SrcSpan [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
forall e. e -> Located e
noLoc [Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall e. e -> Located e
noLoc (Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XCMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> HsMatchContext (NoGhcTc (GhcPass 'Parsed))
-> [LPat (GhcPass 'Parsed)]
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField HsMatchContext (NoGhcTc (GhcPass 'Parsed))
ctxt [LPat (GhcPass 'Parsed)]
ps (GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XCGRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsLocalBinds (GhcPass 'Parsed)
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField [GRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall e. e -> Located e
noLoc (GRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> GRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [GuardLStmt (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> GRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField [] LHsExpr (GhcPass 'Parsed)
b] (LHsLocalBinds (GhcPass 'Parsed)
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> LHsLocalBinds (GhcPass 'Parsed)
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ HsLocalBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> LHsLocalBinds (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsLocalBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> LHsLocalBinds (GhcPass 'Parsed))
-> HsLocalBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> LHsLocalBinds (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsLocalBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
NoExtField
noExtField]) Origin
Generated}
mkSubtsAndTpl :: [Located (Pat (GhcPass 'Parsed))]
-> Located a -> ([(String, SrcSpan)], String)
mkSubtsAndTpl [Located (Pat (GhcPass 'Parsed))]
newPats Located a
newBody = ([(String, SrcSpan)]
sub, String
tpl)
where
([Located (Pat (GhcPass 'Parsed))]
origPats, [String]
vars) = Maybe String
-> [LPat (GhcPass 'Parsed)] -> ([LPat (GhcPass 'Parsed)], [String])
mkOrigPats (String -> Maybe String
forall a. a -> Maybe a
Just (Located RdrName -> String
rdrNameStr Located (IdP (GhcPass 'Parsed))
Located RdrName
funName)) [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
newPats
sub :: [(String, SrcSpan)]
sub = (String
"body", Located a -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located a
newBody) (String, SrcSpan) -> [(String, SrcSpan)] -> [(String, SrcSpan)]
forall a. a -> [a] -> [a]
: [String] -> [SrcSpan] -> [(String, SrcSpan)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
vars ((Located (Pat (GhcPass 'Parsed)) -> SrcSpan)
-> [Located (Pat (GhcPass 'Parsed))] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat (GhcPass 'Parsed)) -> SrcSpan
forall a. Located a -> SrcSpan
toSS [Located (Pat (GhcPass 'Parsed))]
newPats)
tpl :: String
tpl = LHsDecl (GhcPass 'Parsed) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint ([LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
reform [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
origPats LHsExpr (GhcPass 'Parsed)
varBody)
lambdaBind LHsBind (GhcPass 'Parsed)
_ RType
_ = []
etaReduce :: [LPat GhcPs] -> LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
etaReduce :: [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
etaReduce ([LPat (GhcPass 'Parsed)]
-> Maybe
([Located (Pat (GhcPass 'Parsed))],
Located (Pat (GhcPass 'Parsed)))
forall a. [a] -> Maybe ([a], a)
unsnoc -> Just ([Located (Pat (GhcPass 'Parsed))]
ps, Located (Pat (GhcPass 'Parsed)) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
p)) (L SrcSpan
_ (HsApp XApp (GhcPass 'Parsed)
_ LHsExpr (GhcPass 'Parsed)
x (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
y)))
| String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y
, String
y String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` LHsExpr (GhcPass 'Parsed) -> [String]
forall a. FreeVars a => a -> [String]
vars LHsExpr (GhcPass 'Parsed)
x
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (LHsExpr (GhcPass 'Parsed) -> Bool)
-> [LHsExpr (GhcPass 'Parsed)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr (GhcPass 'Parsed) -> Bool
isQuasiQuote ([LHsExpr (GhcPass 'Parsed)] -> Bool)
-> [LHsExpr (GhcPass 'Parsed)] -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
forall on. Uniplate on => on -> [on]
universe LHsExpr (GhcPass 'Parsed)
x
= [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
etaReduce [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
ps LHsExpr (GhcPass 'Parsed)
x
etaReduce [LPat (GhcPass 'Parsed)]
ps (L SrcSpan
loc (OpApp XOpApp (GhcPass 'Parsed)
_ LHsExpr (GhcPass 'Parsed)
x (LHsExpr (GhcPass 'Parsed) -> Bool
isDol -> Bool
True) LHsExpr (GhcPass 'Parsed)
y)) = [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
etaReduce [LPat (GhcPass 'Parsed)]
ps (SrcSpan -> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XApp (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp (GhcPass 'Parsed)
NoExtField
noExtField LHsExpr (GhcPass 'Parsed)
x LHsExpr (GhcPass 'Parsed)
y))
etaReduce [LPat (GhcPass 'Parsed)]
ps LHsExpr (GhcPass 'Parsed)
x = ([LPat (GhcPass 'Parsed)]
ps, LHsExpr (GhcPass 'Parsed)
x)
lambdaExp :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
lambdaExp :: Maybe (LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> [Idea]
lambdaExp Maybe (LHsExpr (GhcPass 'Parsed))
_ o :: LHsExpr (GhcPass 'Parsed)
o@(L SrcSpan
_ (HsPar XPar (GhcPass 'Parsed)
_ (L SrcSpan
_ (HsApp XApp (GhcPass 'Parsed)
_ oper :: LHsExpr (GhcPass 'Parsed)
oper@(L SrcSpan
_ (HsVar XVar (GhcPass 'Parsed)
_ origf :: Located (IdP (GhcPass 'Parsed))
origf@(L SrcSpan
_ (IdP (GhcPass 'Parsed) -> OccName
RdrName -> OccName
rdrNameOcc -> OccName
f)))) LHsExpr (GhcPass 'Parsed)
y))))
| OccName -> Bool
isSymOcc OccName
f
, LHsExpr (GhcPass 'Parsed) -> Bool
forall a. Brackets a => a -> Bool
isAtom LHsExpr (GhcPass 'Parsed)
y
, String -> Bool
allowLeftSection (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString OccName
f
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> Bool
isTypeApp LHsExpr (GhcPass 'Parsed)
y
= [String
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use section" LHsExpr (GhcPass 'Parsed)
o LHsExpr (GhcPass 'Parsed)
to [Refactoring SrcSpan
r]]
where
to :: LHsExpr GhcPs
to :: LHsExpr (GhcPass 'Parsed)
to = HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XPar (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar (GhcPass 'Parsed)
NoExtField
noExtField (LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XSectionL (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XSectionL p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionL XSectionL (GhcPass 'Parsed)
NoExtField
noExtField LHsExpr (GhcPass 'Parsed)
y LHsExpr (GhcPass 'Parsed)
oper
r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
o) [(String
"x", LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
y)] (String
"(x " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Located RdrName -> String
forall a. Outputable a => a -> String
unsafePrettyPrint Located (IdP (GhcPass 'Parsed))
Located RdrName
origf String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
lambdaExp Maybe (LHsExpr (GhcPass 'Parsed))
_ o :: LHsExpr (GhcPass 'Parsed)
o@(L SrcSpan
_ (HsPar XPar (GhcPass 'Parsed)
_ (LHsExpr (GhcPass 'Parsed) -> App2
forall a b. View a b => a -> b
view -> App2 (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
"flip") origf :: LHsExpr (GhcPass 'Parsed)
origf@(LHsExpr (GhcPass 'Parsed) -> RdrName_
forall a b. View a b => a -> b
view -> RdrName_ Located RdrName
f) LHsExpr (GhcPass 'Parsed)
y)))
| String -> Bool
allowRightSection (Located RdrName -> String
rdrNameStr Located RdrName
f), Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Located RdrName -> String
rdrNameStr Located RdrName
f
= [String
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use section" LHsExpr (GhcPass 'Parsed)
o LHsExpr (GhcPass 'Parsed)
to [Refactoring SrcSpan
r]]
where
to :: LHsExpr GhcPs
to :: LHsExpr (GhcPass 'Parsed)
to = HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XPar (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar (GhcPass 'Parsed)
NoExtField
noExtField (LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XSectionR (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR XSectionR (GhcPass 'Parsed)
NoExtField
noExtField LHsExpr (GhcPass 'Parsed)
origf LHsExpr (GhcPass 'Parsed)
y
op :: String
op = if RdrName -> Bool
isSymbolRdrName (Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc Located RdrName
f)
then Located RdrName -> String
forall a. Outputable a => a -> String
unsafePrettyPrint Located RdrName
f
else String
"`" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Located RdrName -> String
forall a. Outputable a => a -> String
unsafePrettyPrint Located RdrName
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"`"
var :: String
var = if Located RdrName -> String
rdrNameStr Located RdrName
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x" then String
"y" else String
"x"
r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
o) [(String
var, LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
y)] (String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
lambdaExp Maybe (LHsExpr (GhcPass 'Parsed))
p o :: LHsExpr (GhcPass 'Parsed)
o@(L SrcSpan
_ HsLam{})
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (LHsExpr (GhcPass 'Parsed) -> Bool)
-> Maybe (LHsExpr (GhcPass 'Parsed)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr (GhcPass 'Parsed) -> Bool
isOpApp Maybe (LHsExpr (GhcPass 'Parsed))
p
, (LHsExpr (GhcPass 'Parsed)
res, SrcSpan -> [Refactoring SrcSpan]
refact) <- [String]
-> LHsExpr (GhcPass 'Parsed)
-> (LHsExpr (GhcPass 'Parsed), SrcSpan -> [Refactoring SrcSpan])
niceLambdaR [] LHsExpr (GhcPass 'Parsed)
o
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> Bool
isLambda LHsExpr (GhcPass 'Parsed)
res
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (LHsExpr (GhcPass 'Parsed) -> Bool)
-> [LHsExpr (GhcPass 'Parsed)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LHsExpr (GhcPass 'Parsed) -> Bool
isQuasiQuote ([LHsExpr (GhcPass 'Parsed)] -> Bool)
-> [LHsExpr (GhcPass 'Parsed)] -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
forall on. Uniplate on => on -> [on]
universe LHsExpr (GhcPass 'Parsed)
res
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
"runST" String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` (OccName -> String) -> Set OccName -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map OccName -> String
occNameString (LHsExpr (GhcPass 'Parsed) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr (GhcPass 'Parsed)
o)
, let name :: String
name = String
"Avoid lambda" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if LHsExpr (GhcPass 'Parsed) -> Int
countRightSections LHsExpr (GhcPass 'Parsed)
res Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> LHsExpr (GhcPass 'Parsed) -> Int
countRightSections LHsExpr (GhcPass 'Parsed)
o then String
" using `infix`" else String
"")
, let from :: LHsExpr (GhcPass 'Parsed)
from = case Maybe (LHsExpr (GhcPass 'Parsed))
p of
Just p :: LHsExpr (GhcPass 'Parsed)
p@(L SrcSpan
_ (HsPar XPar (GhcPass 'Parsed)
_ (L SrcSpan
_ HsLam{})))
| L SrcSpan
_ HsPar{} <- LHsExpr (GhcPass 'Parsed)
res -> LHsExpr (GhcPass 'Parsed)
p
| L SrcSpan
_ (HsVar XVar (GhcPass 'Parsed)
_ (L SrcSpan
_ IdP (GhcPass 'Parsed)
name)) <- LHsExpr (GhcPass 'Parsed)
res, Bool -> Bool
not (RdrName -> Bool
isSymbolRdrName IdP (GhcPass 'Parsed)
RdrName
name) -> LHsExpr (GhcPass 'Parsed)
p
Maybe (LHsExpr (GhcPass 'Parsed))
_ -> LHsExpr (GhcPass 'Parsed)
o
= [(if LHsExpr (GhcPass 'Parsed) -> Bool
isVar LHsExpr (GhcPass 'Parsed)
res then String
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn else String
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest) String
name LHsExpr (GhcPass 'Parsed)
from LHsExpr (GhcPass 'Parsed)
res (SrcSpan -> [Refactoring SrcSpan]
refact (SrcSpan -> [Refactoring SrcSpan])
-> SrcSpan -> [Refactoring SrcSpan]
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
from)]
where
countRightSections :: LHsExpr GhcPs -> Int
countRightSections :: LHsExpr (GhcPass 'Parsed) -> Int
countRightSections LHsExpr (GhcPass 'Parsed)
x = [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | L SrcSpan
_ (SectionR XSectionR (GhcPass 'Parsed)
_ (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
_) LHsExpr (GhcPass 'Parsed)
_) <- LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
forall on. Uniplate on => on -> [on]
universe LHsExpr (GhcPass 'Parsed)
x]
lambdaExp Maybe (LHsExpr (GhcPass 'Parsed))
p o :: LHsExpr (GhcPass 'Parsed)
o@(SimpleLambda [LPat (GhcPass 'Parsed)]
origPats LHsExpr (GhcPass 'Parsed)
origBody)
| LHsExpr (GhcPass 'Parsed) -> Bool
isLambda (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
fromParen LHsExpr (GhcPass 'Parsed)
origBody)
, [HsExpr (GhcPass 'Parsed)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Located (Pat (GhcPass 'Parsed))] -> [HsExpr (GhcPass 'Parsed)]
forall from to. Biplate from to => from -> [to]
universeBi [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
origPats :: [HsExpr GhcPs])
, Bool
-> (LHsExpr (GhcPass 'Parsed) -> Bool)
-> Maybe (LHsExpr (GhcPass 'Parsed))
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not (Bool -> Bool)
-> (LHsExpr (GhcPass 'Parsed) -> Bool)
-> LHsExpr (GhcPass 'Parsed)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr (GhcPass 'Parsed) -> Bool
isLambda) Maybe (LHsExpr (GhcPass 'Parsed))
p =
[String
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Collapse lambdas" LHsExpr (GhcPass 'Parsed)
o ([LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
lambda [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
pats LHsExpr (GhcPass 'Parsed)
body) [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
o) [(String, SrcSpan)]
subts String
template]]
where
([Located (Pat (GhcPass 'Parsed))]
pats, LHsExpr (GhcPass 'Parsed)
body) = LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
fromLambda LHsExpr (GhcPass 'Parsed)
o
([Located (Pat (GhcPass 'Parsed))]
oPats, [String]
vars) = Maybe String
-> [LPat (GhcPass 'Parsed)] -> ([LPat (GhcPass 'Parsed)], [String])
mkOrigPats Maybe String
forall a. Maybe a
Nothing [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
pats
subts :: [(String, SrcSpan)]
subts = (String
"body", LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
body) (String, SrcSpan) -> [(String, SrcSpan)] -> [(String, SrcSpan)]
forall a. a -> [a] -> [a]
: [String] -> [SrcSpan] -> [(String, SrcSpan)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
vars ((Located (Pat (GhcPass 'Parsed)) -> SrcSpan)
-> [Located (Pat (GhcPass 'Parsed))] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat (GhcPass 'Parsed)) -> SrcSpan
forall a. Located a -> SrcSpan
toSS [Located (Pat (GhcPass 'Parsed))]
pats)
template :: String
template = LHsExpr (GhcPass 'Parsed) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint ([LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
lambda [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
oPats LHsExpr (GhcPass 'Parsed)
varBody)
lambdaExp Maybe (LHsExpr (GhcPass 'Parsed))
_ o :: LHsExpr (GhcPass 'Parsed)
o@(SimpleLambda [LPat (GhcPass 'Parsed) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
x] (L SrcSpan
_ HsExpr (GhcPass 'Parsed)
expr)) =
case HsExpr (GhcPass 'Parsed)
expr of
ExplicitTuple XExplicitTuple (GhcPass 'Parsed)
_ [LHsTupArg (GhcPass 'Parsed)]
args Boxity
boxity
| ([LHsTupArg (GhcPass 'Parsed)
_x], [LHsTupArg (GhcPass 'Parsed)]
ys) <- (LHsTupArg (GhcPass 'Parsed) -> Bool)
-> [LHsTupArg (GhcPass 'Parsed)]
-> ([LHsTupArg (GhcPass 'Parsed)], [LHsTupArg (GhcPass 'Parsed)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
==String -> Maybe String
forall a. a -> Maybe a
Just String
x) (Maybe String -> Bool)
-> (LHsTupArg (GhcPass 'Parsed) -> Maybe String)
-> LHsTupArg (GhcPass 'Parsed)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTupArg (GhcPass 'Parsed) -> Maybe String
tupArgVar) [LHsTupArg (GhcPass 'Parsed)]
args
, String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember String
x (Set String -> Bool) -> Set String -> Bool
forall a b. (a -> b) -> a -> b
$ (OccName -> String) -> Set OccName -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map OccName -> String
occNameString (Set OccName -> Set String) -> Set OccName -> Set String
forall a b. (a -> b) -> a -> b
$ [LHsTupArg (GhcPass 'Parsed)] -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars [LHsTupArg (GhcPass 'Parsed)]
ys
-> [(String
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed) -> Idea
forall a. Outputable a => String -> Located a -> Located a -> Idea
suggestN String
"Use tuple-section" LHsExpr (GhcPass 'Parsed)
o (LHsExpr (GhcPass 'Parsed) -> Idea)
-> LHsExpr (GhcPass 'Parsed) -> Idea
forall a b. (a -> b) -> a -> b
$ HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XExplicitTuple (GhcPass 'Parsed)
-> [LHsTupArg (GhcPass 'Parsed)]
-> Boxity
-> HsExpr (GhcPass 'Parsed)
forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple (GhcPass 'Parsed)
NoExtField
noExtField ((LHsTupArg (GhcPass 'Parsed) -> LHsTupArg (GhcPass 'Parsed))
-> [LHsTupArg (GhcPass 'Parsed)] -> [LHsTupArg (GhcPass 'Parsed)]
forall a b. (a -> b) -> [a] -> [b]
map LHsTupArg (GhcPass 'Parsed) -> LHsTupArg (GhcPass 'Parsed)
removeX [LHsTupArg (GhcPass 'Parsed)]
args) Boxity
boxity)
{ideaNote :: [Note]
ideaNote = [String -> Note
RequiresExtension String
"TupleSections"]}]
HsCase XCase (GhcPass 'Parsed)
_ (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
x') MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
matchGroup
| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x'
, String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember String
x (Set String -> Bool) -> Set String -> Bool
forall a b. (a -> b) -> a -> b
$ (OccName -> String) -> Set OccName -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map OccName -> String
occNameString (Set OccName -> Set String) -> Set OccName -> Set String
forall a b. (a -> b) -> a -> b
$ Vars -> Set OccName
free (Vars -> Set OccName) -> Vars -> Set OccName
forall a b. (a -> b) -> a -> b
$ MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)) -> Vars
forall a. AllVars a => a -> Vars
allVars MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
matchGroup
-> case MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
matchGroup of
oldMG :: MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldMG@(MG XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ (L SrcSpan
_ [L SrcSpan
_ Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch]) Origin
_)
| (LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)) -> Bool)
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(L SrcSpan
_ (GRHS XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ [GuardLStmt (GhcPass 'Parsed)]
stmts LHsExpr (GhcPass 'Parsed)
_)) -> [GuardLStmt (GhcPass 'Parsed)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GuardLStmt (GhcPass 'Parsed)]
stmts) (GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs (Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body. Match p body -> GRHSs p body
m_grhss Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch)) ->
let patLocs :: [SrcSpan]
patLocs = (Located (Pat (GhcPass 'Parsed)) -> SrcSpan)
-> [Located (Pat (GhcPass 'Parsed))] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (Pat (GhcPass 'Parsed)) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LPat (GhcPass 'Parsed)]
forall p body. Match p body -> [LPat p]
m_pats Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch)
bodyLocs :: [SrcSpan]
bodyLocs = (LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)) -> [SrcSpan])
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> [SrcSpan]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\case L SrcSpan
_ (GRHS XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ [GuardLStmt (GhcPass 'Parsed)]
_ LHsExpr (GhcPass 'Parsed)
body) -> [LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr (GhcPass 'Parsed)
body])
([LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> [SrcSpan])
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs (Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body. Match p body -> GRHSs p body
m_grhss Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch)
r :: [Refactoring SrcSpan]
r | [SrcSpan] -> Bool
forall a. [a] -> Bool
notNull [SrcSpan]
patLocs Bool -> Bool -> Bool
&& [SrcSpan] -> Bool
forall a. [a] -> Bool
notNull [SrcSpan]
bodyLocs =
let xloc :: SrcSpan
xloc = (SrcSpan -> SrcSpan -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall a. (a -> a -> a) -> [a] -> a
foldl1' SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans [SrcSpan]
patLocs
yloc :: SrcSpan
yloc = (SrcSpan -> SrcSpan -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall a. (a -> a -> a) -> [a] -> a
foldl1' SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans [SrcSpan]
bodyLocs
in [ RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LHsExpr (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr (GhcPass 'Parsed)
o) [(String
"x", SrcSpan -> SrcSpan
toRefactSrcSpan SrcSpan
xloc), (String
"y", SrcSpan -> SrcSpan
toRefactSrcSpan SrcSpan
yloc)]
((if Bool
needParens then String
"\\(x)" else String
"\\x") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> y")
]
| Bool
otherwise = []
needParens :: Bool
needParens = (Located (Pat (GhcPass 'Parsed)) -> Bool)
-> [Located (Pat (GhcPass 'Parsed))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (PprPrec -> Pat (GhcPass 'Parsed) -> Bool
forall (p :: Pass). IsPass p => PprPrec -> Pat (GhcPass p) -> Bool
patNeedsParens PprPrec
appPrec (Pat (GhcPass 'Parsed) -> Bool)
-> (Located (Pat (GhcPass 'Parsed)) -> Pat (GhcPass 'Parsed))
-> Located (Pat (GhcPass 'Parsed))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Pat (GhcPass 'Parsed)) -> Pat (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc) (Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LPat (GhcPass 'Parsed)]
forall p body. Match p body -> [LPat p]
m_pats Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch)
in [ String
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use lambda" LHsExpr (GhcPass 'Parsed)
o
( HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XLam (GhcPass 'Parsed)
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam (GhcPass 'Parsed)
NoExtField
noExtField MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldMG
{ mg_alts :: GenLocated
SrcSpan [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
mg_alts = [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> GenLocated
SrcSpan [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
forall e. e -> Located e
noLoc
[ Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall e. e -> Located e
noLoc Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch
{ m_pats :: [LPat (GhcPass 'Parsed)]
m_pats = (Located (Pat (GhcPass 'Parsed))
-> Located (Pat (GhcPass 'Parsed)))
-> [Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat (GhcPass 'Parsed)) -> Located (Pat (GhcPass 'Parsed))
forall (p :: Pass).
IsPass p =>
LPat (GhcPass p) -> LPat (GhcPass p)
mkParPat ([Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))])
-> [Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> a -> b
$ Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LPat (GhcPass 'Parsed)]
forall p body. Match p body -> [LPat p]
m_pats Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
oldmatch
, m_ctxt :: HsMatchContext (NoGhcTc (GhcPass 'Parsed))
m_ctxt = HsMatchContext (NoGhcTc (GhcPass 'Parsed))
forall p. HsMatchContext p
LambdaExpr
}
]
}
:: LHsExpr GhcPs
)
[Refactoring SrcSpan]
r
]
MG XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ (L SrcSpan
_ [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
_) Origin
_ ->
[(String
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed) -> Idea
forall a. Outputable a => String -> Located a -> Located a -> Idea
suggestN String
"Use lambda-case" LHsExpr (GhcPass 'Parsed)
o (LHsExpr (GhcPass 'Parsed) -> Idea)
-> LHsExpr (GhcPass 'Parsed) -> Idea
forall a b. (a -> b) -> a -> b
$ HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XLamCase (GhcPass 'Parsed)
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p. XLamCase p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase (GhcPass 'Parsed)
NoExtField
noExtField MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
matchGroup)
{ideaNote :: [Note]
ideaNote=[String -> Note
RequiresExtension String
"LambdaCase"]}]
HsExpr (GhcPass 'Parsed)
_ -> []
where
removeX :: LHsTupArg GhcPs -> LHsTupArg GhcPs
removeX :: LHsTupArg (GhcPass 'Parsed) -> LHsTupArg (GhcPass 'Parsed)
removeX (L SrcSpan
_ (Present XPresent (GhcPass 'Parsed)
_ (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
x')))
| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x' = HsTupArg (GhcPass 'Parsed) -> LHsTupArg (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsTupArg (GhcPass 'Parsed) -> LHsTupArg (GhcPass 'Parsed))
-> HsTupArg (GhcPass 'Parsed) -> LHsTupArg (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XMissing (GhcPass 'Parsed) -> HsTupArg (GhcPass 'Parsed)
forall id. XMissing id -> HsTupArg id
Missing XMissing (GhcPass 'Parsed)
NoExtField
noExtField
removeX LHsTupArg (GhcPass 'Parsed)
y = LHsTupArg (GhcPass 'Parsed)
y
tupArgVar :: LHsTupArg GhcPs -> Maybe String
tupArgVar :: LHsTupArg (GhcPass 'Parsed) -> Maybe String
tupArgVar (L SrcSpan
_ (Present XPresent (GhcPass 'Parsed)
_ (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
x))) = String -> Maybe String
forall a. a -> Maybe a
Just String
x
tupArgVar LHsTupArg (GhcPass 'Parsed)
_ = Maybe String
forall a. Maybe a
Nothing
lambdaExp Maybe (LHsExpr (GhcPass 'Parsed))
_ LHsExpr (GhcPass 'Parsed)
_ = []
varBody :: LHsExpr GhcPs
varBody :: LHsExpr (GhcPass 'Parsed)
varBody = String -> LHsExpr (GhcPass 'Parsed)
strToVar String
"body"
fromLambda :: LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
fromLambda :: LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
fromLambda (SimpleLambda [LPat (GhcPass 'Parsed)]
ps1 (LHsExpr (GhcPass 'Parsed)
-> ([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))
LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
fromLambda (LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed)))
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
-> ([Located (Pat (GhcPass 'Parsed))], LHsExpr (GhcPass 'Parsed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
fromParen -> ([Located (Pat (GhcPass 'Parsed))]
ps2,LHsExpr (GhcPass 'Parsed)
x))) = ((Pat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed))
-> [Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))]
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi ([String] -> Pat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
f ([String] -> Pat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed))
-> [String] -> Pat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ [Located (Pat (GhcPass 'Parsed))] -> [String]
forall a. AllVars a => a -> [String]
pvars [Located (Pat (GhcPass 'Parsed))]
ps2) [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
ps1 [Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))]
-> [Located (Pat (GhcPass 'Parsed))]
forall a. [a] -> [a] -> [a]
++ [Located (Pat (GhcPass 'Parsed))]
ps2, LHsExpr (GhcPass 'Parsed)
x)
where f :: [String] -> Pat GhcPs -> Pat GhcPs
f :: [String] -> Pat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
f [String]
bad (VarPat XVarPat (GhcPass 'Parsed)
_ (Located (IdP (GhcPass 'Parsed)) -> String
Located RdrName -> String
rdrNameStr -> String
x))
| String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
bad = XWildPat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall p. XWildPat p -> Pat p
WildPat XWildPat (GhcPass 'Parsed)
NoExtField
noExtField
f [String]
bad Pat (GhcPass 'Parsed)
x = Pat (GhcPass 'Parsed)
x
fromLambda LHsExpr (GhcPass 'Parsed)
x = ([], LHsExpr (GhcPass 'Parsed)
x)
mkOrigPats :: Maybe String -> [LPat GhcPs] -> ([LPat GhcPs], [String])
mkOrigPats :: Maybe String
-> [LPat (GhcPass 'Parsed)] -> ([LPat (GhcPass 'Parsed)], [String])
mkOrigPats Maybe String
funName [LPat (GhcPass 'Parsed)]
pats = ((String
-> (Bool, Located (Pat (GhcPass 'Parsed)))
-> Located (Pat (GhcPass 'Parsed)))
-> [String]
-> [(Bool, Located (Pat (GhcPass 'Parsed)))]
-> [Located (Pat (GhcPass 'Parsed))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> (Bool, LPat (GhcPass 'Parsed)) -> LPat (GhcPass 'Parsed)
String
-> (Bool, Located (Pat (GhcPass 'Parsed)))
-> Located (Pat (GhcPass 'Parsed))
munge [String]
vars [(Bool, Located (Pat (GhcPass 'Parsed)))]
pats', [String]
vars)
where
([Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions -> Set String
used, [(Bool, Located (Pat (GhcPass 'Parsed)))]
pats') = [(Set String, (Bool, Located (Pat (GhcPass 'Parsed))))]
-> ([Set String], [(Bool, Located (Pat (GhcPass 'Parsed)))])
forall a b. [(a, b)] -> ([a], [b])
unzip ((Located (Pat (GhcPass 'Parsed))
-> (Set String, (Bool, Located (Pat (GhcPass 'Parsed)))))
-> [Located (Pat (GhcPass 'Parsed))]
-> [(Set String, (Bool, Located (Pat (GhcPass 'Parsed))))]
forall a b. (a -> b) -> [a] -> [b]
map LPat (GhcPass 'Parsed)
-> (Set String, (Bool, LPat (GhcPass 'Parsed)))
Located (Pat (GhcPass 'Parsed))
-> (Set String, (Bool, Located (Pat (GhcPass 'Parsed))))
f [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
pats)
vars :: [String]
vars = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
s -> String
s String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set String
used Bool -> Bool -> Bool
&& String -> Maybe String
forall a. a -> Maybe a
Just String
s Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe String
funName) [String]
substVars
f :: LPat GhcPs -> (Set String, (Bool, LPat GhcPs))
f :: LPat (GhcPass 'Parsed)
-> (Set String, (Bool, LPat (GhcPass 'Parsed)))
f LPat (GhcPass 'Parsed)
p
| (Located (Pat (GhcPass 'Parsed)) -> Bool)
-> [Located (Pat (GhcPass 'Parsed))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LPat (GhcPass 'Parsed) -> Bool
Located (Pat (GhcPass 'Parsed)) -> Bool
isWildPat (Located (Pat (GhcPass 'Parsed))
-> [Located (Pat (GhcPass 'Parsed))]
forall on. Uniplate on => on -> [on]
universe LPat (GhcPass 'Parsed)
Located (Pat (GhcPass 'Parsed))
p) =
let used :: Set String
used = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [Located RdrName -> String
rdrNameStr Located (IdP (GhcPass 'Parsed))
Located RdrName
name | (L SrcSpan
_ (VarPat XVarPat (GhcPass 'Parsed)
_ Located (IdP (GhcPass 'Parsed))
name)) <- Located (Pat (GhcPass 'Parsed))
-> [Located (Pat (GhcPass 'Parsed))]
forall on. Uniplate on => on -> [on]
universe LPat (GhcPass 'Parsed)
Located (Pat (GhcPass 'Parsed))
p]
in (Set String
used, (Bool
True, LPat (GhcPass 'Parsed)
p))
| Bool
otherwise = (Set String
forall a. Monoid a => a
mempty, (Bool
False, LPat (GhcPass 'Parsed)
p))
isWildPat :: LPat GhcPs -> Bool
isWildPat :: LPat (GhcPass 'Parsed) -> Bool
isWildPat = \case (L SrcSpan
_ (WildPat XWildPat (GhcPass 'Parsed)
_)) -> Bool
True; LPat (GhcPass 'Parsed)
_ -> Bool
False
munge :: String -> (Bool, LPat GhcPs) -> LPat GhcPs
munge :: String -> (Bool, LPat (GhcPass 'Parsed)) -> LPat (GhcPass 'Parsed)
munge String
_ (Bool
True, LPat (GhcPass 'Parsed)
p) = LPat (GhcPass 'Parsed)
p
munge String
ident (Bool
False, L SrcSpan
ploc Pat (GhcPass 'Parsed)
_) = SrcSpan -> Pat (GhcPass 'Parsed) -> Located (Pat (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpan
ploc (XVarPat (GhcPass 'Parsed)
-> Located (IdP (GhcPass 'Parsed)) -> Pat (GhcPass 'Parsed)
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat XVarPat (GhcPass 'Parsed)
NoExtField
noExtField (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
ploc (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc String
ident))