Remove ticks from View

ndmitchell · May 12, 2020 · 4ec9f14 · 4ec9f14
1 parent 1cced2f
commit 4ec9f14
Show file tree

Hide file tree

Showing 9 changed files with 105 additions and 105 deletions.
diff --git a/src/Config/Compute.hs b/src/Config/Compute.hs
@@ -66,9 +66,9 @@ findExp name vs (OpApp _ x dot y) | isDot dot = findExp name (vs++["_hlint"]) $
 
 findExp name vs bod = [SettingMatchExp $
         HintRule Warning defaultHintName []
-        mempty (extendInstances lhs) (extendInstances $ fromParen' rhs) Nothing]
+        mempty (extendInstances lhs) (extendInstances $ fromParen rhs) Nothing]
     where
-        lhs = fromParen' $ noLoc $ transform f bod
+        lhs = fromParen $ noLoc $ transform f bod
         rhs = apps' $ map noLoc $ HsVar noExtField (noLoc name) : map snd rep
 
         rep = zip vs $ map (mkVar . pure) ['a'..]

diff --git a/src/GHC/Util/HsExpr.hs b/src/GHC/Util/HsExpr.hs
@@ -124,7 +124,7 @@ simplifyExp' e@(L _ (HsLet _ (L _ (HsValBinds _ (ValBinds _ binds []))) z)) =
          -- 'z[(y)/x]'.
       | occNameString (rdrNameOcc x) `notElem` vars' y && length [() | Unqual a <- universeBi z, a == rdrNameOcc x] <= 1 ->
           transform f z
-          where f (view' -> Var_' x') | occNameString (rdrNameOcc x) == x' = paren' y
+          where f (view -> Var_ x') | occNameString (rdrNameOcc x) == x' = paren' y
                 f x = x
     _ -> e
 simplifyExp' e = e
@@ -159,15 +159,15 @@ niceLambdaR' xs (L _ (HsPar _ x)) = niceLambdaR' xs x
 
 -- @\vs v -> ($) e v@ ==> @\vs -> e@
 -- @\vs v -> e $ v@ ==> @\vs -> e@
-niceLambdaR' (unsnoc -> Just (vs, v)) (view' -> App2' f e (view' -> Var_' v'))
+niceLambdaR' (unsnoc -> Just (vs, v)) (view -> App2 f e (view -> Var_ v'))
   | isDol f
   , v == v'
   , vars' e `disjoint` [v]
   = niceLambdaR' vs e
 
 -- @\v -> thing + v@ ==> @\v -> (thing +)@  (heuristic: @v@ must be a single
 -- lexeme, or it all gets too complex)
-niceLambdaR' [v] (L _ (OpApp _ e f (view' -> Var_' v')))
+niceLambdaR' [v] (L _ (OpApp _ e f (view -> Var_ v')))
   | isLexeme e
   , v == v'
   , vars' e `disjoint` [v]
@@ -176,23 +176,23 @@ niceLambdaR' [v] (L _ (OpApp _ e f (view' -> Var_' v')))
   = (noLoc $ HsPar noExtField $ noLoc $ SectionL noExtField e f, \s -> [Replace Expr s [] (unsafePrettyPrint e)])
 
 -- @\vs v -> f x v@ ==> @\vs -> f x@
-niceLambdaR' (unsnoc -> Just (vs, v)) (L _ (HsApp _ f (view' -> Var_' v')))
+niceLambdaR' (unsnoc -> Just (vs, v)) (L _ (HsApp _ f (view -> Var_ v')))
   | v == v'
   , vars' f `disjoint` [v]
   = niceLambdaR' vs f
 
 -- @\vs v -> (v `f`)@ ==> @\vs -> f@
-niceLambdaR' (unsnoc -> Just (vs, v)) (L _ (SectionL _ (view' -> Var_' v') f))
+niceLambdaR' (unsnoc -> Just (vs, v)) (L _ (SectionL _ (view -> Var_ v') f))
   | v == v' = niceLambdaR' vs f
 
 -- Strip one variable pattern from the end of a lambdas match, and place it in our list of factoring variables.
-niceLambdaR' xs (SimpleLambda ((view' -> PVar_' v):vs) x)
+niceLambdaR' xs (SimpleLambda ((view -> PVar_ v):vs) x)
   | v `notElem` xs = niceLambdaR' (xs++[v]) $ lambda vs x
 
 -- Rewrite @\x -> x + a@ as @(+ a)@ (heuristic: @a@ must be a single
 -- lexeme, or it all gets too complex).
-niceLambdaR' [x] (view' -> App2' op@(L _ (HsVar _ (L _ tag))) l r)
-  | isLexeme r, view' l == Var_' x, x `notElem` vars' r, allowRightSection (occNameString $ rdrNameOcc tag) =
+niceLambdaR' [x] (view -> App2 op@(L _ (HsVar _ (L _ tag))) l r)
+  | isLexeme r, view l == Var_ x, x `notElem` vars' r, allowRightSection (occNameString $ rdrNameOcc tag) =
       let e = rebracket1' $ addParen (noLoc $ SectionR noExtField op r)
       in (e, \s -> [Replace Expr s [] (unsafePrettyPrint e)])
 -- Rewrite (1) @\x -> f (b x)@ as @f . b@, (2) @\x -> f $ b x@ as @f . b@.
@@ -201,7 +201,7 @@ niceLambdaR' [x] y
   where
     -- Factor the expression with respect to x.
     factor :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [LHsExpr GhcPs])
-    factor y@(L _ (HsApp _ ini lst)) | view' lst == Var_' x = Just (ini, [ini])
+    factor y@(L _ (HsApp _ ini lst)) | view lst == Var_ x = Just (ini, [ini])
     factor y@(L _ (HsApp _ ini lst)) | Just (z, ss) <- factor lst
       = let r = niceDotApp' ini z
         in if astEq r z then Just (r, ss) else Just (r, ini : ss)
@@ -216,10 +216,10 @@ niceLambdaR' [x] y
           template = dotApps' (map (strToVar . fst) tempSubts)
       in Replace Expr s tempSubts (unsafePrettyPrint template)
 -- Rewrite @\x y -> x + y@ as @(+)@.
-niceLambdaR' [x,y] (L _ (OpApp _ (view' -> Var_' x1) op@(L _ HsVar {}) (view' -> Var_' y1)))
+niceLambdaR' [x,y] (L _ (OpApp _ (view -> Var_ x1) op@(L _ HsVar {}) (view -> Var_ y1)))
     | x == x1, y == y1, vars' op `disjoint` [x, y] = (op, \s -> [Replace Expr s [] (unsafePrettyPrint op)])
 -- Rewrite @\x y -> f y x@ as @flip f@.
-niceLambdaR' [x, y] (view' -> App2' op (view' -> Var_' y1) (view' -> Var_' x1))
+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)] (unsafePrettyPrint $ gen (strToVar "x"))]

diff --git a/src/GHC/Util/Unify.hs b/src/GHC/Util/Unify.hs
@@ -58,7 +58,7 @@ validSubst' eq = fmap Subst' . mapM f . groupSort . fromSubst'
 -- for which brackets should be removed from their substitutions.
 removeParens :: [String] -> Subst' (LHsExpr GhcPs) -> Subst' (LHsExpr GhcPs)
 removeParens noParens (Subst' xs) = Subst' $
-  map (\(x, y) -> if x `elem` noParens then (x, fromParen' y) else (x, y)) xs
+  map (\(x, y) -> if x `elem` noParens then (x, fromParen y) else (x, y)) xs
 
 -- Peform a substition.
 -- Returns (suggested replacement, refactor template), both with brackets added
@@ -149,7 +149,7 @@ unifyExp nm root x@(L _ (HsApp _ x1 x2)) (L _ (HsApp _ y1 y2)) =
   where
     -- Unify a function application where the function is a composition of functions.
     unifyComposed
-      | (L _ (OpApp _ y11 dot y12)) <- fromParen' y1, isDot dot =
+      | (L _ (OpApp _ y11 dot y12)) <- fromParen y1, isDot dot =
           -- Attempt #1: rewrite '(fun1 . fun2) arg' as 'fun1 (fun2 arg)', and unify it with 'x'.
           -- The guard ensures that you don't get duplicate matches because the matching engine
           -- auto-generates hints in dot-form.
@@ -178,7 +178,7 @@ unifyExp nm root x y = (, Nothing) <$> unifyExp' nm root x y
 unifyExp' :: NameMatch' -> Bool -> LHsExpr GhcPs -> LHsExpr GhcPs -> Maybe (Subst' (LHsExpr GhcPs) )
 -- Brackets are not added when expanding '$' in user code, so tolerate
 -- them in the match even if they aren't in the user code.
-unifyExp' nm root x y | not root, isPar x, not $ isPar y = unifyExp' nm root (fromParen' x) y
+unifyExp' nm root x y | not root, isPar x, not $ isPar y = unifyExp' nm root (fromParen x) y
 -- Don't subsitute for type apps, since no one writes rules imaginging
 -- they exist.
 unifyExp' nm root (L _ (HsVar _ (rdrNameStr' -> v))) y | isUnifyVar v, not $ isTypeApp y = Just $ Subst' [(v, y)]

diff --git a/src/GHC/Util/View.hs b/src/GHC/Util/View.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE ViewPatterns, MultiParamTypeClasses, FlexibleInstances, PatternSynonyms #-}
 
 module GHC.Util.View (
-   fromParen'
-  , View'(..)
-  , Var_'(Var_'), PVar_'(PVar_'), PApp_'(PApp_'), App2'(App2'),LamConst1'(LamConst1')
+   fromParen
+  , View(..)
+  , Var_(Var_), PVar_(PVar_), PApp_(PApp_), App2(App2),LamConst1(LamConst1)
   , pattern SimpleLambda
 ) where
 
@@ -14,47 +14,47 @@ import OccName
 import BasicTypes
 import GHC.Util.RdrName (rdrNameStr')
 
-fromParen' :: LHsExpr GhcPs -> LHsExpr GhcPs
-fromParen' (L _ (HsPar _ x)) = fromParen' x
-fromParen' x = x
-
-fromPParen' :: LPat GhcPs -> LPat GhcPs
-fromPParen' (L _ (ParPat _ x)) = fromPParen' x
-fromPParen' x = x
-
-class View' a b where
-  view' :: a -> b
-
-data Var_'  = NoVar_' | Var_' String deriving Eq
-data PVar_' = NoPVar_' | PVar_' String
-data PApp_' = NoPApp_' | PApp_' String [LPat GhcPs]
-data App2'  = NoApp2'  | App2' (LHsExpr GhcPs) (LHsExpr GhcPs) (LHsExpr GhcPs)
-data LamConst1' = NoLamConst1' | LamConst1' (LHsExpr GhcPs)
-
-instance View' (LHsExpr GhcPs) LamConst1' where
-  view' (fromParen' -> (L _ (HsLam _ (MG _ (L _ [L _ (Match _ LambdaExpr [L _ WildPat {}]
-    (GRHSs _ [L _ (GRHS _ [] x)] (L _ (EmptyLocalBinds _))))]) FromSource)))) = LamConst1' x
-  view' _ = NoLamConst1'
-
-instance View' (LHsExpr GhcPs) Var_' where
-    view' (fromParen' -> (L _ (HsVar _ (rdrNameStr' -> x)))) = Var_' x
-    view' _ = NoVar_'
-
-instance View' (LHsExpr GhcPs) App2' where
-  view' (fromParen' -> L _ (OpApp _ lhs op rhs)) = App2' op lhs rhs
-  view' (fromParen' -> L _ (HsApp _ (L _ (HsApp _ f x)) y)) = App2' f x y
-  view' _ = NoApp2'
-
-instance View' (Located (Pat GhcPs)) PVar_' where
-  view' (fromPParen' -> L _ (VarPat _ (L _ x))) = PVar_' $ occNameString (rdrNameOcc x)
-  view' _ = NoPVar_'
-
-instance View' (Located (Pat GhcPs)) PApp_' where
-  view' (fromPParen' -> L _ (ConPatIn (L _ x) (PrefixCon args))) =
-    PApp_' (occNameString . rdrNameOcc $ x) args
-  view' (fromPParen' -> L _ (ConPatIn (L _ x) (InfixCon lhs rhs))) =
-    PApp_' (occNameString . rdrNameOcc $ x) [lhs, rhs]
-  view' _ = NoPApp_'
+fromParen :: LHsExpr GhcPs -> LHsExpr GhcPs
+fromParen (L _ (HsPar _ x)) = fromParen x
+fromParen x = x
+
+fromPParen :: LPat GhcPs -> LPat GhcPs
+fromPParen (L _ (ParPat _ x)) = fromPParen x
+fromPParen x = x
+
+class View a b where
+  view :: a -> b
+
+data Var_  = NoVar_ | Var_ String deriving Eq
+data PVar_ = NoPVar_ | PVar_ String
+data PApp_ = NoPApp_ | PApp_ String [LPat GhcPs]
+data App2  = NoApp2  | App2 (LHsExpr GhcPs) (LHsExpr GhcPs) (LHsExpr GhcPs)
+data LamConst1 = NoLamConst1 | LamConst1 (LHsExpr GhcPs)
+
+instance View (LHsExpr GhcPs) LamConst1 where
+  view (fromParen -> (L _ (HsLam _ (MG _ (L _ [L _ (Match _ LambdaExpr [L _ WildPat {}]
+    (GRHSs _ [L _ (GRHS _ [] x)] (L _ (EmptyLocalBinds _))))]) FromSource)))) = LamConst1 x
+  view _ = NoLamConst1
+
+instance View (LHsExpr GhcPs) Var_ where
+    view (fromParen -> (L _ (HsVar _ (rdrNameStr' -> x)))) = Var_ x
+    view _ = NoVar_
+
+instance View (LHsExpr GhcPs) App2 where
+  view (fromParen -> L _ (OpApp _ lhs op rhs)) = App2 op lhs rhs
+  view (fromParen -> L _ (HsApp _ (L _ (HsApp _ f x)) y)) = App2 f x y
+  view _ = NoApp2
+
+instance View (Located (Pat GhcPs)) PVar_ where
+  view (fromPParen -> L _ (VarPat _ (L _ x))) = PVar_ $ occNameString (rdrNameOcc x)
+  view _ = NoPVar_
+
+instance View (Located (Pat GhcPs)) PApp_ where
+  view (fromPParen -> L _ (ConPatIn (L _ x) (PrefixCon args))) =
+    PApp_ (occNameString . rdrNameOcc $ x) args
+  view (fromPParen -> L _ (ConPatIn (L _ x) (InfixCon lhs rhs))) =
+    PApp_ (occNameString . rdrNameOcc $ x) [lhs, rhs]
+  view _ = NoPApp_
 
 -- A lambda with no guards and no where clauses
 pattern SimpleLambda :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs

diff --git a/src/Hint/Lambda.hs b/src/Hint/Lambda.hs
@@ -129,7 +129,7 @@ lambdaDecl
             MG {mg_alts =
                 L _ [L _ (Match _ ctxt@(FunRhs _ Prefix _) pats (GRHSs _ [L _ (GRHS _ [] origBody@(L loc2 _))] bind))]}}))
     | L _ (EmptyLocalBinds noExtField) <- bind
-    , isLambda $ fromParen' origBody
+    , isLambda $ fromParen origBody
     , null (universeBi pats :: [HsExpr GhcPs])
     = [warn "Redundant lambda" o (gen pats origBody) [Replace Decl (toSS o) s1 t1]]
     | length pats2 < length pats, pvars' (drop (length pats2) pats) `disjoint` varss' bind
@@ -159,7 +159,7 @@ lambdaDecl _ = []
 
 
 etaReduce :: [LPat GhcPs] -> LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
-etaReduce (unsnoc -> Just (ps, view' -> PVar_' p)) (L _ (HsApp _ x (view' -> Var_' y)))
+etaReduce (unsnoc -> Just (ps, view -> PVar_ p)) (L _ (HsApp _ x (view -> Var_ y)))
     | p == y
     , y `notElem` vars' x
     , not $ any isQuasiQuote $ universe x
@@ -176,7 +176,7 @@ lambdaExp _ o@(L _ (HsPar _ (L _ (HsApp _ oper@(L _ (HsVar _ (L _ (rdrNameOcc ->
     , not $ isTypeApp y =
       [suggestN "Use section" o $ noLoc $ HsPar noExtField $ noLoc $ SectionL noExtField y oper]
 
-lambdaExp _ o@(L _ (HsPar _ (view' -> App2' (view' -> Var_' "flip") origf@(view' -> Var_' f) y)))
+lambdaExp _ o@(L _ (HsPar _ (view -> App2 (view -> Var_ "flip") origf@(view -> Var_ f) y)))
     | allowRightSection f, not $ "(" `isPrefixOf` f
     = [suggestN "Use section" o $ noLoc $ HsPar noExtField $ noLoc $ SectionR noExtField origf y]
 lambdaExp p o@(L _ HsLam{})
@@ -189,9 +189,9 @@ lambdaExp p o@(L _ HsLam{})
     = [(if isVar res then warn else suggest) name o res (refact $ toSS o)]
     where
         countRightSections :: LHsExpr GhcPs -> Int
-        countRightSections x = length [() | L _ (SectionR _ (view' -> Var_' _) _) <- universe x]
+        countRightSections x = length [() | L _ (SectionR _ (view -> Var_ _) _) <- universe x]
 lambdaExp p o@(SimpleLambda origPats origBody)
-    | isLambda (fromParen' origBody)
+    | isLambda (fromParen origBody)
     , null (universeBi origPats :: [HsExpr GhcPs]) -- TODO: I think this checks for view patterns only, so maybe be more explicit about that?
     , maybe True (not . isLambda) p =
     [suggest "Collapse lambdas" o (lambda pats body) [Replace Expr (toSS o) subts template]]
@@ -203,7 +203,7 @@ lambdaExp p o@(SimpleLambda origPats origBody)
       subts = ("body", toSS body) : zipWith (\x y -> ([x],y)) ['a'..'z'] (map toSS pats)
 
 -- match a lambda with a variable pattern, with no guards and no where clauses
-lambdaExp _ o@(SimpleLambda [view' -> PVar_' x] (L _ expr)) =
+lambdaExp _ o@(SimpleLambda [view -> PVar_ x] (L _ expr)) =
     case expr of
         -- suggest TupleSections instead of lambdas
         ExplicitTuple _ args boxity
@@ -215,7 +215,7 @@ lambdaExp _ o@(SimpleLambda [view' -> PVar_' x] (L _ expr)) =
                   {ideaNote = [RequiresExtension "TupleSections"]}]
 
         -- suggest @LambdaCase@/directly matching in a lambda instead of doing @\x -> case x of ...@
-        HsCase _ (view' -> Var_' x') matchGroup
+        HsCase _ (view -> Var_ x') matchGroup
             -- is the case being done on the variable from our original lambda?
             | x == x'
             -- x must not be used in some other way inside the matches
@@ -246,12 +246,12 @@ lambdaExp _ o@(SimpleLambda [view' -> PVar_' x] (L _ expr)) =
         -- | Filter out tuple arguments, converting the @x@ (matched in the lambda) variable argument
         -- to a missing argument, so that we get the proper section.
         removeX :: LHsTupArg GhcPs -> LHsTupArg GhcPs
-        removeX arg@(L _ (Present _ (view' -> Var_' x')))
+        removeX arg@(L _ (Present _ (view -> Var_ x')))
             | x == x' = noLoc $ Missing noExtField
         removeX y = y
         -- | Extract the name of an argument of a tuple if it's present and a variable.
         tupArgVar :: LHsTupArg GhcPs -> Maybe String
-        tupArgVar (L _ (Present _ (view' -> Var_' x))) = Just x
+        tupArgVar (L _ (Present _ (view -> Var_ x))) = Just x
         tupArgVar _ = Nothing
 
 lambdaExp _ _ = []
@@ -261,7 +261,7 @@ varBody = strToVar "body"
 
 -- | Squash lambdas and replace any repeated pattern variable with @_@
 fromLambda :: LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
-fromLambda (SimpleLambda ps1 (fromLambda . fromParen' -> (ps2,x))) = (transformBi (f $ pvars' ps2) ps1 ++ ps2, x)
+fromLambda (SimpleLambda ps1 (fromLambda . fromParen -> (ps2,x))) = (transformBi (f $ pvars' ps2) ps1 ++ ps2, x)
     where f :: [String] -> Pat GhcPs -> Pat GhcPs
           f bad (VarPat _ (rdrNameStr' -> x))
               | x `elem` bad = WildPat noExtField

diff --git a/src/Hint/List.hs b/src/Hint/List.hs
@@ -84,9 +84,9 @@ listComp o@(L _ (HsDo _ ListComp (L _ stmts))) =
 listComp o@(L _ (HsDo _ MonadComp (L _ stmts))) =
   listCompCheckGuards o MonadComp stmts
 
-listComp o@(view' -> App2' mp f (L _ (HsDo _ ListComp (L _ stmts)))) =
+listComp o@(view -> App2 mp f (L _ (HsDo _ ListComp (L _ stmts)))) =
   listCompCheckMap o mp f ListComp stmts
-listComp o@(view' -> App2' mp f (L _ (HsDo _ MonadComp (L _ stmts)))) =
+listComp o@(view -> App2 mp f (L _ (HsDo _ MonadComp (L _ stmts)))) =
   listCompCheckMap o mp f MonadComp stmts
 listComp _ = []
 
@@ -150,7 +150,7 @@ moveGuardsForward = reverse . f [] . reverse
     f guards xs = reverse guards ++ xs
 
 listExp :: Bool -> LHsExpr GhcPs -> [Idea]
-listExp b (fromParen' -> x) =
+listExp b (fromParen -> x) =
   if null res then concatMap (listExp $ isAppend x) $ children x else [head res]
   where
     res = [suggest name x x2 [r]
@@ -164,8 +164,8 @@ listPat x = if null res then concatMap listPat $ children x else [head res]
                   | (name, f) <- pchecks
                   , Just (x2, subts, temp) <- [f x]
                   , let r = Replace Pattern (toSS x) subts temp ]
-isAppend :: View' a App2' => a -> Bool
-isAppend (view' -> App2' op _ _) = varToStr op == "++"
+isAppend :: View a App2 => a -> Bool
+isAppend (view -> App2 op _ _) = varToStr op == "++"
 isAppend _ = False
 
 checks ::[(String, Bool -> LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [(String, R.SrcSpan)], String))]
@@ -199,7 +199,7 @@ usePList =
   . f True ['a'..'z']
   where
     f first _ x | patToStr x == "[]" = if first then Nothing else Just []
-    f first (ident:cs) (view' -> PApp_' ":" [a, b]) = ((a, g ident a) :) <$> f False cs b
+    f first (ident:cs) (view -> PApp_ ":" [a, b]) = ((a, g ident a) :) <$> f False cs b
     f first _ _ = Nothing
 
     g :: Char -> LPat GhcPs -> ((String, SrcSpan), LPat GhcPs)
@@ -223,15 +223,15 @@ useList b =
   . f True ['a'..'z']
   where
     f first _ x | varToStr x == "[]" = if first then Nothing else Just []
-    f first (ident:cs) (view' -> App2' c a b) | varToStr c == ":" =
+    f first (ident:cs) (view -> App2 c a b) | varToStr c == ":" =
           ((a, g ident a) :) <$> f False cs b
     f first _ _ = Nothing
 
     g :: Char -> LHsExpr GhcPs -> (String, LHsExpr GhcPs)
     g c p = ([c], L (getLoc p) (unLoc $ strToVar [c]))
 
-useCons :: View' a App2' => Bool -> a -> Maybe (LHsExpr GhcPs, [(String, R.SrcSpan)], String)
-useCons False (view' -> App2' op x y) | varToStr op == "++"
+useCons :: View a App2 => Bool -> a -> Maybe (LHsExpr GhcPs, [(String, R.SrcSpan)], String)
+useCons False (view -> App2 op x y) | varToStr op == "++"
                                        , Just (x2, build) <- f x
                                        , not $ isAppend y =
     Just (gen (build x2) y