{-# 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 xs (Paren l x) = niceLambdaR xs x
niceLambdaR xs (Lambda _ ((view -> PVar_ v):vs) x) | v `notElem` xs = niceLambdaR (xs++[v]) (Lambda an vs x)
niceLambdaR xs (Lambda _ [] x) = niceLambdaR xs x
niceLambdaR [] x = (x, const [])
niceLambdaR (unsnoc -> Just (vs, v)) (InfixApp _ e (isDol -> True) (view -> Var_ v2))
| v == v2, vars e `disjoint` [v]
= niceLambdaR vs e
niceLambdaR xs (fromAppsWithLoc -> e) | map view xs2 == map Var_ xs, vars e2 `disjoint` xs, not $ null e2 =
(apps e2, \s -> [Replace Expr s [("x", pos)] "x"])
where (e',xs') = splitAt (length e - length xs) e
(e2, xs2) = (map fst e', map fst xs')
pos = toRefactSrcSpan . srcInfoSpan $ snd (last e')
niceLambdaR [x,y] (InfixApp _ (view -> Var_ x1) (opExp -> op) (view -> Var_ y1))
| x == x1, y == y1, vars op `disjoint` [x,y] = (op, \s -> [Replace Expr s [] (prettyPrint op)])
niceLambdaR [x] (view -> App2 (expOp -> Just op) xx a)
| isLexeme a, view xx == Var_ x, x `notElem` vars a, allowRightSection (fromNamed op) =
let e = rebracket1 $ RightSection an op a
in (e, \s -> [Replace Expr s [] (prettyPrint e)])
niceLambdaR [x] (view -> App2 (expOp -> Just op) a xx)
| isLexeme a, view xx == Var_ x, x `notElem` vars a =
let e = rebracket1 $ LeftSection an a op
in (e, \s -> [Replace Expr s [] (prettyPrint e)])
niceLambdaR [x,y] (view -> App2 op (view -> Var_ y1) (view -> Var_ x1))
| x == x1, y == y1, vars op `disjoint` [x,y] = (gen op, \s -> [Replace Expr s [("x", toSS op)] (prettyPrint $ gen (toNamed "x"))])
where
gen = App an (toNamed "flip")
niceLambdaR [x] y | Just (z, subts) <- factor y, x `notElem` vars z = (z, \s -> [mkRefact subts s])
where
factor y@(App _ ini lst) | view lst == Var_ x = Just (ini, [ann ini])
factor y@(App _ ini lst) | Just (z, ss) <- factor lst = let r = niceDotApp ini z
in if r == z then Just (r, ss)
else Just (r, ann ini : ss)
factor (InfixApp _ y op (factor -> Just (z, ss))) | isDol op = let r = niceDotApp y z
in if r == z then Just (r, ss)
else Just (r, ann y : ss)
factor (Paren _ y@App{}) = factor y
factor _ = Nothing
mkRefact :: [S] -> R.SrcSpan -> Refactoring R.SrcSpan
mkRefact subts s =
let tempSubts = zipWith (\a b -> ([a], toRefactSrcSpan $ srcInfoSpan b)) ['a' .. 'z'] subts
template = dotApps (map (toNamed . fst) tempSubts)
in Replace Expr s tempSubts (prettyPrint template)
niceLambdaR [x] (LeftSection _ (view -> Var_ x1) op) | x == x1 =
let e = opExp op
in (e, \s -> [Replace Expr s [] (prettyPrint e)])
niceLambdaR ps x = (Lambda an (map toNamed ps) x, const [])
niceDotApp :: Exp_ -> Exp_ -> Exp_
niceDotApp a b | a ~= "$" = b
| otherwise = dotApp a b