Skip to content

Commit

Permalink
Remove ticks from Refact
Browse files Browse the repository at this point in the history
  • Loading branch information
@shayne-fletcher
shayne-fletcher committed May 11, 2020
1 parent dfe1de7 commit faa836b
Show file tree
Hide file tree
Showing 15 changed files with 75 additions and 78 deletions.
6 changes: 3 additions & 3 deletions src/GHC/Util/HsExpr.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ import Data.Generics.Uniplate.Data
import Data.List.Extra
import Data.Tuple.Extra

import Refact (toSS')
import Refact (toSS)
import Refact.Types hiding (SrcSpan, Match)
import qualified Refact.Types as R (SrcSpan)

Expand Down Expand Up @@ -212,7 +212,7 @@ niceLambdaR' [x] y
factor _ = Nothing
mkRefact :: [LHsExpr GhcPs] -> R.SrcSpan -> Refactoring R.SrcSpan
mkRefact subts s =
let tempSubts = zipWith (\a b -> ([a], toSS' b)) ['a' .. 'z'] subts
let tempSubts = zipWith (\a b -> ([a], toSS b)) ['a' .. 'z'] subts
template = dotApps' (map (strToVar . fst) tempSubts)
in Replace Expr s tempSubts (unsafePrettyPrint template)
-- Rewrite @\x y -> x + y@ as @(+)@.
Expand All @@ -222,7 +222,7 @@ niceLambdaR' [x,y] (L _ (OpApp _ (view' -> Var_' x1) op@(L _ HsVar {}) (view' ->
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"))]
, \s -> [Replace Expr s [("x", toSS op)] (unsafePrettyPrint $ gen (strToVar "x"))]
)
where
gen = noLoc . HsApp noExtField (strToVar "flip")
Expand Down
14 changes: 7 additions & 7 deletions src/Hint/Bracket.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,7 @@ loadCradleOnlyonce = skipManyTill anyMessage (message @PublishDiagnosticsNotific

module Hint.Bracket(bracketHint) where

import Hint.Type(DeclHint',Idea(..),rawIdea,warn,suggest,suggestRemove,Severity(..),toSS')
import Hint.Type(DeclHint',Idea(..),rawIdea,warn,suggest,suggestRemove,Severity(..),toSS)
import Data.Data
import Data.List.Extra
import Data.Generics.Uniplate.Operations
Expand Down Expand Up @@ -186,7 +186,7 @@ bracket pretty isPartialAtom root = f Nothing
rawIdea Suggestion msg (getLoc o) (pretty o) (Just (pretty (gen x))) [] [r] : g x
where
typ = findType (unLoc v)
r = Replace typ (toSS' v) [("x", toSS' x)] "x"
r = Replace typ (toSS v) [("x", toSS x)] "x"
-- Regardless of the context, there are no parentheses to remove
-- from 'x'.
f _ x = g x
Expand All @@ -198,11 +198,11 @@ bracket pretty isPartialAtom root = f Nothing

bracketWarning :: (HasSrcSpan a, HasSrcSpan b, Data (SrcSpanLess b), Outputable a, Outputable b) => String -> a -> b -> Idea
bracketWarning msg o x =
suggest msg o x [Replace (findType (unLoc x)) (toSS' o) [("x", toSS' x)] "x"]
suggest msg o x [Replace (findType (unLoc x)) (toSS o) [("x", toSS x)] "x"]

bracketError :: (HasSrcSpan a, HasSrcSpan b, Data (SrcSpanLess b), Outputable a, Outputable b ) => String -> a -> b -> Idea
bracketError msg o x =
warn msg o x [Replace (findType (unLoc x)) (toSS' o) [("x", toSS' x)] "x"]
warn msg o x [Replace (findType (unLoc x)) (toSS o) [("x", toSS x)] "x"]

fieldDecl :: LConDeclField GhcPs -> [Idea]
fieldDecl o@(L loc f@ConDeclField{cd_fld_type=v@(L l (HsParTy _ c))}) =
Expand All @@ -211,7 +211,7 @@ fieldDecl o@(L loc f@ConDeclField{cd_fld_type=v@(L l (HsParTy _ c))}) =
(showSDocUnsafe $ ppr_fld o) -- Note this custom printer!
(Just (showSDocUnsafe $ ppr_fld r))
[]
[Replace Type (toSS' v) [("x", toSS' c)] "x"]]
[Replace Type (toSS v) [("x", toSS c)] "x"]]
where
-- If we call 'unsafePrettyPrint' on a field decl, we won't like
-- the output (e.g. "[foo, bar] :: T"). Here we use a custom
Expand All @@ -235,15 +235,15 @@ dollar = concatMap f . universe
, not $ needBracket' 0 y a
, not $ needBracket' 1 y b
, not $ isPartialAtom b
, let r = Replace Expr (toSS' x) [("a", toSS' a), ("b", toSS' b)] "a b"]
, let r = Replace Expr (toSS x) [("a", toSS a), ("b", toSS b)] "a b"]
++
[ suggest "Move brackets to avoid $" x (t y) [r]
|(t, e@(L _ (HsPar _ (L _ (OpApp _ a1 op1 a2))))) <- splitInfix x
, isDol op1
, isVar a1 || isApp a1 || isPar a1, not $ isAtom' a2
, varToStr a1 /= "select" -- special case for esqueleto, see #224
, let y = noLoc $ HsApp noExtField a1 (noLoc (HsPar noExtField a2))
, let r = Replace Expr (toSS' e) [("a", toSS' a1), ("b", toSS' a2)] "a (b)" ]
, let r = Replace Expr (toSS e) [("a", toSS a1), ("b", toSS a2)] "a (b)" ]
++ -- Special case of (v1 . v2) <$> v3
[ suggest "Redundant bracket" x y []
| L _ (OpApp _ (L _ (HsPar _ o1@(L _ (OpApp _ v1 (isDot -> True) v2)))) o2 v3) <- [x], varToStr o2 == "<$>"
Expand Down
2 changes: 1 addition & 1 deletion src/Hint/Comment.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,4 +46,4 @@ commentHint _ m = concatMap chk (ghcComments m)
let s1 = commentText o in
rawIdea Suggestion msg pos (f s1) (Just $ f s2) [] refact
where f s = if isCommentMultiline o then "{-" ++ s ++ "-}" else "--" ++ s
refact = [ModifyComment (toRefactSrcSpan' pos) (f s2)]
refact = [ModifyComment (toRefactSrcSpan pos) (f s2)]
4 changes: 2 additions & 2 deletions src/Hint/Extensions.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -206,7 +206,7 @@ foo = \case True -> 3 -- {-# LANGUAGE LambdaCase, NoRebindableSyntax #-}

module Hint.Extensions(extensionsHint) where

import Hint.Type(ModuHint, rawIdea,Severity(Warning),Note(..),toSS',ghcAnnotations,ghcModule)
import Hint.Type(ModuHint, rawIdea,Severity(Warning),Note(..),toSS,ghcAnnotations,ghcModule)
import Extension

import Data.Generics.Uniplate.Operations
Expand Down Expand Up @@ -246,7 +246,7 @@ extensionsHint _ x =
( [RequiresExtension (show gone) | (_, Just x) <- before \\ after, gone <- Map.findWithDefault [] x disappear] ++
[ Note $ "Extension " ++ show x ++ " is " ++ reason x
| (_, Just x) <- explainedRemovals])
[ModifyComment (toSS' (mkLanguagePragmas sl exts)) newPragma]
[ModifyComment (toSS (mkLanguagePragmas sl exts)) newPragma]
| (L sl _, exts) <- languagePragmas $ pragmas (ghcAnnotations x)
, let before = [(x, readExtension x) | x <- exts]
, let after = filter (maybe True (`Set.member` keep) . snd) before
Expand Down
16 changes: 8 additions & 8 deletions src/Hint/Import.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@ import IO as X -- import System.IO as X; import System.IO.Error as X; import Con

module Hint.Import(importHint) where

import Hint.Type(ModuHint,ModuleEx(..),Idea(..),Severity(..),suggest,toSS',rawIdea,rawIdeaN)
import Hint.Type(ModuHint,ModuleEx(..),Idea(..),Severity(..),suggest,toSS,rawIdea,rawIdeaN)
import Refact.Types hiding (ModuleName)
import qualified Refact.Types as R
import Data.Tuple.Extra
Expand Down Expand Up @@ -101,25 +101,25 @@ combine :: LImportDecl GhcPs
-> Maybe (LImportDecl GhcPs, [Refactoring R.SrcSpan])
combine x@(L _ x') y@(L _ y')
-- Both (un/)qualified, common 'as', same names : Delete the second.
| qual, as, specs = Just (x, [Delete Import (toSS' y)])
| qual, as, specs = Just (x, [Delete Import (toSS y)])
-- Both (un/)qualified, common 'as', different names : Merge the
-- second into the first and delete it.
| qual, as
, Just (False, xs) <- ideclHiding x'
, Just (False, ys) <- ideclHiding y' =
let newImp = noLoc x'{ideclHiding = Just (False, noLoc (unLoc xs ++ unLoc ys))}
in Just (newImp, [Replace Import (toSS' x) [] (unsafePrettyPrint (unLoc newImp))
, Delete Import (toSS' y)])
in Just (newImp, [Replace Import (toSS x) [] (unsafePrettyPrint (unLoc newImp))
, Delete Import (toSS y)])
-- Both (un/qualified), common 'as', one has names the other doesn't
-- : Delete the one with names.
| qual, as, isNothing (ideclHiding x') || isNothing (ideclHiding y') =
let (newImp, toDelete) = if isNothing (ideclHiding x') then (x, y) else (y, x)
in Just (newImp, [Delete Import (toSS' toDelete)])
in Just (newImp, [Delete Import (toSS toDelete)])
-- Both unqualified, same names, one (and only one) has an 'as'
-- clause : Delete the one without an 'as'.
| ideclQualified x' == NotQualified, qual, specs, length ass == 1 =
let (newImp, toDelete) = if isJust (ideclAs x') then (x, y) else (y, x)
in Just (newImp, [Delete Import (toSS' toDelete)])
in Just (newImp, [Delete Import (toSS toDelete)])
-- No hints.
| otherwise = Nothing
where
Expand All @@ -138,7 +138,7 @@ stripRedundantAlias :: LImportDecl GhcPs -> [Idea]
stripRedundantAlias x@(L loc i@ImportDecl {..})
-- Suggest 'import M as M' be just 'import M'.
| Just (unLoc ideclName) == fmap unLoc ideclAs =
[suggest "Redundant as" x (cL loc i{ideclAs=Nothing} :: LImportDecl GhcPs) [RemoveAsKeyword (toSS' x)]]
[suggest "Redundant as" x (cL loc i{ideclAs=Nothing} :: LImportDecl GhcPs) [RemoveAsKeyword (toSS x)]]
stripRedundantAlias _ = []

preferHierarchicalImports :: LImportDecl GhcPs -> [Idea]
Expand All @@ -155,7 +155,7 @@ preferHierarchicalImports x@(L loc i@ImportDecl{ideclName=L _ n,ideclPkgQual=Not
-- its hiearchical equivalent e.g. 'Control.Monad'.
| Just y <- lookup (moduleNameString n) newNames =
let newModuleName = y ++ "." ++ moduleNameString n
r = [Replace R.ModuleName (toSS' x) [] newModuleName] in
r = [Replace R.ModuleName (toSS x) [] newModuleName] in
[suggest "Use hierarchical imports"
x (noLoc (desugarQual i){ideclName=noLoc (mkModuleName newModuleName)} :: LImportDecl GhcPs) r]
where
Expand Down
14 changes: 7 additions & 7 deletions src/Hint/Lambda.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -97,7 +97,7 @@ f = map (\s -> MkFoo s 0 s) ["a","b","c"]

module Hint.Lambda(lambdaHint) where

import Hint.Type (DeclHint', Idea, Note(RequiresExtension), suggest, warn, toSS', suggestN, ideaNote)
import Hint.Type (DeclHint', Idea, Note(RequiresExtension), suggest, warn, toSS, suggestN, ideaNote)
import Util
import Data.List.Extra
import qualified Data.Set as Set
Expand Down Expand Up @@ -131,11 +131,11 @@ lambdaDecl
| L _ (EmptyLocalBinds noExtField) <- bind
, isLambda $ fromParen' origBody
, null (universeBi pats :: [HsExpr GhcPs])
= [warn "Redundant lambda" o (gen pats origBody) [Replace Decl (toSS' o) s1 t1]]
= [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
= [warn "Eta reduce" (reform pats origBody) (reform pats2 bod2)
[ -- Disabled, see apply-refact #3
-- Replace Decl (toSS' $ reform' pats origBody) s2 t2]]
-- Replace Decl (toSS $ reform' pats origBody) s2 t2]]
]]
where reform :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsDecl GhcPs
reform ps b = L loc $ ValD noExtField $
Expand All @@ -150,7 +150,7 @@ lambdaDecl
(finalpats, body) = fromLambda . lambda pats $ origBody
(pats2, bod2) = etaReduce pats origBody
template fps = unsafePrettyPrint $ reform (zipWith munge ['a'..'z'] fps) varBody
subts fps b = ("body", toSS' b) : zipWith (\x y -> ([x],y)) ['a'..'z'] (map toSS' fps)
subts fps b = ("body", toSS b) : zipWith (\x y -> ([x],y)) ['a'..'z'] (map toSS fps)
s1 = subts finalpats body
--s2 = subts pats2 bod2
t1 = template finalpats
Expand Down Expand Up @@ -186,21 +186,21 @@ lambdaExp p o@(L _ HsLam{})
, not $ any isQuasiQuote $ universe res
, not $ "runST" `Set.member` Set.map occNameString (freeVars' o)
, let name = "Avoid lambda" ++ (if countRightSections res > countRightSections o then " using `infix`" else "")
= [(if isVar res then warn else suggest) name o res (refact $ toSS' o)]
= [(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]
lambdaExp p o@(SimpleLambda origPats 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]]
[suggest "Collapse lambdas" o (lambda pats body) [Replace Expr (toSS o) subts template]]
where
(pats, body) = fromLambda o

template = unsafePrettyPrint $ lambda (zipWith munge ['a'..'z'] pats) varBody

subts = ("body", toSS' body) : zipWith (\x y -> ([x],y)) ['a'..'z'] (map toSS' pats)
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)) =
Expand Down
16 changes: 8 additions & 8 deletions src/Hint/List.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ import Data.List.Extra
import Data.Maybe
import Prelude

import Hint.Type(DeclHint',Idea,suggest,toRefactSrcSpan',toSS')
import Hint.Type(DeclHint',Idea,suggest,toRefactSrcSpan,toSS)

import Refact.Types hiding (SrcSpan)
import qualified Refact.Types as R
Expand Down Expand Up @@ -124,7 +124,7 @@ listCompCheckMap o mp f ctx stmts | varToStr mp == "map" =
listCompCheckMap _ _ _ _ _ = []

suggestExpr :: LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring R.SrcSpan]
suggestExpr o o2 = [Replace Expr (toSS' o) [] (unsafePrettyPrint o2)]
suggestExpr o o2 = [Replace Expr (toSS o) [] (unsafePrettyPrint o2)]

moveGuardsForward :: [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
moveGuardsForward = reverse . f [] . reverse
Expand Down Expand Up @@ -156,14 +156,14 @@ listExp b (fromParen' -> x) =
res = [suggest name x x2 [r]
| (name, f) <- checks
, Just (x2, subts, temp) <- [f b x]
, let r = Replace Expr (toSS' x) subts temp ]
, let r = Replace Expr (toSS x) subts temp ]

listPat :: LPat GhcPs -> [Idea]
listPat x = if null res then concatMap listPat $ children x else [head res]
where res = [suggest name x x2 [r]
| (name, f) <- pchecks
, Just (x2, subts, temp) <- [f x]
, let r = Replace Pattern (toSS' x) subts temp ]
, let r = Replace Pattern (toSS x) subts temp ]
isAppend :: View' a App2' => a -> Bool
isAppend (view' -> App2' op _ _) = varToStr op == "++"
isAppend _ = False
Expand Down Expand Up @@ -191,7 +191,7 @@ usePList :: LPat GhcPs -> Maybe (LPat GhcPs, [(String, R.SrcSpan)], String)
usePList =
fmap ( (\(e, s) ->
(noLoc (ListPat noExtField e)
, map (fmap toRefactSrcSpan' . fst) s
, map (fmap toRefactSrcSpan . fst) s
, unsafePrettyPrint (noLoc $ ListPat noExtField (map snd s) :: LPat GhcPs))
)
. unzip
Expand All @@ -215,7 +215,7 @@ useList :: p -> LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [(String, R.SrcSpan)], St
useList b =
fmap ( (\(e, s) ->
(noLoc (ExplicitList noExtField Nothing e)
, map (fmap toSS') s
, map (fmap toSS) s
, unsafePrettyPrint (noLoc $ ExplicitList noExtField Nothing (map snd s) :: LHsExpr GhcPs))
)
. unzip
Expand All @@ -235,7 +235,7 @@ useCons False (view' -> App2' op x y) | varToStr op == "++"
, Just (x2, build) <- f x
, not $ isAppend y =
Just (gen (build x2) y
, [("x", toSS' x2), ("xs", toSS' y)]
, [("x", toSS x2), ("xs", toSS y)]
, unsafePrettyPrint $ gen (build $ strToVar "x") (strToVar "xs")
)
where
Expand Down Expand Up @@ -272,4 +272,4 @@ stringType (L _ x) = case x of
g e@(fromTyParen -> x) = [suggest "Use String" x (transform f x)
rs | not . null $ rs]
where f x = if astEq x typeListChar then typeString else x
rs = [Replace Type (toSS' t) [] (unsafePrettyPrint typeString) | t <- universe x, astEq t typeListChar]
rs = [Replace Type (toSS t) [] (unsafePrettyPrint typeString) | t <- universe x, astEq t typeListChar]
4 changes: 2 additions & 2 deletions src/Hint/ListRec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ fun [] = []; fun (x:xs) = f x xs ++ fun xs

module Hint.ListRec(listRecHint) where

import Hint.Type (DeclHint', Severity(Suggestion, Warning), idea, toSS')
import Hint.Type (DeclHint', Severity(Suggestion, Warning), idea, toSS)

import Data.Generics.Uniplate.Operations
import Data.List.Extra
Expand Down Expand Up @@ -69,7 +69,7 @@ listRecHint _ _ = concatMap f . universe
guard $ recursiveStr `notElem` varss' y
-- Maybe we can do better here maintaining source
-- formatting?
pure $ idea severity ("Use " ++ use) o y [Replace Decl (toSS' o) [] (unsafePrettyPrint y)]
pure $ idea severity ("Use " ++ use) o y [Replace Decl (toSS o) [] (unsafePrettyPrint y)]

recursiveStr :: String
recursiveStr = "_recursive_"
Expand Down
6 changes: 3 additions & 3 deletions src/Hint/Match.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@ not . not . x ==> x

module Hint.Match(readMatch') where

import Hint.Type (ModuleEx,Idea,idea,ideaNote,toSS')
import Hint.Type (ModuleEx,Idea,idea,ideaNote,toSS)
import Util
import Timing
import qualified Data.Set as Set
Expand Down Expand Up @@ -112,7 +112,7 @@ findIdeas' matches s _ decl = timed "Hint" "Match apply" $ forceList
| (name, expr) <- findDecls' decl
, (parent,x) <- universeParentExp' expr
, m <- matches, Just (y, tpl, notes, subst) <- [matchIdea s name m parent x]
, let r = R.Replace R.Expr (toSS' x) subst (unsafePrettyPrint tpl)
, let r = R.Replace R.Expr (toSS x) subst (unsafePrettyPrint tpl)
]

-- | A list of root expressions, with their associated names
Expand Down Expand Up @@ -161,7 +161,7 @@ matchIdea sb declName HintRule{..} parent x = do
(u, tpl) <- pure $ if any ((== noSrcSpan) . getLoc . snd) (fromSubst' u) then (mempty, res) else (u, tpl)
tpl <- pure $ unqualify' sa sb (performSpecial' tpl)

pure (res, tpl, hintRuleNotes, [(s, toSS' pos) | (s, pos) <- fromSubst' u, getLoc pos /= noSrcSpan])
pure (res, tpl, hintRuleNotes, [(s, toSS pos) | (s, pos) <- fromSubst' u, getLoc pos /= noSrcSpan])

---------------------------------------------------------------------
-- SIDE CONDITIONS
Expand Down
Loading

0 comments on commit faa836b

Please sign in to comment.