{-# LANGUAGE PatternGuards, ViewPatterns #-}
module Hint.Util(niceLambdaR) where
import HSE.All
import Data.List.Extra
import Refact.Types
import Refact
import qualified Refact.Types as R (SrcSpan)
niceLambdaR :: [String] -> Exp_ -> (Exp_, R.SrcSpan -> [Refactoring R.SrcSpan])
niceLambdaR :: [String] -> Exp_ -> (Exp_, SrcSpan -> [Refactoring SrcSpan])
niceLambdaR xs :: [String]
xs (Paren l :: S
l x :: Exp_
x) = [String] -> Exp_ -> (Exp_, SrcSpan -> [Refactoring SrcSpan])
niceLambdaR [String]
xs Exp_
x
niceLambdaR xs :: [String]
xs (Lambda _ ((Pat S -> PVar_
forall a b. View a b => a -> b
view -> PVar_ v :: String
v):vs :: [Pat S]
vs) x :: Exp_
x) | String
v String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
xs = [String] -> Exp_ -> (Exp_, SrcSpan -> [Refactoring SrcSpan])
niceLambdaR ([String]
xs[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
v]) (S -> [Pat S] -> Exp_ -> Exp_
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda S
an [Pat S]
vs Exp_
x)
niceLambdaR xs :: [String]
xs (Lambda _ [] x :: Exp_
x) = [String] -> Exp_ -> (Exp_, SrcSpan -> [Refactoring SrcSpan])
niceLambdaR [String]
xs Exp_
x
niceLambdaR [] x :: Exp_
x = (Exp_
x, [Refactoring SrcSpan] -> SrcSpan -> [Refactoring SrcSpan]
forall a b. a -> b -> a
const [])
niceLambdaR ([String] -> Maybe ([String], String)
forall a. [a] -> Maybe ([a], a)
unsnoc -> Just (vs :: [String]
vs, v :: String
v)) (InfixApp _ e :: Exp_
e (QOp S -> Bool
isDol -> Bool
True) (Exp_ -> Var_
forall a b. View a b => a -> b
view -> Var_ v2 :: String
v2))
| String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v2, Exp_ -> [String]
forall a. FreeVars a => a -> [String]
vars Exp_
e [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`disjoint` [String
v]
= [String] -> Exp_ -> (Exp_, SrcSpan -> [Refactoring SrcSpan])
niceLambdaR [String]
vs Exp_
e
niceLambdaR xs :: [String]
xs (Exp_ -> [(Exp_, S)]
fromAppsWithLoc -> [(Exp_, S)]
e) | (Exp_ -> Var_) -> [Exp_] -> [Var_]
forall a b. (a -> b) -> [a] -> [b]
map Exp_ -> Var_
forall a b. View a b => a -> b
view [Exp_]
xs2 [Var_] -> [Var_] -> Bool
forall a. Eq a => a -> a -> Bool
== (String -> Var_) -> [String] -> [Var_]
forall a b. (a -> b) -> [a] -> [b]
map String -> Var_
Var_ [String]
xs, [Exp_] -> [String]
forall a. FreeVars a => a -> [String]
vars [Exp_]
e2 [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`disjoint` [String]
xs, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Exp_] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Exp_]
e2 =
([Exp_] -> Exp_
apps [Exp_]
e2, \s :: SrcSpan
s -> [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr SrcSpan
s [("x", SrcSpan
pos)] "x"])
where (e' :: [(Exp_, S)]
e',xs' :: [(Exp_, S)]
xs') = Int -> [(Exp_, S)] -> ([(Exp_, S)], [(Exp_, S)])
forall a. Int -> [a] -> ([a], [a])
splitAt ([(Exp_, S)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Exp_, S)]
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs) [(Exp_, S)]
e
(e2 :: [Exp_]
e2, xs2 :: [Exp_]
xs2) = (((Exp_, S) -> Exp_) -> [(Exp_, S)] -> [Exp_]
forall a b. (a -> b) -> [a] -> [b]
map (Exp_, S) -> Exp_
forall a b. (a, b) -> a
fst [(Exp_, S)]
e', ((Exp_, S) -> Exp_) -> [(Exp_, S)] -> [Exp_]
forall a b. (a -> b) -> [a] -> [b]
map (Exp_, S) -> Exp_
forall a b. (a, b) -> a
fst [(Exp_, S)]
xs')
pos :: SrcSpan
pos = SrcSpan -> SrcSpan
toRefactSrcSpan (SrcSpan -> SrcSpan) -> (S -> SrcSpan) -> S -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S -> SrcSpan
srcInfoSpan (S -> SrcSpan) -> S -> SrcSpan
forall a b. (a -> b) -> a -> b
$ (Exp_, S) -> S
forall a b. (a, b) -> b
snd ([(Exp_, S)] -> (Exp_, S)
forall a. [a] -> a
last [(Exp_, S)]
e')
niceLambdaR [x :: String
x,y :: String
y] (InfixApp _ (Exp_ -> Var_
forall a b. View a b => a -> b
view -> Var_ x1 :: String
x1) (QOp S -> Exp_
opExp -> Exp_
op) (Exp_ -> Var_
forall a b. View a b => a -> b
view -> Var_ y1 :: String
y1))
| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x1, String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y1, Exp_ -> [String]
forall a. FreeVars a => a -> [String]
vars Exp_
op [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`disjoint` [String
x,String
y] = (Exp_
op, \s :: SrcSpan
s -> [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr SrcSpan
s [] (Exp_ -> String
forall a. Pretty a => a -> String
prettyPrint Exp_
op)])
niceLambdaR [x :: String
x] (Exp_ -> App2
forall a b. View a b => a -> b
view -> App2 (Exp_ -> Maybe (QOp S)
expOp -> Just op :: QOp S
op) xx :: Exp_
xx a :: Exp_
a)
| Exp_ -> Bool
forall l. Exp l -> Bool
isLexeme Exp_
a, Exp_ -> Var_
forall a b. View a b => a -> b
view Exp_
xx Var_ -> Var_ -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Var_
Var_ String
x, String
x 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_
a, String -> Bool
allowRightSection (QOp S -> String
forall a. Named a => a -> String
fromNamed QOp S
op) =
let e :: Exp_
e = Exp_ -> Exp_
forall l. (Data l, Default l) => Exp l -> Exp l
rebracket1 (Exp_ -> Exp_) -> Exp_ -> Exp_
forall a b. (a -> b) -> a -> b
$ S -> QOp S -> Exp_ -> Exp_
forall l. l -> QOp l -> Exp l -> Exp l
RightSection S
an QOp S
op Exp_
a
in (Exp_
e, \s :: SrcSpan
s -> [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr SrcSpan
s [] (Exp_ -> String
forall a. Pretty a => a -> String
prettyPrint Exp_
e)])
niceLambdaR [x :: String
x] (Exp_ -> App2
forall a b. View a b => a -> b
view -> App2 (Exp_ -> Maybe (QOp S)
expOp -> Just op :: QOp S
op) a :: Exp_
a xx :: Exp_
xx)
| Exp_ -> Bool
forall l. Exp l -> Bool
isLexeme Exp_
a, Exp_ -> Var_
forall a b. View a b => a -> b
view Exp_
xx Var_ -> Var_ -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Var_
Var_ String
x, String
x 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_
a =
let e :: Exp_
e = Exp_ -> Exp_
forall l. (Data l, Default l) => Exp l -> Exp l
rebracket1 (Exp_ -> Exp_) -> Exp_ -> Exp_
forall a b. (a -> b) -> a -> b
$ S -> Exp_ -> QOp S -> Exp_
forall l. l -> Exp l -> QOp l -> Exp l
LeftSection S
an Exp_
a QOp S
op
in (Exp_
e, \s :: SrcSpan
s -> [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr SrcSpan
s [] (Exp_ -> String
forall a. Pretty a => a -> String
prettyPrint Exp_
e)])
niceLambdaR [x :: String
x,y :: String
y] (Exp_ -> App2
forall a b. View a b => a -> b
view -> App2 op :: Exp_
op (Exp_ -> Var_
forall a b. View a b => a -> b
view -> Var_ y1 :: String
y1) (Exp_ -> Var_
forall a b. View a b => a -> b
view -> Var_ x1 :: String
x1))
| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x1, String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y1, Exp_ -> [String]
forall a. FreeVars a => a -> [String]
vars Exp_
op [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`disjoint` [String
x,String
y] = (Exp_ -> Exp_
gen Exp_
op, \s :: SrcSpan
s -> [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr SrcSpan
s [("x", Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp_
op)] (Exp_ -> String
forall a. Pretty a => a -> String
prettyPrint (Exp_ -> String) -> Exp_ -> String
forall a b. (a -> b) -> a -> b
$ Exp_ -> Exp_
gen (String -> Exp_
forall a. Named a => String -> a
toNamed "x"))])
where
gen :: Exp_ -> Exp_
gen = S -> Exp_ -> Exp_ -> Exp_
forall l. l -> Exp l -> Exp l -> Exp l
App S
an (String -> Exp_
forall a. Named a => String -> a
toNamed "flip")
niceLambdaR [x :: String
x] y :: Exp_
y | Just (z :: Exp_
z, subts :: [S]
subts) <- Exp_ -> Maybe (Exp_, [S])
factor Exp_
y, String
x 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_
z = (Exp_
z, \s :: SrcSpan
s -> [[S] -> SrcSpan -> Refactoring SrcSpan
mkRefact [S]
subts SrcSpan
s])
where
factor :: Exp_ -> Maybe (Exp_, [S])
factor y :: Exp_
y@(App _ ini :: Exp_
ini lst :: Exp_
lst) | Exp_ -> Var_
forall a b. View a b => a -> b
view Exp_
lst Var_ -> Var_ -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Var_
Var_ String
x = (Exp_, [S]) -> Maybe (Exp_, [S])
forall a. a -> Maybe a
Just (Exp_
ini, [Exp_ -> S
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Exp_
ini])
factor y :: Exp_
y@(App _ ini :: Exp_
ini lst :: Exp_
lst) | Just (z :: Exp_
z, ss :: [S]
ss) <- Exp_ -> Maybe (Exp_, [S])
factor Exp_
lst = let r :: Exp_
r = Exp_ -> Exp_ -> Exp_
niceDotApp Exp_
ini Exp_
z
in if Exp_
r Exp_ -> Exp_ -> Bool
forall a. Eq a => a -> a -> Bool
== Exp_
z then (Exp_, [S]) -> Maybe (Exp_, [S])
forall a. a -> Maybe a
Just (Exp_
r, [S]
ss)
else (Exp_, [S]) -> Maybe (Exp_, [S])
forall a. a -> Maybe a
Just (Exp_
r, Exp_ -> S
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Exp_
ini S -> [S] -> [S]
forall a. a -> [a] -> [a]
: [S]
ss)
factor (InfixApp _ y :: Exp_
y op :: QOp S
op (Exp_ -> Maybe (Exp_, [S])
factor -> Just (z :: Exp_
z, ss :: [S]
ss))) | QOp S -> Bool
isDol QOp S
op = let r :: Exp_
r = Exp_ -> Exp_ -> Exp_
niceDotApp Exp_
y Exp_
z
in if Exp_
r Exp_ -> Exp_ -> Bool
forall a. Eq a => a -> a -> Bool
== Exp_
z then (Exp_, [S]) -> Maybe (Exp_, [S])
forall a. a -> Maybe a
Just (Exp_
r, [S]
ss)
else (Exp_, [S]) -> Maybe (Exp_, [S])
forall a. a -> Maybe a
Just (Exp_
r, Exp_ -> S
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Exp_
y S -> [S] -> [S]
forall a. a -> [a] -> [a]
: [S]
ss)
factor (Paren _ y :: Exp_
y@App{}) = Exp_ -> Maybe (Exp_, [S])
factor Exp_
y
factor _ = Maybe (Exp_, [S])
forall a. Maybe a
Nothing
mkRefact :: [S] -> R.SrcSpan -> Refactoring R.SrcSpan
mkRefact :: [S] -> SrcSpan -> Refactoring SrcSpan
mkRefact subts :: [S]
subts s :: SrcSpan
s =
let tempSubts :: [(String, SrcSpan)]
tempSubts = (Char -> S -> (String, SrcSpan))
-> String -> [S] -> [(String, SrcSpan)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a :: Char
a b :: S
b -> ([Char
a], SrcSpan -> SrcSpan
toRefactSrcSpan (SrcSpan -> SrcSpan) -> SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ S -> SrcSpan
srcInfoSpan S
b)) ['a' .. 'z'] [S]
subts
template :: Exp_
template = [Exp_] -> Exp_
dotApps (((String, SrcSpan) -> Exp_) -> [(String, SrcSpan)] -> [Exp_]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Exp_
forall a. Named a => String -> a
toNamed (String -> Exp_)
-> ((String, SrcSpan) -> String) -> (String, SrcSpan) -> Exp_
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, SrcSpan) -> String
forall a b. (a, b) -> a
fst) [(String, SrcSpan)]
tempSubts)
in RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr SrcSpan
s [(String, SrcSpan)]
tempSubts (Exp_ -> String
forall a. Pretty a => a -> String
prettyPrint Exp_
template)
niceLambdaR [x :: String
x] (LeftSection _ (Exp_ -> Var_
forall a b. View a b => a -> b
view -> Var_ x1 :: String
x1) op :: QOp S
op) | String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x1 =
let e :: Exp_
e = QOp S -> Exp_
opExp QOp S
op
in (Exp_
e, \s :: SrcSpan
s -> [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr SrcSpan
s [] (Exp_ -> String
forall a. Pretty a => a -> String
prettyPrint Exp_
e)])
niceLambdaR ps :: [String]
ps x :: Exp_
x = (S -> [Pat S] -> Exp_ -> Exp_
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda S
an ((String -> Pat S) -> [String] -> [Pat S]
forall a b. (a -> b) -> [a] -> [b]
map String -> Pat S
forall a. Named a => String -> a
toNamed [String]
ps) Exp_
x, [Refactoring SrcSpan] -> SrcSpan -> [Refactoring SrcSpan]
forall a b. a -> b -> a
const [])
niceDotApp :: Exp_ -> Exp_ -> Exp_
niceDotApp :: Exp_ -> Exp_ -> Exp_
niceDotApp a :: Exp_
a b :: Exp_
b | Exp_
a Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "$" = Exp_
b
| Bool
otherwise = Exp_ -> Exp_ -> Exp_
dotApp Exp_
a Exp_
b