{-# LANGUAGE ViewPatterns, PatternGuards #-}

{-
    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  -- 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
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 mr = y mr
fun x = f . g $ x -- fun = f . g
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
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 (-) x)
f = foo (\x y -> fun x y) -- @Warning fun
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
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
baz = bar (\x -> (x +)) -- (+)
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
no = blah (\ x -> case x of A -> a x; B -> b x)
yes = blah (\ x -> (y, x, z+q)) -- (y, , z+q)
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)
</TEST>
-}


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)
            [ -- Disabled, see apply-refact #3
              -- Replace Decl (toSS $ reform pats bod) s2 t2]]
            ]]
        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
              --s2 = subts pats2 bod2
              t1 :: String
t1 = [Pat S] -> Exp_ -> String
forall p. [Pat S] -> p -> String
template [Pat S]
finalpats Exp_
body
              --t2 = template pats2 bod2

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)


--Section refactoring is not currently implemented.
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)] -- [Replace Expr (toSS o) subts template]]
    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)
--      template = prettyPrint (exp (toNamed "a") "*")
--      subts = [("a", toSS y), ("*", toSS v)]
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 _ _ = []


-- replace any repeated pattern variable with _
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)