module Hint.Structure(structureHint) where
import Hint.Type
import Util
structureHint :: DeclHint
structureHint _ _ x =
concatMap (uncurry hints . swap) (asPattern x) ++
concatMap patHint (universeBi x) ++
concatMap expHint (universeBi x)
hints :: (String -> Pattern -> Idea) -> Pattern -> [Idea]
hints gen (Pattern pat (UnGuardedRhs d bod) bind)
| length guards > 2 = [gen "Use guards" $ Pattern pat (GuardedRhss d guards) bind]
where guards = asGuards bod
hints gen (Pattern pats (GuardedRhss _ [GuardedRhs _ [test] bod]) bind)
| prettyPrint test `elem` ["otherwise","True"]
= [gen "Redundant guard" $ Pattern pats (UnGuardedRhs an bod) bind]
hints gen (Pattern pats bod (Just bind)) | f bind && False
= [gen "Redundant where" $ Pattern pats bod Nothing]
where
f (BDecls _ x) = null x
f (IPBinds _ x) = null x
hints gen (Pattern pats (GuardedRhss _ (unsnoc -> (gs, GuardedRhs _ [test] bod))) bind)
| prettyPrint test == "True"
= [gen "Use otherwise" $ Pattern pats (GuardedRhss an $ gs ++ [GuardedRhs an [Qualifier an $ toNamed "otherwise"] bod]) bind]
hints _ _ = []
asGuards :: Exp_ -> [GuardedRhs S]
asGuards (Paren _ x) = asGuards x
asGuards (If _ a b c) = GuardedRhs an [Qualifier an a] b : asGuards c
asGuards x = [GuardedRhs an [Qualifier an $ toNamed "otherwise"] x]
data Pattern = Pattern [Pat_] (Rhs S) (Maybe (Binds S))
asPattern :: Decl_ -> [(Pattern, String -> Pattern -> Idea)]
asPattern x = concatMap decl (universeBi x) ++ concatMap alt (universeBi x)
where
decl o@(PatBind a pat rhs bind) = [(Pattern [pat] rhs bind, \msg (Pattern [pat] rhs bind) -> warn msg o $ PatBind a pat rhs bind)]
decl (FunBind _ xs) = map match xs
decl _ = []
match o@(Match a b pat rhs bind) = (Pattern pat rhs bind, \msg (Pattern pat rhs bind) -> warn msg o $ Match a b pat rhs bind)
match o@(InfixMatch a p b ps rhs bind) = (Pattern (p:ps) rhs bind, \msg (Pattern (p:ps) rhs bind) -> warn msg o $ InfixMatch a p b ps rhs bind)
alt o@(Alt a pat rhs bind) = [(Pattern [pat] rhs bind, \msg (Pattern [pat] rhs bind) -> warn msg o $ Alt a pat rhs bind)]
patHint :: Pat_ -> [Idea]
patHint o@(PApp _ name args) | length args >= 3 && all isPWildCard args = [warn "Use record patterns" o $ PRec an name []]
patHint o@(PBangPat _ x) | f x = [err "Redundant bang pattern" o x]
where f (PParen _ x) = f x
f (PAsPat _ _ x) = f x
f PLit{} = True
f PApp{} = True
f PInfixApp{} = True
f _ = False
patHint o@(PIrrPat _ x) | f x = [err "Redundant irrefutable pattern" o x]
where f (PParen _ x) = f x
f (PAsPat _ _ x) = f x
f PWildCard{} = True
f PVar{} = True
f _ = False
patHint _ = []
expHint :: Exp_ -> [Idea]
expHint o@(Case _ _ [Alt _ PWildCard{} (UnGuardedRhs _ e) Nothing]) = [warn "Redundant case" o e]
expHint o@(Case _ (Var _ x) [Alt _ (PVar _ y) (UnGuardedRhs _ e) Nothing])
| x =~= UnQual an y = [warn "Redundant case" o e]
expHint _ = []