{-# LANGUAGE ViewPatterns, PatternGuards, TypeFamilies #-}
module Hint.Pattern(patternHint) where
import Hint.Type(DeclHint,Idea,ghcAnnotations,ideaTo,toSS,toRefactSrcSpan,suggest,suggestRemove,warn)
import Data.Generics.Uniplate.DataOnly
import Data.Function
import Data.List.Extra
import Data.Tuple
import Data.Maybe
import Data.Either
import Refact.Types hiding (RType(Pattern, Match), SrcSpan)
import qualified Refact.Types as R (RType(Pattern, Match), SrcSpan)
import GHC.Hs
import GHC.Types.SrcLoc
import GHC.Types.Name.Reader
import GHC.Types.Name.Occurrence
import GHC.Data.Bag
import GHC.Types.Basic
import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Hs.Pat
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
patternHint :: DeclHint
patternHint :: DeclHint
patternHint Scope
_scope ModuleEx
modu LHsDecl GhcPs
x =
((Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)
-> [Idea])
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
-> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((String -> Pattern -> [Refactoring SrcSpan] -> Idea)
-> Pattern -> [Idea])
-> (String -> Pattern -> [Refactoring SrcSpan] -> Idea, Pattern)
-> [Idea]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> Pattern -> [Refactoring SrcSpan] -> Idea)
-> Pattern -> [Idea]
hints ((String -> Pattern -> [Refactoring SrcSpan] -> Idea, Pattern)
-> [Idea])
-> ((Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)
-> (String -> Pattern -> [Refactoring SrcSpan] -> Idea, Pattern))
-> (Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)
-> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)
-> (String -> Pattern -> [Refactoring SrcSpan] -> Idea, Pattern)
forall a b. (a, b) -> (b, a)
swap) (LHsDecl GhcPs
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
asPattern LHsDecl GhcPs
x) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
(Located (Pat GhcPs) -> [Idea]) -> [Located (Pat GhcPs)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Bool -> LPat GhcPs -> [Idea]
patHint Bool
strict Bool
False) [LPat GhcPs
Located (Pat GhcPs)
p | PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
p GRHSs GhcPs (LHsExpr GhcPs)
_ ([Tickish Id], [[Tickish Id]])
_ <- LHsDecl GhcPs -> [HsBindLR GhcPs GhcPs]
forall from to. Biplate from to => from -> [to]
universeBi LHsDecl GhcPs
x :: [HsBind GhcPs]] [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
(Located (Pat GhcPs) -> [Idea]) -> [Located (Pat GhcPs)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Bool -> LPat GhcPs -> [Idea]
patHint Bool
strict Bool
True) (LHsDecl GhcPs -> [Located (Pat GhcPs)]
forall from to. Biplate from to => from -> [to]
universeBi (LHsDecl GhcPs -> [Located (Pat GhcPs)])
-> LHsDecl GhcPs -> [Located (Pat GhcPs)]
forall a b. (a -> b) -> a -> b
$ (LHsBind GhcPs -> LHsBind GhcPs) -> LHsDecl GhcPs -> LHsDecl GhcPs
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi LHsBind GhcPs -> LHsBind GhcPs
noPatBind LHsDecl GhcPs
x) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
(LHsExpr GhcPs -> [Idea]) -> [LHsExpr GhcPs] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsExpr GhcPs -> [Idea]
expHint (LHsDecl GhcPs -> [LHsExpr GhcPs]
forall from to. Biplate from to => from -> [to]
universeBi LHsDecl GhcPs
x)
where
exts :: [String]
exts = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((Located AnnotationComment, [String]) -> [String])
-> [(Located AnnotationComment, [String])] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Located AnnotationComment, [String]) -> [String]
forall a b. (a, b) -> b
snd ([(Located AnnotationComment, String)]
-> [(Located AnnotationComment, [String])]
languagePragmas (ApiAnns -> [(Located AnnotationComment, String)]
pragmas (ModuleEx -> ApiAnns
ghcAnnotations ModuleEx
modu)))
strict :: Bool
strict = String
"Strict" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
exts
noPatBind :: LHsBind GhcPs -> LHsBind GhcPs
noPatBind :: LHsBind GhcPs -> LHsBind GhcPs
noPatBind (L SrcSpan
loc a :: HsBindLR GhcPs GhcPs
a@PatBind{}) = SrcSpan -> HsBindLR GhcPs GhcPs -> LHsBind GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc HsBindLR GhcPs GhcPs
a{pat_lhs :: LPat GhcPs
pat_lhs=Pat GhcPs -> Located (Pat GhcPs)
forall e. e -> Located e
noLoc (XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> Pat p
WildPat NoExtField
XWildPat GhcPs
noExtField)}
noPatBind LHsBind GhcPs
x = LHsBind GhcPs
x
hints :: (String -> Pattern -> [Refactoring R.SrcSpan] -> Idea) -> Pattern -> [Idea]
hints :: (String -> Pattern -> [Refactoring SrcSpan] -> Idea)
-> Pattern -> [Idea]
hints String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen (Pattern SrcSpan
l RType
rtype [LPat GhcPs]
pat (GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ [L SrcSpan
_ (GRHS XCGRHS GhcPs (LHsExpr GhcPs)
_ [] LHsExpr GhcPs
bod)] LHsLocalBinds GhcPs
bind))
| [LGRHS GhcPs (LHsExpr GhcPs)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LGRHS GhcPs (LHsExpr GhcPs)]
guards Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 = [String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen String
"Use guards" (SrcSpan
-> RType -> [LPat GhcPs] -> GRHSs GhcPs (LHsExpr GhcPs) -> Pattern
Pattern SrcSpan
l RType
rtype [LPat GhcPs]
pat (XCGRHSs GhcPs (LHsExpr GhcPs)
-> [LGRHS GhcPs (LHsExpr GhcPs)]
-> LHsLocalBinds GhcPs
-> GRHSs GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs NoExtField
XCGRHSs GhcPs (LHsExpr GhcPs)
noExtField [LGRHS GhcPs (LHsExpr GhcPs)]
guards LHsLocalBinds GhcPs
bind)) [Refactoring SrcSpan
refactoring]]
where
rawGuards :: [(LHsExpr GhcPs, LHsExpr GhcPs)]
rawGuards :: [(LHsExpr GhcPs, LHsExpr GhcPs)]
rawGuards = LHsExpr GhcPs -> [(LHsExpr GhcPs, LHsExpr GhcPs)]
asGuards LHsExpr GhcPs
bod
mkGuard :: LHsExpr GhcPs -> (LHsExpr GhcPs -> GRHS GhcPs (LHsExpr GhcPs))
mkGuard :: LHsExpr GhcPs -> LHsExpr GhcPs -> GRHS GhcPs (LHsExpr GhcPs)
mkGuard LHsExpr GhcPs
a = XCGRHS GhcPs (LHsExpr GhcPs)
-> [GuardLStmt GhcPs]
-> LHsExpr GhcPs
-> GRHS GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS NoExtField
XCGRHS GhcPs (LHsExpr GhcPs)
noExtField [StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> GuardLStmt GhcPs
forall e. e -> Located e
noLoc (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> GuardLStmt GhcPs)
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> GuardLStmt GhcPs
forall a b. (a -> b) -> a -> b
$ XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExtField
XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
noExtField LHsExpr GhcPs
a SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr]
guards :: [LGRHS GhcPs (LHsExpr GhcPs)]
guards :: [LGRHS GhcPs (LHsExpr GhcPs)]
guards = ((LHsExpr GhcPs, LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs))
-> [(LHsExpr GhcPs, LHsExpr GhcPs)]
-> [LGRHS GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (GRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
forall e. e -> Located e
noLoc (GRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs))
-> ((LHsExpr GhcPs, LHsExpr GhcPs) -> GRHS GhcPs (LHsExpr GhcPs))
-> (LHsExpr GhcPs, LHsExpr GhcPs)
-> LGRHS GhcPs (LHsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LHsExpr GhcPs -> LHsExpr GhcPs -> GRHS GhcPs (LHsExpr GhcPs))
-> (LHsExpr GhcPs, LHsExpr GhcPs) -> GRHS GhcPs (LHsExpr GhcPs)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LHsExpr GhcPs -> LHsExpr GhcPs -> GRHS GhcPs (LHsExpr GhcPs)
mkGuard) [(LHsExpr GhcPs, LHsExpr GhcPs)]
rawGuards
([LHsExpr GhcPs]
lhs, [LHsExpr GhcPs]
rhs) = [(LHsExpr GhcPs, LHsExpr GhcPs)]
-> ([LHsExpr GhcPs], [LHsExpr GhcPs])
forall a b. [(a, b)] -> ([a], [b])
unzip [(LHsExpr GhcPs, LHsExpr GhcPs)]
rawGuards
mkTemplate :: String
-> [GenLocated SrcSpan a]
-> [Either (GenLocated SrcSpan a) (String, SrcSpan)]
mkTemplate String
c [GenLocated SrcSpan a]
ps =
(GenLocated SrcSpan a
-> Char -> Either (GenLocated SrcSpan a) (String, SrcSpan))
-> [GenLocated SrcSpan a]
-> String
-> [Either (GenLocated SrcSpan a) (String, SrcSpan)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith GenLocated SrcSpan a
-> Char -> Either (GenLocated SrcSpan a) (String, SrcSpan)
checkLoc [GenLocated SrcSpan a]
ps [Char
'1' .. Char
'9']
where
checkLoc :: GenLocated SrcSpan a
-> Char -> Either (GenLocated SrcSpan a) (String, SrcSpan)
checkLoc p :: GenLocated SrcSpan a
p@(L SrcSpan
l a
_) Char
v = if SrcSpan
l SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
noSrcSpan then GenLocated SrcSpan a
-> Either (GenLocated SrcSpan a) (String, SrcSpan)
forall a b. a -> Either a b
Left GenLocated SrcSpan a
p else (String, SrcSpan)
-> Either (GenLocated SrcSpan a) (String, SrcSpan)
forall a b. b -> Either a b
Right (String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
v], GenLocated SrcSpan a -> SrcSpan
forall a. Located a -> SrcSpan
toSS GenLocated SrcSpan a
p)
patSubts :: [Either (Located (Pat GhcPs)) (String, SrcSpan)]
patSubts =
case [LPat GhcPs]
pat of
[LPat GhcPs
p] -> [Located (Pat GhcPs)
-> Either (Located (Pat GhcPs)) (String, SrcSpan)
forall a b. a -> Either a b
Left LPat GhcPs
Located (Pat GhcPs)
p]
[LPat GhcPs]
ps -> String
-> [Located (Pat GhcPs)]
-> [Either (Located (Pat GhcPs)) (String, SrcSpan)]
forall a.
String
-> [GenLocated SrcSpan a]
-> [Either (GenLocated SrcSpan a) (String, SrcSpan)]
mkTemplate String
"p100" [LPat GhcPs]
[Located (Pat GhcPs)]
ps
guardSubts :: [Either (LHsExpr GhcPs) (String, SrcSpan)]
guardSubts = String
-> [LHsExpr GhcPs] -> [Either (LHsExpr GhcPs) (String, SrcSpan)]
forall a.
String
-> [GenLocated SrcSpan a]
-> [Either (GenLocated SrcSpan a) (String, SrcSpan)]
mkTemplate String
"g100" [LHsExpr GhcPs]
lhs
exprSubts :: [Either (LHsExpr GhcPs) (String, SrcSpan)]
exprSubts = String
-> [LHsExpr GhcPs] -> [Either (LHsExpr GhcPs) (String, SrcSpan)]
forall a.
String
-> [GenLocated SrcSpan a]
-> [Either (GenLocated SrcSpan a) (String, SrcSpan)]
mkTemplate String
"e100" [LHsExpr GhcPs]
rhs
templateGuards :: [LGRHS GhcPs (LHsExpr GhcPs)]
templateGuards = (GRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs))
-> [GRHS GhcPs (LHsExpr GhcPs)] -> [LGRHS GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map GRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
forall e. e -> Located e
noLoc ((Either (LHsExpr GhcPs) (String, SrcSpan)
-> Either (LHsExpr GhcPs) (String, SrcSpan)
-> GRHS GhcPs (LHsExpr GhcPs))
-> [Either (LHsExpr GhcPs) (String, SrcSpan)]
-> [Either (LHsExpr GhcPs) (String, SrcSpan)]
-> [GRHS GhcPs (LHsExpr GhcPs)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (LHsExpr GhcPs -> LHsExpr GhcPs -> GRHS GhcPs (LHsExpr GhcPs)
mkGuard (LHsExpr GhcPs -> LHsExpr GhcPs -> GRHS GhcPs (LHsExpr GhcPs))
-> (Either (LHsExpr GhcPs) (String, SrcSpan) -> LHsExpr GhcPs)
-> Either (LHsExpr GhcPs) (String, SrcSpan)
-> Either (LHsExpr GhcPs) (String, SrcSpan)
-> GRHS GhcPs (LHsExpr GhcPs)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Either (LHsExpr GhcPs) (String, SrcSpan) -> LHsExpr GhcPs
forall b. Either (LHsExpr GhcPs) (String, b) -> LHsExpr GhcPs
toString) [Either (LHsExpr GhcPs) (String, SrcSpan)]
guardSubts [Either (LHsExpr GhcPs) (String, SrcSpan)]
exprSubts)
toString :: Either (LHsExpr GhcPs) (String, b) -> LHsExpr GhcPs
toString (Left LHsExpr GhcPs
e) = LHsExpr GhcPs
e
toString (Right (String
v, b
_)) = String -> LHsExpr GhcPs
strToVar String
v
toString' :: Either (Located (Pat GhcPs)) (String, b) -> Located (Pat GhcPs)
toString' (Left Located (Pat GhcPs)
e) = Located (Pat GhcPs)
e
toString' (Right (String
v, b
_)) = String -> LPat GhcPs
strToPat String
v
template :: String
template = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Idea -> Maybe String
ideaTo (String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen String
"" (SrcSpan
-> RType -> [LPat GhcPs] -> GRHSs GhcPs (LHsExpr GhcPs) -> Pattern
Pattern SrcSpan
l RType
rtype ((Either (Located (Pat GhcPs)) (String, SrcSpan)
-> Located (Pat GhcPs))
-> [Either (Located (Pat GhcPs)) (String, SrcSpan)]
-> [Located (Pat GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map Either (Located (Pat GhcPs)) (String, SrcSpan)
-> Located (Pat GhcPs)
forall b.
Either (Located (Pat GhcPs)) (String, b) -> Located (Pat GhcPs)
toString' [Either (Located (Pat GhcPs)) (String, SrcSpan)]
patSubts) (XCGRHSs GhcPs (LHsExpr GhcPs)
-> [LGRHS GhcPs (LHsExpr GhcPs)]
-> LHsLocalBinds GhcPs
-> GRHSs GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs NoExtField
XCGRHSs GhcPs (LHsExpr GhcPs)
noExtField [LGRHS GhcPs (LHsExpr GhcPs)]
templateGuards LHsLocalBinds GhcPs
bind)) [])
f :: [Either a (String, R.SrcSpan)] -> [(String, R.SrcSpan)]
f :: [Either a (String, SrcSpan)] -> [(String, SrcSpan)]
f = [Either a (String, SrcSpan)] -> [(String, SrcSpan)]
forall a b. [Either a b] -> [b]
rights
refactoring :: Refactoring SrcSpan
refactoring = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
rtype (SrcSpan -> SrcSpan
toRefactSrcSpan SrcSpan
l) ([Either (Located (Pat GhcPs)) (String, SrcSpan)]
-> [(String, SrcSpan)]
forall a. [Either a (String, SrcSpan)] -> [(String, SrcSpan)]
f [Either (Located (Pat GhcPs)) (String, SrcSpan)]
patSubts [(String, SrcSpan)] -> [(String, SrcSpan)] -> [(String, SrcSpan)]
forall a. [a] -> [a] -> [a]
++ [Either (LHsExpr GhcPs) (String, SrcSpan)] -> [(String, SrcSpan)]
forall a. [Either a (String, SrcSpan)] -> [(String, SrcSpan)]
f [Either (LHsExpr GhcPs) (String, SrcSpan)]
guardSubts [(String, SrcSpan)] -> [(String, SrcSpan)] -> [(String, SrcSpan)]
forall a. [a] -> [a] -> [a]
++ [Either (LHsExpr GhcPs) (String, SrcSpan)] -> [(String, SrcSpan)]
forall a. [Either a (String, SrcSpan)] -> [(String, SrcSpan)]
f [Either (LHsExpr GhcPs) (String, SrcSpan)]
exprSubts) String
template
hints String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen (Pattern SrcSpan
l RType
t [LPat GhcPs]
pats o :: GRHSs GhcPs (LHsExpr GhcPs)
o@(GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ [L SrcSpan
_ (GRHS XCGRHS GhcPs (LHsExpr GhcPs)
_ [GuardLStmt GhcPs
test] LHsExpr GhcPs
bod)] LHsLocalBinds GhcPs
bind))
| GuardLStmt GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint GuardLStmt GhcPs
test String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"otherwise", String
"True"]
= [String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen String
"Redundant guard" (SrcSpan
-> RType -> [LPat GhcPs] -> GRHSs GhcPs (LHsExpr GhcPs) -> Pattern
Pattern SrcSpan
l RType
t [LPat GhcPs]
pats GRHSs GhcPs (LHsExpr GhcPs)
o{grhssGRHSs :: [LGRHS GhcPs (LHsExpr GhcPs)]
grhssGRHSs=[GRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
forall e. e -> Located e
noLoc (XCGRHS GhcPs (LHsExpr GhcPs)
-> [GuardLStmt GhcPs]
-> LHsExpr GhcPs
-> GRHS GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS NoExtField
XCGRHS GhcPs (LHsExpr GhcPs)
noExtField [] LHsExpr GhcPs
bod)]}) [RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Stmt (GuardLStmt GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS GuardLStmt GhcPs
test)]]
hints String -> Pattern -> [Refactoring SrcSpan] -> Idea
_ (Pattern SrcSpan
l RType
t [LPat GhcPs]
pats bod :: GRHSs GhcPs (LHsExpr GhcPs)
bod@(GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ [LGRHS GhcPs (LHsExpr GhcPs)]
_ LHsLocalBinds GhcPs
binds)) | LHsLocalBinds GhcPs -> Bool
f LHsLocalBinds GhcPs
binds
= [String -> SrcSpan -> String -> [Refactoring SrcSpan] -> Idea
suggestRemove String
"Redundant where" SrcSpan
whereSpan String
"where" [ ]]
where
f :: LHsLocalBinds GhcPs -> Bool
f :: LHsLocalBinds GhcPs -> Bool
f (L SrcSpan
_ (HsValBinds XHsValBinds GhcPs GhcPs
_ (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
bag [LSig GhcPs]
_))) = LHsBindsLR GhcPs GhcPs -> Bool
forall a. Bag a -> Bool
isEmptyBag LHsBindsLR GhcPs GhcPs
bag
f (L SrcSpan
_ (HsIPBinds XHsIPBinds GhcPs GhcPs
_ (IPBinds XIPBinds GhcPs
_ [LIPBind GhcPs]
l))) = [LIPBind GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIPBind GhcPs]
l
f LHsLocalBinds GhcPs
_ = Bool
False
whereSpan :: SrcSpan
whereSpan = case SrcSpan
l of
UnhelpfulSpan UnhelpfulSpanReason
s -> UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan UnhelpfulSpanReason
s
RealSrcSpan RealSrcSpan
s Maybe BufSpan
_ ->
let end :: RealSrcLoc
end = RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
s
start :: RealSrcLoc
start = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
s) (RealSrcLoc -> Int
srcLocLine RealSrcLoc
end) (RealSrcLoc -> Int
srcLocCol RealSrcLoc
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5)
in RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
start RealSrcLoc
end) Maybe BufSpan
forall a. Maybe a
Nothing
hints String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen (Pattern SrcSpan
l RType
t [LPat GhcPs]
pats o :: GRHSs GhcPs (LHsExpr GhcPs)
o@(GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ ([LGRHS GhcPs (LHsExpr GhcPs)]
-> Maybe
([LGRHS GhcPs (LHsExpr GhcPs)], LGRHS GhcPs (LHsExpr GhcPs))
forall a. [a] -> Maybe ([a], a)
unsnoc -> Just ([LGRHS GhcPs (LHsExpr GhcPs)]
gs, L SrcSpan
_ (GRHS XCGRHS GhcPs (LHsExpr GhcPs)
_ [GuardLStmt GhcPs
test] LHsExpr GhcPs
bod))) LHsLocalBinds GhcPs
binds))
| GuardLStmt GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint GuardLStmt GhcPs
test String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"True"
= let otherwise_ :: GuardLStmt GhcPs
otherwise_ = StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> GuardLStmt GhcPs
forall e. e -> Located e
noLoc (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> GuardLStmt GhcPs)
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> GuardLStmt GhcPs
forall a b. (a -> b) -> a -> b
$ XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExtField
XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
noExtField (String -> LHsExpr GhcPs
strToVar String
"otherwise") SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr in
[String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen String
"Use otherwise" (SrcSpan
-> RType -> [LPat GhcPs] -> GRHSs GhcPs (LHsExpr GhcPs) -> Pattern
Pattern SrcSpan
l RType
t [LPat GhcPs]
pats GRHSs GhcPs (LHsExpr GhcPs)
o{grhssGRHSs :: [LGRHS GhcPs (LHsExpr GhcPs)]
grhssGRHSs = [LGRHS GhcPs (LHsExpr GhcPs)]
gs [LGRHS GhcPs (LHsExpr GhcPs)]
-> [LGRHS GhcPs (LHsExpr GhcPs)] -> [LGRHS GhcPs (LHsExpr GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
forall e. e -> Located e
noLoc (XCGRHS GhcPs (LHsExpr GhcPs)
-> [GuardLStmt GhcPs]
-> LHsExpr GhcPs
-> GRHS GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS NoExtField
XCGRHS GhcPs (LHsExpr GhcPs)
noExtField [GuardLStmt GhcPs
otherwise_] LHsExpr GhcPs
bod)]}) [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (GuardLStmt GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS GuardLStmt GhcPs
test) [] String
"otherwise"]]
hints String -> Pattern -> [Refactoring SrcSpan] -> Idea
_ Pattern
_ = []
asGuards :: LHsExpr GhcPs -> [(LHsExpr GhcPs, LHsExpr GhcPs)]
asGuards :: LHsExpr GhcPs -> [(LHsExpr GhcPs, LHsExpr GhcPs)]
asGuards (L SrcSpan
_ (HsPar XPar GhcPs
_ LHsExpr GhcPs
x)) = LHsExpr GhcPs -> [(LHsExpr GhcPs, LHsExpr GhcPs)]
asGuards LHsExpr GhcPs
x
asGuards (L SrcSpan
_ (HsIf XIf GhcPs
_ LHsExpr GhcPs
a LHsExpr GhcPs
b LHsExpr GhcPs
c)) = (LHsExpr GhcPs
a, LHsExpr GhcPs
b) (LHsExpr GhcPs, LHsExpr GhcPs)
-> [(LHsExpr GhcPs, LHsExpr GhcPs)]
-> [(LHsExpr GhcPs, LHsExpr GhcPs)]
forall a. a -> [a] -> [a]
: LHsExpr GhcPs -> [(LHsExpr GhcPs, LHsExpr GhcPs)]
asGuards LHsExpr GhcPs
c
asGuards LHsExpr GhcPs
x = [(String -> LHsExpr GhcPs
strToVar String
"otherwise", LHsExpr GhcPs
x)]
data Pattern = Pattern SrcSpan R.RType [LPat GhcPs] (GRHSs GhcPs (LHsExpr GhcPs))
asPattern :: LHsDecl GhcPs -> [(Pattern, String -> Pattern -> [Refactoring R.SrcSpan] -> Idea)]
asPattern :: LHsDecl GhcPs
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
asPattern (L SrcSpan
loc HsDecl GhcPs
x) = (HsBindLR GhcPs GhcPs
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)])
-> [HsBindLR GhcPs GhcPs]
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HsBindLR GhcPs GhcPs
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
decl (HsDecl GhcPs -> [HsBindLR GhcPs GhcPs]
forall from to. Biplate from to => from -> [to]
universeBi HsDecl GhcPs
x)
where
decl :: HsBind GhcPs -> [(Pattern, String -> Pattern -> [Refactoring R.SrcSpan] -> Idea)]
decl :: HsBindLR GhcPs GhcPs
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
decl o :: HsBindLR GhcPs GhcPs
o@(PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
pat GRHSs GhcPs (LHsExpr GhcPs)
rhs ([Tickish Id], [[Tickish Id]])
_) = [(SrcSpan
-> RType -> [LPat GhcPs] -> GRHSs GhcPs (LHsExpr GhcPs) -> Pattern
Pattern SrcSpan
loc RType
Bind [LPat GhcPs
pat] GRHSs GhcPs (LHsExpr GhcPs)
rhs, \String
msg (Pattern SrcSpan
_ RType
_ [LPat GhcPs
pat] GRHSs GhcPs (LHsExpr GhcPs)
rhs) [Refactoring SrcSpan]
rs -> String
-> LHsBind GhcPs -> LHsBind GhcPs -> [Refactoring SrcSpan] -> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
msg (SrcSpan -> HsBindLR GhcPs GhcPs -> LHsBind GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc HsBindLR GhcPs GhcPs
o :: LHsBind GhcPs) (HsBindLR GhcPs GhcPs -> LHsBind GhcPs
forall e. e -> Located e
noLoc (XPatBind GhcPs GhcPs
-> LPat GhcPs
-> GRHSs GhcPs (LHsExpr GhcPs)
-> ([Tickish Id], [[Tickish Id]])
-> HsBindLR GhcPs GhcPs
forall idL idR.
XPatBind idL idR
-> LPat idL
-> GRHSs idR (LHsExpr idR)
-> ([Tickish Id], [[Tickish Id]])
-> HsBindLR idL idR
PatBind NoExtField
XPatBind GhcPs GhcPs
noExtField LPat GhcPs
pat GRHSs GhcPs (LHsExpr GhcPs)
rhs ([], [])) :: LHsBind GhcPs) [Refactoring SrcSpan]
rs)]
decl (FunBind XFunBind GhcPs GhcPs
_ Located (IdP GhcPs)
_ (MG XMG GhcPs (LHsExpr GhcPs)
_ (L SrcSpan
_ [LMatch GhcPs (LHsExpr GhcPs)]
xs) Origin
_) [Tickish Id]
_) = (LMatch GhcPs (LHsExpr GhcPs)
-> (Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea))
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
forall a b. (a -> b) -> [a] -> [b]
map LMatch GhcPs (LHsExpr GhcPs)
-> (Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)
match [LMatch GhcPs (LHsExpr GhcPs)]
xs
decl HsBindLR GhcPs GhcPs
_ = []
match :: LMatch GhcPs (LHsExpr GhcPs) -> (Pattern, String -> Pattern -> [Refactoring R.SrcSpan] -> Idea)
match :: LMatch GhcPs (LHsExpr GhcPs)
-> (Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)
match o :: LMatch GhcPs (LHsExpr GhcPs)
o@(L SrcSpan
loc (Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext (NoGhcTc GhcPs)
ctx [LPat GhcPs]
pats GRHSs GhcPs (LHsExpr GhcPs)
grhss)) = (SrcSpan
-> RType -> [LPat GhcPs] -> GRHSs GhcPs (LHsExpr GhcPs) -> Pattern
Pattern SrcSpan
loc RType
R.Match [LPat GhcPs]
pats GRHSs GhcPs (LHsExpr GhcPs)
grhss, \String
msg (Pattern SrcSpan
_ RType
_ [LPat GhcPs]
pats GRHSs GhcPs (LHsExpr GhcPs)
grhss) [Refactoring SrcSpan]
rs -> String
-> LMatch GhcPs (LHsExpr GhcPs)
-> LMatch GhcPs (LHsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
msg LMatch GhcPs (LHsExpr GhcPs)
o (Match GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
forall e. e -> Located e
noLoc (XCMatch GhcPs (LHsExpr GhcPs)
-> HsMatchContext (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GRHSs GhcPs (LHsExpr GhcPs)
-> Match GhcPs (LHsExpr GhcPs)
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match NoExtField
XCMatch GhcPs (LHsExpr GhcPs)
noExtField HsMatchContext (NoGhcTc GhcPs)
ctx [LPat GhcPs]
pats GRHSs GhcPs (LHsExpr GhcPs)
grhss) :: LMatch GhcPs (LHsExpr GhcPs)) [Refactoring SrcSpan]
rs)
patHint :: Bool -> Bool -> LPat GhcPs -> [Idea]
patHint :: Bool -> Bool -> LPat GhcPs -> [Idea]
patHint Bool
_ Bool
_ o :: LPat GhcPs
o@(L _ (ConPat _ name (PrefixCon args)))
| [Located (Pat GhcPs)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LPat GhcPs]
[Located (Pat GhcPs)]
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3 Bool -> Bool -> Bool
&& (Located (Pat GhcPs) -> Bool) -> [Located (Pat GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LPat GhcPs -> Bool
Located (Pat GhcPs) -> Bool
isPWildcard [LPat GhcPs]
[Located (Pat GhcPs)]
args =
let rec_fields :: HsRecFields GhcPs (LPat GhcPs)
rec_fields = [LHsRecField GhcPs (Located (Pat GhcPs))]
-> Maybe (Located Int) -> HsRecFields GhcPs (Located (Pat GhcPs))
forall p arg.
[LHsRecField p arg] -> Maybe (Located Int) -> HsRecFields p arg
HsRecFields [] Maybe (Located Int)
forall a. Maybe a
Nothing :: HsRecFields GhcPs (LPat GhcPs)
new :: LPat GhcPs
new = Pat GhcPs -> Located (Pat GhcPs)
forall e. e -> Located e
noLoc (Pat GhcPs -> Located (Pat GhcPs))
-> Pat GhcPs -> Located (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XConPat GhcPs
-> Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p.
XConPat p -> Located (ConLikeP p) -> HsConPatDetails p -> Pat p
ConPat NoExtField
XConPat GhcPs
noExtField Located (ConLikeP GhcPs)
name (HsRecFields GhcPs (Located (Pat GhcPs))
-> HsConDetails
(Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
forall arg rec. rec -> HsConDetails arg rec
RecCon HsRecFields GhcPs (Located (Pat GhcPs))
rec_fields) :: LPat GhcPs
in
[String
-> Located (Pat GhcPs)
-> Located (Pat GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use record patterns" LPat GhcPs
Located (Pat GhcPs)
o LPat GhcPs
Located (Pat GhcPs)
new [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
R.Pattern (Located (Pat GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LPat GhcPs
Located (Pat GhcPs)
o) [] (Located (Pat GhcPs) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint LPat GhcPs
Located (Pat GhcPs)
new)]]
patHint Bool
_ Bool
_ o :: LPat GhcPs
o@(L _ (VarPat _ (L _ name)))
| OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc IdP GhcPs
RdrName
name) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"otherwise" =
[String
-> Located (Pat GhcPs)
-> Located (Pat GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Used otherwise as a pattern" LPat GhcPs
Located (Pat GhcPs)
o (Pat GhcPs -> Located (Pat GhcPs)
forall e. e -> Located e
noLoc (XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> Pat p
WildPat NoExtField
XWildPat GhcPs
noExtField) :: LPat GhcPs) []]
patHint Bool
lang Bool
strict o :: LPat GhcPs
o@(L _ (BangPat _ pat@(L _ x)))
| Bool
strict, Pat GhcPs -> Bool
f Pat GhcPs
x = [String
-> Located (Pat GhcPs)
-> Located (Pat GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant bang pattern" LPat GhcPs
Located (Pat GhcPs)
o (Pat GhcPs -> Located (Pat GhcPs)
forall e. e -> Located e
noLoc Pat GhcPs
x :: LPat GhcPs) [Refactoring SrcSpan
r]]
where
f :: Pat GhcPs -> Bool
f :: Pat GhcPs -> Bool
f (ParPat XParPat GhcPs
_ (L _ x)) = Pat GhcPs -> Bool
f Pat GhcPs
x
f (AsPat XAsPat GhcPs
_ Located (IdP GhcPs)
_ (L _ x)) = Pat GhcPs -> Bool
f Pat GhcPs
x
f LitPat {} = Bool
True
f NPat {} = Bool
True
f ConPat {} = Bool
True
f TuplePat {} = Bool
True
f ListPat {} = Bool
True
f (SigPat XSigPat GhcPs
_ (L _ p) HsPatSigType (NoGhcTc GhcPs)
_) = Pat GhcPs -> Bool
f Pat GhcPs
p
f Pat GhcPs
_ = Bool
False
r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
R.Pattern (Located (Pat GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LPat GhcPs
Located (Pat GhcPs)
o) [(String
"x", Located (Pat GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LPat GhcPs
Located (Pat GhcPs)
pat)] String
"x"
patHint Bool
False Bool
_ o :: LPat GhcPs
o@(L _ (LazyPat _ pat@(L _ x)))
| Pat GhcPs -> Bool
f Pat GhcPs
x = [String
-> Located (Pat GhcPs)
-> Located (Pat GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant irrefutable pattern" LPat GhcPs
Located (Pat GhcPs)
o (Pat GhcPs -> Located (Pat GhcPs)
forall e. e -> Located e
noLoc Pat GhcPs
x :: LPat GhcPs) [Refactoring SrcSpan
r]]
where
f :: Pat GhcPs -> Bool
f :: Pat GhcPs -> Bool
f (ParPat XParPat GhcPs
_ (L _ x)) = Pat GhcPs -> Bool
f Pat GhcPs
x
f (AsPat XAsPat GhcPs
_ Located (IdP GhcPs)
_ (L _ x)) = Pat GhcPs -> Bool
f Pat GhcPs
x
f WildPat{} = Bool
True
f VarPat{} = Bool
True
f Pat GhcPs
_ = Bool
False
r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
R.Pattern (Located (Pat GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LPat GhcPs
Located (Pat GhcPs)
o) [(String
"x", Located (Pat GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LPat GhcPs
Located (Pat GhcPs)
pat)] String
"x"
patHint Bool
_ Bool
_ o :: LPat GhcPs
o@(L _ (AsPat _ v (L _ (WildPat _)))) =
[String
-> Located (Pat GhcPs)
-> Located RdrName
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant as-pattern" LPat GhcPs
Located (Pat GhcPs)
o Located (IdP GhcPs)
Located RdrName
v [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
R.Pattern (Located (Pat GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LPat GhcPs
Located (Pat GhcPs)
o) [] (Located RdrName -> String
rdrNameStr Located (IdP GhcPs)
Located RdrName
v)]]
patHint Bool
_ Bool
_ LPat GhcPs
_ = []
expHint :: LHsExpr GhcPs -> [Idea]
expHint :: LHsExpr GhcPs -> [Idea]
expHint o :: LHsExpr GhcPs
o@(L SrcSpan
_ (HsCase XCase GhcPs
_ LHsExpr GhcPs
_ (MG XMG GhcPs (LHsExpr GhcPs)
_ (L SrcSpan
_ [L SrcSpan
_ (Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext (NoGhcTc GhcPs)
CaseAlt [L _ (WildPat _)] (GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ [L SrcSpan
_ (GRHS XCGRHS GhcPs (LHsExpr GhcPs)
_ [] LHsExpr GhcPs
e)] (L SrcSpan
_ (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_)))) ]) Origin
FromSource ))) =
[String
-> LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring SrcSpan] -> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Redundant case" LHsExpr GhcPs
o LHsExpr GhcPs
e [Refactoring SrcSpan
r]]
where
r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr GhcPs
o) [(String
"x", LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr GhcPs
e)] String
"x"
expHint o :: LHsExpr GhcPs
o@(L SrcSpan
_ (HsCase XCase GhcPs
_ (L SrcSpan
_ (HsVar XVar GhcPs
_ (L SrcSpan
_ IdP GhcPs
x))) (MG XMG GhcPs (LHsExpr GhcPs)
_ (L SrcSpan
_ [L SrcSpan
_ (Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext (NoGhcTc GhcPs)
CaseAlt [L _ (VarPat _ (L _ y))] (GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ [L SrcSpan
_ (GRHS XCGRHS GhcPs (LHsExpr GhcPs)
_ [] LHsExpr GhcPs
e)] (L SrcSpan
_ (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_)))) ]) Origin
FromSource )))
| RdrName -> String
occNameStr IdP GhcPs
RdrName
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName -> String
occNameStr IdP GhcPs
RdrName
y =
[String
-> LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring SrcSpan] -> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Redundant case" LHsExpr GhcPs
o LHsExpr GhcPs
e [Refactoring SrcSpan
r]]
where
r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr GhcPs
o) [(String
"x", LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr GhcPs
e)] String
"x"
expHint LHsExpr GhcPs
_ = []