{-# LANGUAGE ViewPatterns, PatternGuards #-}
module Hint.Lambda(lambdaHint) where
import Hint.Util
import Hint.Type
import Util
import Data.List.Extra
import Data.Maybe
import qualified Data.Set as Set
import Refact.Types hiding (RType(Match))
lambdaHint :: DeclHint
lambdaHint :: DeclHint
lambdaHint _ _ x :: Decl_
x = ((Maybe Exp_, Exp_) -> [Idea]) -> [(Maybe Exp_, Exp_)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Maybe Exp_ -> Exp_ -> [Idea]) -> (Maybe Exp_, Exp_) -> [Idea]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Exp_ -> Exp_ -> [Idea]
lambdaExp) (Decl_ -> [(Maybe Exp_, Exp_)]
forall a b. Biplate a b => a -> [(Maybe b, b)]
universeParentBi Decl_
x) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ (Decl_ -> [Idea]) -> [Decl_] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl_ -> [Idea]
lambdaDecl (Decl_ -> [Decl_]
forall on. Uniplate on => on -> [on]
universe Decl_
x)
lambdaDecl :: Decl_ -> [Idea]
lambdaDecl :: Decl_ -> [Idea]
lambdaDecl (Decl_ -> Decl_
forall s. Decl s -> Decl s
toFunBind -> o :: Decl_
o@(FunBind loc1 :: S
loc1 [Match _ name :: Name S
name pats :: [Pat S]
pats (UnGuardedRhs loc2 :: S
loc2 bod :: Exp_
bod) bind :: Maybe (Binds S)
bind]))
| Maybe (Binds S) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Binds S)
bind, Exp_ -> Bool
forall l. Exp l -> Bool
isLambda (Exp_ -> Bool) -> Exp_ -> Bool
forall a b. (a -> b) -> a -> b
$ Exp_ -> Exp_
fromParen Exp_
bod, [Exp_] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Pat S] -> [Exp_]
forall from to. Biplate from to => from -> [to]
universeBi [Pat S]
pats :: [Exp_]) =
[String -> Decl_ -> Decl_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Redundant lambda" Decl_
o ([Pat S] -> Exp_ -> Decl_
gen [Pat S]
pats Exp_
bod) [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Decl (Decl_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Decl_
o) [(String, SrcSpan)]
s1 String
t1]]
| [Pat S] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pat S]
pats2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Pat S] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pat S]
pats, [Pat S] -> [String]
forall a. AllVars a => a -> [String]
pvars (Int -> [Pat S] -> [Pat S]
forall a. Int -> [a] -> [a]
drop ([Pat S] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pat S]
pats2) [Pat S]
pats) [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`disjoint` Maybe (Binds S) -> [String]
forall a. AllVars a => a -> [String]
varss Maybe (Binds S)
bind
= [String -> Decl_ -> Decl_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Eta reduce" ([Pat S] -> Exp_ -> Decl_
reform [Pat S]
pats Exp_
bod) ([Pat S] -> Exp_ -> Decl_
reform [Pat S]
pats2 Exp_
bod2)
[
]]
where reform :: [Pat S] -> Exp_ -> Decl_
reform p :: [Pat S]
p b :: Exp_
b = S -> [Match S] -> Decl_
forall l. l -> [Match l] -> Decl l
FunBind S
loc [S -> Name S -> [Pat S] -> Rhs S -> Maybe (Binds S) -> Match S
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match S
an Name S
name [Pat S]
p (S -> Exp_ -> Rhs S
forall l. l -> Exp l -> Rhs l
UnGuardedRhs S
an Exp_
b) Maybe (Binds S)
forall a. Maybe a
Nothing]
loc :: S
loc = S -> (Int, Int) -> S
setSpanInfoEnd S
loc1 ((Int, Int) -> S) -> (Int, Int) -> S
forall a b. (a -> b) -> a -> b
$ SrcSpan -> (Int, Int)
srcSpanEnd (SrcSpan -> (Int, Int)) -> SrcSpan -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ S -> SrcSpan
srcInfoSpan S
loc2
gen :: [Pat S] -> Exp_ -> Decl_
gen ps :: [Pat S]
ps = ([Pat S] -> Exp_ -> Decl_) -> ([Pat S], Exp_) -> Decl_
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Pat S] -> Exp_ -> Decl_
reform (([Pat S], Exp_) -> Decl_)
-> (Exp_ -> ([Pat S], Exp_)) -> Exp_ -> Decl_
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp_ -> ([Pat S], Exp_)
fromLambda (Exp_ -> ([Pat S], Exp_))
-> (Exp_ -> Exp_) -> Exp_ -> ([Pat S], Exp_)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S -> [Pat S] -> Exp_ -> Exp_
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda S
an [Pat S]
ps
(finalpats :: [Pat S]
finalpats, body :: Exp_
body) = Exp_ -> ([Pat S], Exp_)
fromLambda (Exp_ -> ([Pat S], Exp_))
-> (Exp_ -> Exp_) -> Exp_ -> ([Pat S], Exp_)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S -> [Pat S] -> Exp_ -> Exp_
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda S
an [Pat S]
pats (Exp_ -> ([Pat S], Exp_)) -> Exp_ -> ([Pat S], Exp_)
forall a b. (a -> b) -> a -> b
$ Exp_
bod
(pats2 :: [Pat S]
pats2, bod2 :: Exp_
bod2) = [Pat S] -> Exp_ -> ([Pat S], Exp_)
etaReduce [Pat S]
pats Exp_
bod
template :: [Pat S] -> p -> String
template fps :: [Pat S]
fps b :: p
b = Decl_ -> String
forall a. Pretty a => a -> String
prettyPrint (Decl_ -> String) -> Decl_ -> String
forall a b. (a -> b) -> a -> b
$ [Pat S] -> Exp_ -> Decl_
reform ((Char -> Pat S -> Pat S) -> String -> [Pat S] -> [Pat S]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> Pat S -> Pat S
munge ['a'..'z'] [Pat S]
fps) (String -> Exp_
forall a. Named a => String -> a
toNamed "body")
munge :: Char -> Pat_ -> Pat_
munge :: Char -> Pat S -> Pat S
munge ident :: Char
ident p :: Pat S
p@(PWildCard _) = Pat S
p
munge ident :: Char
ident p :: Pat S
p = S -> Name S -> Pat S
forall l. l -> Name l -> Pat l
PVar (Pat S -> S
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Pat S
p) (S -> String -> Name S
forall l. l -> String -> Name l
Ident (Pat S -> S
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Pat S
p) [Char
ident])
subts :: [a S] -> a S -> [(String, SrcSpan)]
subts fps :: [a S]
fps b :: a S
b = ("body", a S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS a S
b) (String, SrcSpan) -> [(String, SrcSpan)] -> [(String, SrcSpan)]
forall a. a -> [a] -> [a]
: (Char -> SrcSpan -> (String, SrcSpan))
-> String -> [SrcSpan] -> [(String, SrcSpan)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\x :: Char
x y :: SrcSpan
y -> ([Char
x],SrcSpan
y)) ['a'..'z'] ((a S -> SrcSpan) -> [a S] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map a S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS [a S]
fps)
s1 :: [(String, SrcSpan)]
s1 = [Pat S] -> Exp_ -> [(String, SrcSpan)]
forall (a :: * -> *) (a :: * -> *).
(Annotated a, Annotated a) =>
[a S] -> a S -> [(String, SrcSpan)]
subts [Pat S]
finalpats Exp_
body
t1 :: String
t1 = [Pat S] -> Exp_ -> String
forall p. [Pat S] -> p -> String
template [Pat S]
finalpats Exp_
body
lambdaDecl _ = []
setSpanInfoEnd :: S -> (Int, Int) -> S
setSpanInfoEnd ssi :: S
ssi (line :: Int
line, col :: Int
col) = S
ssi{srcInfoSpan :: SrcSpan
srcInfoSpan = (S -> SrcSpan
srcInfoSpan S
ssi){srcSpanEndLine :: Int
srcSpanEndLine=Int
line, srcSpanEndColumn :: Int
srcSpanEndColumn=Int
col}}
etaReduce :: [Pat_] -> Exp_ -> ([Pat_], Exp_)
etaReduce :: [Pat S] -> Exp_ -> ([Pat S], Exp_)
etaReduce ps :: [Pat S]
ps (App _ x :: Exp_
x (Var _ (UnQual _ (Ident _ y :: String
y))))
| [Pat S]
ps [Pat S] -> [Pat S] -> Bool
forall a. Eq a => a -> a -> Bool
/= [], PVar _ (Ident _ p :: String
p) <- [Pat S] -> Pat S
forall a. [a] -> a
last [Pat S]
ps, String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y, String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "mr", String
y String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Exp_ -> [String]
forall a. FreeVars a => a -> [String]
vars Exp_
x
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Exp_ -> Bool) -> [Exp_] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Exp_ -> Bool
forall l. Exp l -> Bool
isQuasiQuote ([Exp_] -> Bool) -> [Exp_] -> Bool
forall a b. (a -> b) -> a -> b
$ Exp_ -> [Exp_]
forall on. Uniplate on => on -> [on]
universe Exp_
x
= [Pat S] -> Exp_ -> ([Pat S], Exp_)
etaReduce ([Pat S] -> [Pat S]
forall a. [a] -> [a]
init [Pat S]
ps) Exp_
x
etaReduce ps :: [Pat S]
ps (InfixApp a :: S
a x :: Exp_
x (QOp S -> Bool
isDol -> Bool
True) y :: Exp_
y) = [Pat S] -> Exp_ -> ([Pat S], Exp_)
etaReduce [Pat S]
ps (S -> Exp_ -> Exp_ -> Exp_
forall l. l -> Exp l -> Exp l -> Exp l
App S
a Exp_
x Exp_
y)
etaReduce ps :: [Pat S]
ps x :: Exp_
x = ([Pat S]
ps,Exp_
x)
lambdaExp :: Maybe Exp_ -> Exp_ -> [Idea]
lambdaExp :: Maybe Exp_ -> Exp_ -> [Idea]
lambdaExp p :: Maybe Exp_
p o :: Exp_
o@(Paren _ (App _ v :: Exp_
v@(Var l :: S
l (UnQual _ (Symbol _ x :: String
x))) y :: Exp_
y)) | Exp_ -> Bool
forall a. Brackets a => a -> Bool
isAtom Exp_
y, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Exp_ -> Bool
forall l. Exp l -> Bool
isTypeApp Exp_
y, String -> Bool
allowLeftSection String
x =
[String -> Exp_ -> Exp_ -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> Idea
suggestN "Use section" Exp_
o (Exp_ -> String -> Exp_
exp Exp_
y String
x)]
where
exp :: Exp_ -> String -> Exp_
exp op :: Exp_
op rhs :: String
rhs = S -> Exp_ -> QOp S -> Exp_
forall l. l -> Exp l -> QOp l -> Exp l
LeftSection S
an Exp_
op (String -> QOp S
forall a. Named a => String -> a
toNamed String
rhs)
lambdaExp p :: Maybe Exp_
p o :: Exp_
o@(Paren _ (App _ (App _ (Exp_ -> Var_
forall a b. View a b => a -> b
view -> Var_ "flip") (Var _ x :: QName S
x)) y :: Exp_
y)) | String -> Bool
allowRightSection (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ QName S -> String
forall a. Named a => a -> String
fromNamed QName S
x =
[String -> Exp_ -> Exp_ -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> Idea
suggestN "Use section" Exp_
o (Exp_ -> Idea) -> Exp_ -> Idea
forall a b. (a -> b) -> a -> b
$ S -> QOp S -> Exp_ -> Exp_
forall l. l -> QOp l -> Exp l -> Exp l
RightSection S
an (S -> QName S -> QOp S
forall l. l -> QName l -> QOp l
QVarOp S
an QName S
x) Exp_
y]
lambdaExp p :: Maybe Exp_
p o :: Exp_
o@Lambda{}
| Bool -> (Exp_ -> Bool) -> Maybe Exp_ -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not (Bool -> Bool) -> (Exp_ -> Bool) -> Exp_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp_ -> Bool
forall l. Exp l -> Bool
isInfixApp) Maybe Exp_
p, (res :: Exp_
res, refact :: SrcSpan -> [Refactoring SrcSpan]
refact) <- [String] -> Exp_ -> (Exp_, SrcSpan -> [Refactoring SrcSpan])
niceLambdaR [] Exp_
o
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Exp_ -> Bool
forall l. Exp l -> Bool
isLambda Exp_
res, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Exp_ -> Bool) -> [Exp_] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Exp_ -> Bool
forall l. Exp l -> Bool
isQuasiQuote ([Exp_] -> Bool) -> [Exp_] -> Bool
forall a b. (a -> b) -> a -> b
$ Exp_ -> [Exp_]
forall on. Uniplate on => on -> [on]
universe Exp_
res, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ "runST" String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Exp_ -> Set String
forall a. FreeVars a => a -> Set String
freeVars Exp_
o
, let name :: String
name = "Avoid lambda" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Exp_ -> Int
forall l. Data l => Exp l -> Int
countInfixNames Exp_
res Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Exp_ -> Int
forall l. Data l => Exp l -> Int
countInfixNames Exp_
o then " using `infix`" else "") =
[(if Exp_ -> Bool
forall l. Exp l -> Bool
isVar Exp_
res Bool -> Bool -> Bool
|| Exp_ -> Bool
forall l. Exp l -> Bool
isCon Exp_
res then String -> Exp_ -> Exp_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn else String -> Exp_ -> Exp_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest) String
name Exp_
o Exp_
res (SrcSpan -> [Refactoring SrcSpan]
refact (SrcSpan -> [Refactoring SrcSpan])
-> SrcSpan -> [Refactoring SrcSpan]
forall a b. (a -> b) -> a -> b
$ Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp_
o)]
where countInfixNames :: Exp l -> Int
countInfixNames x :: Exp l
x = [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | RightSection _ (QVarOp _ (UnQual _ (Ident _ _))) _ <- Exp l -> [Exp l]
forall on. Uniplate on => on -> [on]
universe Exp l
x]
lambdaExp p :: Maybe Exp_
p o :: Exp_
o@(Lambda _ pats :: [Pat S]
pats x :: Exp_
x) | Exp_ -> Bool
forall l. Exp l -> Bool
isLambda (Exp_ -> Exp_
fromParen Exp_
x), [Exp_] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Pat S] -> [Exp_]
forall from to. Biplate from to => from -> [to]
universeBi [Pat S]
pats :: [Exp_]), Bool -> (Exp_ -> Bool) -> Maybe Exp_ -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not (Bool -> Bool) -> (Exp_ -> Bool) -> Exp_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp_ -> Bool
forall l. Exp l -> Bool
isLambda) Maybe Exp_
p =
[String -> Exp_ -> Exp_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Collapse lambdas" Exp_
o (S -> [Pat S] -> Exp_ -> Exp_
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda S
an [Pat S]
pats Exp_
body) [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp_
o) [(String, SrcSpan)]
subts String
template]]
where
(pats :: [Pat S]
pats, body :: Exp_
body) = Exp_ -> ([Pat S], Exp_)
fromLambda Exp_
o
template :: String
template = Exp_ -> String
forall a. Pretty a => a -> String
prettyPrint (Exp_ -> String) -> Exp_ -> String
forall a b. (a -> b) -> a -> b
$ S -> [Pat S] -> Exp_ -> Exp_
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda S
an ((Char -> Pat S -> Pat S) -> String -> [Pat S] -> [Pat S]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> Pat S -> Pat S
munge ['a'..'z'] [Pat S]
pats) (String -> Exp_
forall a. Named a => String -> a
toNamed "body")
munge :: Char -> Pat_ -> Pat_
munge :: Char -> Pat S -> Pat S
munge ident :: Char
ident p :: Pat S
p@(PWildCard _) = Pat S
p
munge ident :: Char
ident p :: Pat S
p = S -> Name S -> Pat S
forall l. l -> Name l -> Pat l
PVar (Pat S -> S
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Pat S
p) (S -> String -> Name S
forall l. l -> String -> Name l
Ident (Pat S -> S
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Pat S
p) [Char
ident])
subts :: [(String, SrcSpan)]
subts = ("body", Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp_
body) (String, SrcSpan) -> [(String, SrcSpan)] -> [(String, SrcSpan)]
forall a. a -> [a] -> [a]
: (Char -> SrcSpan -> (String, SrcSpan))
-> String -> [SrcSpan] -> [(String, SrcSpan)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\x :: Char
x y :: SrcSpan
y -> ([Char
x],SrcSpan
y)) ['a'..'z'] ((Pat S -> SrcSpan) -> [Pat S] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map Pat S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS [Pat S]
pats)
lambdaExp p :: Maybe Exp_
p o :: Exp_
o@(Lambda _ [Pat S -> PVar_
forall a b. View a b => a -> b
view -> PVar_ u :: String
u] (Case _ (Exp_ -> Var_
forall a b. View a b => a -> b
view -> Var_ v :: String
v) alts :: [Alt S]
alts))
| String
u String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v, String
u String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Alt S] -> [String]
forall a. FreeVars a => a -> [String]
vars [Alt S]
alts = case [Alt S]
alts of
[Alt _ pat :: Pat S
pat (UnGuardedRhs _ bod :: Exp_
bod) Nothing] -> [String -> Exp_ -> Exp_ -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> Idea
suggestN "Use lambda" Exp_
o (Exp_ -> Idea) -> Exp_ -> Idea
forall a b. (a -> b) -> a -> b
$ S -> [Pat S] -> Exp_ -> Exp_
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda S
an [Pat S
pat] Exp_
bod]
_ -> [(String -> Exp_ -> Exp_ -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> Idea
suggestN "Use lambda-case" Exp_
o (Exp_ -> Idea) -> Exp_ -> Idea
forall a b. (a -> b) -> a -> b
$ S -> [Alt S] -> Exp_
forall l. l -> [Alt l] -> Exp l
LCase S
an [Alt S]
alts){ideaNote :: [Note]
ideaNote=[String -> Note
RequiresExtension "LambdaCase"]}]
lambdaExp p :: Maybe Exp_
p o :: Exp_
o@(Lambda _ [Pat S -> PVar_
forall a b. View a b => a -> b
view -> PVar_ u :: String
u] (Tuple _ boxed :: Boxed
boxed xs :: [Exp_]
xs))
| ([yes :: Exp_
yes],no :: [Exp_]
no) <- (Exp_ -> Bool) -> [Exp_] -> ([Exp_], [Exp_])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= String
u) [Exp_]
xs, String
u String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (Exp_ -> [String]) -> [Exp_] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Exp_ -> [String]
forall a. FreeVars a => a -> [String]
vars [Exp_]
no
= [(String -> Exp_ -> Exp_ -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> Idea
suggestN "Use tuple-section" Exp_
o (Exp_ -> Idea) -> Exp_ -> Idea
forall a b. (a -> b) -> a -> b
$ S -> Boxed -> [Maybe Exp_] -> Exp_
forall l. l -> Boxed -> [Maybe (Exp l)] -> Exp l
TupleSection S
an Boxed
boxed [if Exp_
x Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= String
u then Maybe Exp_
forall a. Maybe a
Nothing else Exp_ -> Maybe Exp_
forall a. a -> Maybe a
Just Exp_
x | Exp_
x <- [Exp_]
xs])
{ideaNote :: [Note]
ideaNote=[String -> Note
RequiresExtension "TupleSections"]}]
lambdaExp _ _ = []
fromLambda :: Exp_ -> ([Pat_], Exp_)
fromLambda :: Exp_ -> ([Pat S], Exp_)
fromLambda (Lambda _ ps1 :: [Pat S]
ps1 (Exp_ -> ([Pat S], Exp_)
fromLambda (Exp_ -> ([Pat S], Exp_))
-> (Exp_ -> Exp_) -> Exp_ -> ([Pat S], Exp_)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp_ -> Exp_
fromParen -> (ps2 :: [Pat S]
ps2,x :: Exp_
x))) = ((Pat S -> Pat S) -> [Pat S] -> [Pat S]
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi ([String] -> Pat S -> Pat S
forall (t :: * -> *). Foldable t => t String -> Pat S -> Pat S
f ([String] -> Pat S -> Pat S) -> [String] -> Pat S -> Pat S
forall a b. (a -> b) -> a -> b
$ [Pat S] -> [String]
forall a. AllVars a => a -> [String]
pvars [Pat S]
ps2) [Pat S]
ps1 [Pat S] -> [Pat S] -> [Pat S]
forall a. [a] -> [a] -> [a]
++ [Pat S]
ps2, Exp_
x)
where f :: t String -> Pat S -> Pat S
f bad :: t String
bad x :: Pat S
x@PVar{} | Pat S -> String
forall a. Pretty a => a -> String
prettyPrint Pat S
x String -> t String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t String
bad = S -> Pat S
forall l. l -> Pat l
PWildCard S
an
f bad :: t String
bad x :: Pat S
x = Pat S
x
fromLambda x :: Exp_
x = ([], Exp_
x)