{-# LANGUAGE ViewPatterns, PatternGuards #-}

{-
    Improve the structure of code

<TEST>
yes x y = if a then b else if c then d else e -- yes x y ; | a = b ; | c = d ; | otherwise = e
x `yes` y = if a then b else if c then d else e -- x `yes` y ; | a = b ; | c = d ; | otherwise = e
no x y = if a then b else c
-- foo b | c <- f b = c -- foo (f -> c) = c
-- foo x y b z | c:cs <- f g b = c -- foo x y (f g -> c:cs) z = c
foo b | c <- f b = c + b
foo b | c <- f b = c where f = here
foo b | c <- f b = c where foo = b
foo b | c <- f b = c \
      | c <- f b = c
foo x = yes x x where yes x y = if a then b else if c then d else e -- yes x y ; | a = b ; | c = d ; | otherwise = e
foo x | otherwise = y -- foo x = y
foo x = x + x where -- foo x = x + x
foo x | a = b | True = d -- foo x | a = b ; | otherwise = d
foo (Bar _ _ _ _) = x -- Bar{}
foo (Bar _ x _ _) = x
foo (Bar _ _) = x
foo = case f v of _ -> x -- x
foo = case v of v -> x -- x
foo = case v of z -> z
foo = case v of _ | False -> x
foo = case v of !True -> x -- True
foo = case v of !(Just x) -> x -- (Just x)
foo = case v of !(x : xs) -> x -- (x:xs)
foo = case v of !1 -> x -- 1
foo = case v of !x -> x
foo = case v of !(I# x) -> y -- (I# x)
foo = let ~x = 1 in y -- x
foo = let ~(x:xs) = y in z
foo = let !x = undefined in y
foo = let !(I# x) = 4 in x
foo = let !(Just x) = Nothing in 3
foo = 1 where f !False = 2 -- False
foo = 1 where !False = True
foo = 1 where g (Just !True) = Nothing -- True
foo = 1 where Just !True = Nothing
foo otherwise = 1 -- _
foo ~x = y -- x
{-# LANGUAGE Strict #-} foo ~x = y
foo !(x, y) = x -- (x, y)
foo ![x] = x -- [x]
foo !Bar { bar = x } = x -- Bar { bar = x }
l !(() :: ()) = x -- (() :: ())
foo x@_ = x -- x
foo x@Foo = x
</TEST>
-}


module Hint.Pattern(patternHint) where

import Hint.Type
import Data.Function
import Data.List.Extra
import Data.Tuple
import Data.Maybe
import Data.Either
import Refact.Types hiding (RType(Pattern, Match))
import qualified Refact.Types as R (RType(Pattern, Match), SrcSpan)


patternHint :: DeclHint
patternHint :: DeclHint
patternHint _ modu :: Module_
modu x :: Decl_
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) (Decl_
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
asPattern Decl_
x) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    -- PatBind (used in Let and Where) contains lazy-by-default patterns, everything else is strict
    (Pat_ -> [Idea]) -> [Pat_] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Bool -> Pat_ -> [Idea]
patHint Bool
strict Bool
False) ([Pat_] -> [Pat_]
forall from to. Biplate from to => from -> [to]
universeBi [Pat_
p | PatBind _ p :: Pat_
p _ _ <- Decl_ -> [Decl_]
forall on. Uniplate on => on -> [on]
universe Decl_
x]) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    (Pat_ -> [Idea]) -> [Pat_] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Bool -> Pat_ -> [Idea]
patHint Bool
strict Bool
True) (Decl_ -> [Pat_]
forall from to. Biplate from to => from -> [to]
universeBi (Decl_ -> [Pat_]) -> Decl_ -> [Pat_]
forall a b. (a -> b) -> a -> b
$ (Decl_ -> Decl_) -> Decl_ -> Decl_
forall on. Uniplate on => (on -> on) -> on -> on
transform Decl_ -> Decl_
forall l. Decl l -> Decl l
noPatBind Decl_
x) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    (Exp_ -> [Idea]) -> [Exp_] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Exp_ -> [Idea]
expHint (Decl_ -> [Exp_]
forall from to. Biplate from to => from -> [to]
universeBi Decl_
x)
    where
        noPatBind :: Decl l -> Decl l
noPatBind (PatBind a :: l
a _ b :: Rhs l
b c :: Maybe (Binds l)
c) = l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
PatBind l
a (l -> Pat l
forall l. l -> Pat l
PWildCard l
a) Rhs l
b Maybe (Binds l)
c
        noPatBind x :: Decl l
x = Decl l
x

        strict :: Bool
strict = "Strict" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
n | LanguagePragma _ ns :: [Name S]
ns <- Module_ -> [ModulePragma S]
modulePragmas Module_
modu, Ident _ n :: String
n <- [Name S]
ns]


hints :: (String -> Pattern -> [Refactoring R.SrcSpan] -> Idea) -> Pattern -> [Idea]
hints :: (String -> Pattern -> [Refactoring SrcSpan] -> Idea)
-> Pattern -> [Idea]
hints gen :: String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen (Pattern l :: S
l rtype :: RType
rtype pat :: [Pat_]
pat (UnGuardedRhs d :: S
d bod :: Exp_
bod) bind :: Maybe (Binds S)
bind)
    | [GuardedRhs S] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GuardedRhs S]
guards Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 2 = [String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen "Use guards" (S -> RType -> [Pat_] -> Rhs S -> Maybe (Binds S) -> Pattern
Pattern S
l RType
rtype [Pat_]
pat (S -> [GuardedRhs S] -> Rhs S
forall l. l -> [GuardedRhs l] -> Rhs l
GuardedRhss S
d [GuardedRhs S]
guards) Maybe (Binds S)
bind) [Refactoring SrcSpan
refactoring]]
    where rawGuards :: [(Exp_, Exp_)]
rawGuards = Exp_ -> [(Exp_, Exp_)]
asGuards Exp_
bod
          mkGuard :: Exp_ -> Exp_ -> GuardedRhs S
mkGuard a :: Exp_
a = S -> [Stmt S] -> Exp_ -> GuardedRhs S
forall l. l -> [Stmt l] -> Exp l -> GuardedRhs l
GuardedRhs S
an [S -> Exp_ -> Stmt S
forall l. l -> Exp l -> Stmt l
Qualifier S
an Exp_
a]
          guards :: [GuardedRhs S]
guards = ((Exp_, Exp_) -> GuardedRhs S) -> [(Exp_, Exp_)] -> [GuardedRhs S]
forall a b. (a -> b) -> [a] -> [b]
map ((Exp_ -> Exp_ -> GuardedRhs S) -> (Exp_, Exp_) -> GuardedRhs S
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Exp_ -> Exp_ -> GuardedRhs S
mkGuard) [(Exp_, Exp_)]
rawGuards
          (lhs :: [Exp_]
lhs, rhs :: [Exp_]
rhs) = [(Exp_, Exp_)] -> ([Exp_], [Exp_])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Exp_, Exp_)]
rawGuards
          mkTemplate :: String -> [a S] -> [Either (a S) (String, SrcSpan)]
mkTemplate c :: String
c ps :: [a S]
ps =
            -- Check if the expression has been injected or is natural
            let checkAn :: a S -> Char -> Either (a S) (String, SrcSpan)
checkAn p :: a S
p v :: Char
v = if a S -> S
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann a S
p S -> S -> Bool
forall a. Eq a => a -> a -> Bool
== S
an then a S -> Either (a S) (String, SrcSpan)
forall a b. a -> Either a b
Left a S
p else (String, SrcSpan) -> Either (a S) (String, SrcSpan)
forall a b. b -> Either a b
Right ( String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
v], a S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS a S
p)
            in (a S -> Char -> Either (a S) (String, SrcSpan))
-> [a S] -> String -> [Either (a S) (String, SrcSpan)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a S -> Char -> Either (a S) (String, SrcSpan)
forall (a :: * -> *).
Annotated a =>
a S -> Char -> Either (a S) (String, SrcSpan)
checkAn [a S]
ps ['1' .. '9']
          patSubts :: [Either Pat_ (String, SrcSpan)]
patSubts = case [Pat_]
pat of
                       [p :: Pat_
p] -> [Pat_ -> Either Pat_ (String, SrcSpan)
forall a b. a -> Either a b
Left Pat_
p] -- Substitution doesn't work properly for PatBinds
                                       -- This will probably produce
                                       -- unexpected results if the pattern
                                       -- contains any template variables
                       ps :: [Pat_]
ps  -> String -> [Pat_] -> [Either Pat_ (String, SrcSpan)]
forall (a :: * -> *).
Annotated a =>
String -> [a S] -> [Either (a S) (String, SrcSpan)]
mkTemplate "p100" [Pat_]
ps
          guardSubts :: [Either Exp_ (String, SrcSpan)]
guardSubts = String -> [Exp_] -> [Either Exp_ (String, SrcSpan)]
forall (a :: * -> *).
Annotated a =>
String -> [a S] -> [Either (a S) (String, SrcSpan)]
mkTemplate "g100" [Exp_]
lhs
          exprSubts :: [Either Exp_ (String, SrcSpan)]
exprSubts  = String -> [Exp_] -> [Either Exp_ (String, SrcSpan)]
forall (a :: * -> *).
Annotated a =>
String -> [a S] -> [Either (a S) (String, SrcSpan)]
mkTemplate "e100" [Exp_]
rhs
          templateGuards :: [GuardedRhs S]
templateGuards = (Either Exp_ (String, SrcSpan)
 -> Either Exp_ (String, SrcSpan) -> GuardedRhs S)
-> [Either Exp_ (String, SrcSpan)]
-> [Either Exp_ (String, SrcSpan)]
-> [GuardedRhs S]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Exp_ -> Exp_ -> GuardedRhs S
mkGuard (Exp_ -> Exp_ -> GuardedRhs S)
-> (Either Exp_ (String, SrcSpan) -> Exp_)
-> Either Exp_ (String, SrcSpan)
-> Either Exp_ (String, SrcSpan)
-> GuardedRhs S
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Either Exp_ (String, SrcSpan) -> Exp_
forall p b. Named p => Either p (String, b) -> p
toString) [Either Exp_ (String, SrcSpan)]
guardSubts [Either Exp_ (String, SrcSpan)]
exprSubts
          toString :: Either p (String, b) -> p
toString (Left e :: p
e) = p
e
          toString (Right (v :: String
v, _)) = String -> p
forall a. Named a => String -> a
toNamed String
v
          template :: String
template = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Idea -> Maybe String
ideaTo (String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen "" (S -> RType -> [Pat_] -> Rhs S -> Maybe (Binds S) -> Pattern
Pattern S
l RType
rtype ((Either Pat_ (String, SrcSpan) -> Pat_)
-> [Either Pat_ (String, SrcSpan)] -> [Pat_]
forall a b. (a -> b) -> [a] -> [b]
map Either Pat_ (String, SrcSpan) -> Pat_
forall p b. Named p => Either p (String, b) -> p
toString [Either Pat_ (String, SrcSpan)]
patSubts) (S -> [GuardedRhs S] -> Rhs S
forall l. l -> [GuardedRhs l] -> Rhs l
GuardedRhss S
d [GuardedRhs S]
templateGuards) Maybe (Binds S)
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 -> SrcSpan) -> SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ S -> SrcSpan
srcInfoSpan S
l) ([Either Pat_ (String, SrcSpan)] -> [(String, SrcSpan)]
forall a. [Either a (String, SrcSpan)] -> [(String, SrcSpan)]
f [Either Pat_ (String, SrcSpan)]
patSubts [(String, SrcSpan)] -> [(String, SrcSpan)] -> [(String, SrcSpan)]
forall a. [a] -> [a] -> [a]
++ [Either Exp_ (String, SrcSpan)] -> [(String, SrcSpan)]
forall a. [Either a (String, SrcSpan)] -> [(String, SrcSpan)]
f [Either Exp_ (String, SrcSpan)]
guardSubts [(String, SrcSpan)] -> [(String, SrcSpan)] -> [(String, SrcSpan)]
forall a. [a] -> [a] -> [a]
++ [Either Exp_ (String, SrcSpan)] -> [(String, SrcSpan)]
forall a. [Either a (String, SrcSpan)] -> [(String, SrcSpan)]
f [Either Exp_ (String, SrcSpan)]
exprSubts) String
template

{-
-- Do not suggest view patterns, they aren't something everyone likes sufficiently
hints gen (Pattern pats (GuardedRhss _ [GuardedRhs _ [Generator _ pat (App _ op (view -> Var_ p))] bod]) bind)
    | Just i <- findIndex (=~= (toNamed p :: Pat_)) pats
    , p `notElem` (vars bod ++ vars bind)
    , vars op `disjoint` decsBind, pvars pats `disjoint` vars op, pvars pat `disjoint` pvars pats
    = [gen "Use view patterns" $
       Pattern (take i pats ++ [PParen an $ PViewPat an op pat] ++ drop (i+1) pats) (UnGuardedRhs an bod) bind]
    where
        decsBind = nub $ concatMap declBind $ childrenBi bind
-}

hints gen :: String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen (Pattern l :: S
l t :: RType
t pats :: [Pat_]
pats (GuardedRhss _ [GuardedRhs _ [test :: Stmt S
test] bod :: Exp_
bod]) bind :: Maybe (Binds S)
bind)
    | Stmt S -> String
forall a. Pretty a => a -> String
prettyPrint Stmt S
test String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["otherwise","True"]
    = [String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen "Redundant guard" (S -> RType -> [Pat_] -> Rhs S -> Maybe (Binds S) -> Pattern
Pattern S
l RType
t [Pat_]
pats (S -> Exp_ -> Rhs S
forall l. l -> Exp l -> Rhs l
UnGuardedRhs S
an Exp_
bod) Maybe (Binds S)
bind) [RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Stmt (Stmt S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Stmt S
test)]]

hints gen :: String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen (Pattern l :: S
l t :: RType
t pats :: [Pat_]
pats bod :: Rhs S
bod (Just bind :: Binds S
bind)) | Binds S -> Bool
forall l. Binds l -> Bool
f Binds S
bind
    = [String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen "Redundant where" (S -> RType -> [Pat_] -> Rhs S -> Maybe (Binds S) -> Pattern
Pattern S
l RType
t [Pat_]
pats Rhs S
bod Maybe (Binds S)
forall a. Maybe a
Nothing) []]
    where
        f :: Binds l -> Bool
f (BDecls _ x :: [Decl l]
x) = [Decl l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Decl l]
x
        f (IPBinds _ x :: [IPBind l]
x) = [IPBind l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IPBind l]
x

hints gen :: String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen (Pattern l :: S
l t :: RType
t pats :: [Pat_]
pats (GuardedRhss _ ([GuardedRhs S] -> Maybe ([GuardedRhs S], GuardedRhs S)
forall a. [a] -> Maybe ([a], a)
unsnoc -> Just (gs :: [GuardedRhs S]
gs, GuardedRhs _ [test :: Stmt S
test] bod :: Exp_
bod))) bind :: Maybe (Binds S)
bind)
    | Stmt S -> String
forall a. Pretty a => a -> String
prettyPrint Stmt S
test String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "True"
    = [String -> Pattern -> [Refactoring SrcSpan] -> Idea
gen "Use otherwise" (S -> RType -> [Pat_] -> Rhs S -> Maybe (Binds S) -> Pattern
Pattern S
l RType
t [Pat_]
pats (S -> [GuardedRhs S] -> Rhs S
forall l. l -> [GuardedRhs l] -> Rhs l
GuardedRhss S
an ([GuardedRhs S] -> Rhs S) -> [GuardedRhs S] -> Rhs S
forall a b. (a -> b) -> a -> b
$ [GuardedRhs S]
gs [GuardedRhs S] -> [GuardedRhs S] -> [GuardedRhs S]
forall a. [a] -> [a] -> [a]
++ [S -> [Stmt S] -> Exp_ -> GuardedRhs S
forall l. l -> [Stmt l] -> Exp l -> GuardedRhs l
GuardedRhs S
an [S -> Exp_ -> Stmt S
forall l. l -> Exp l -> Stmt l
Qualifier S
an (Exp_ -> Stmt S) -> Exp_ -> Stmt S
forall a b. (a -> b) -> a -> b
$ String -> Exp_
forall a. Named a => String -> a
toNamed "otherwise"] Exp_
bod]) Maybe (Binds S)
bind) [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (Stmt S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Stmt S
test) [] "otherwise"]]

hints _ _ = []


asGuards :: Exp_ -> [(Exp S, Exp S)]
asGuards :: Exp_ -> [(Exp_, Exp_)]
asGuards (Paren _ x :: Exp_
x) = Exp_ -> [(Exp_, Exp_)]
asGuards Exp_
x
asGuards (If _ a :: Exp_
a b :: Exp_
b c :: Exp_
c) = (Exp_
a, Exp_
b) (Exp_, Exp_) -> [(Exp_, Exp_)] -> [(Exp_, Exp_)]
forall a. a -> [a] -> [a]
: Exp_ -> [(Exp_, Exp_)]
asGuards Exp_
c
asGuards x :: Exp_
x = [(String -> Exp_
forall a. Named a => String -> a
toNamed "otherwise", Exp_
x)]


data Pattern = Pattern S R.RType [Pat_] (Rhs S) (Maybe (Binds S))

-- Invariant: Number of patterns may not change
asPattern :: Decl_ -> [(Pattern, String -> Pattern -> [Refactoring R.SrcSpan] -> Idea)]
asPattern :: Decl_
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
asPattern x :: Decl_
x = (Decl_
 -> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)])
-> [Decl_]
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl_
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
decl (Decl_ -> [Decl_]
forall from to. Biplate from to => from -> [to]
universeBi Decl_
x) [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
forall a. [a] -> [a] -> [a]
++ (Alt S
 -> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)])
-> [Alt S]
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Alt S
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
forall p. Alt S -> [(Pattern, String -> Pattern -> p -> Idea)]
alt (Decl_ -> [Alt S]
forall from to. Biplate from to => from -> [to]
universeBi Decl_
x)
    where
        decl :: Decl_
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
decl o :: Decl_
o@(PatBind a :: S
a pat :: Pat_
pat rhs :: Rhs S
rhs bind :: Maybe (Binds S)
bind) = [(S -> RType -> [Pat_] -> Rhs S -> Maybe (Binds S) -> Pattern
Pattern S
a RType
Bind [Pat_
pat] Rhs S
rhs Maybe (Binds S)
bind, \msg :: String
msg (Pattern _ _ [pat :: Pat_
pat] rhs :: Rhs S
rhs bind :: Maybe (Binds S)
bind) rs :: [Refactoring SrcSpan]
rs -> String -> Decl_ -> Decl_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest String
msg Decl_
o (S -> Pat_ -> Rhs S -> Maybe (Binds S) -> Decl_
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
PatBind S
a Pat_
pat Rhs S
rhs Maybe (Binds S)
bind) [Refactoring SrcSpan]
rs)]
        decl (FunBind _ xs :: [Match S]
xs) = (Match S
 -> (Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea))
-> [Match S]
-> [(Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)]
forall a b. (a -> b) -> [a] -> [b]
map Match S
-> (Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)
match [Match S]
xs
        decl _ = []
        match :: Match S
-> (Pattern, String -> Pattern -> [Refactoring SrcSpan] -> Idea)
match o :: Match S
o@(Match a :: S
a b :: Name S
b pat :: [Pat_]
pat rhs :: Rhs S
rhs bind :: Maybe (Binds S)
bind) = (S -> RType -> [Pat_] -> Rhs S -> Maybe (Binds S) -> Pattern
Pattern S
a RType
R.Match [Pat_]
pat Rhs S
rhs Maybe (Binds S)
bind, \msg :: String
msg (Pattern _ _ pat :: [Pat_]
pat rhs :: Rhs S
rhs bind :: Maybe (Binds S)
bind) rs :: [Refactoring SrcSpan]
rs -> String -> Match S -> Match S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest String
msg Match S
o (S -> Name S -> [Pat_] -> Rhs S -> Maybe (Binds S) -> Match S
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match S
a Name S
b [Pat_]
pat Rhs S
rhs Maybe (Binds S)
bind) [Refactoring SrcSpan]
rs)
        match o :: Match S
o@(InfixMatch a :: S
a p :: Pat_
p b :: Name S
b ps :: [Pat_]
ps rhs :: Rhs S
rhs bind :: Maybe (Binds S)
bind) = (S -> RType -> [Pat_] -> Rhs S -> Maybe (Binds S) -> Pattern
Pattern S
a RType
R.Match (Pat_
pPat_ -> [Pat_] -> [Pat_]
forall a. a -> [a] -> [a]
:[Pat_]
ps) Rhs S
rhs Maybe (Binds S)
bind, \msg :: String
msg (Pattern _ _ (p :: Pat_
p:ps :: [Pat_]
ps) rhs :: Rhs S
rhs bind :: Maybe (Binds S)
bind) rs :: [Refactoring SrcSpan]
rs -> String -> Match S -> Match S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest String
msg Match S
o (S
-> Pat_ -> Name S -> [Pat_] -> Rhs S -> Maybe (Binds S) -> Match S
forall l.
l
-> Pat l
-> Name l
-> [Pat l]
-> Rhs l
-> Maybe (Binds l)
-> Match l
InfixMatch S
a Pat_
p Name S
b [Pat_]
ps Rhs S
rhs Maybe (Binds S)
bind) [Refactoring SrcSpan]
rs)
        alt :: Alt S -> [(Pattern, String -> Pattern -> p -> Idea)]
alt o :: Alt S
o@(Alt a :: S
a pat :: Pat_
pat rhs :: Rhs S
rhs bind :: Maybe (Binds S)
bind) = [(S -> RType -> [Pat_] -> Rhs S -> Maybe (Binds S) -> Pattern
Pattern S
a RType
R.Match [Pat_
pat] Rhs S
rhs Maybe (Binds S)
bind, \msg :: String
msg (Pattern _ _ [pat :: Pat_
pat] rhs :: Rhs S
rhs bind :: Maybe (Binds S)
bind) rs :: p
rs -> String -> Alt S -> Alt S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest String
msg Alt S
o (S -> Pat_ -> Rhs S -> Maybe (Binds S) -> Alt S
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt S
a Pat_
pat Rhs S
rhs Maybe (Binds S)
bind) [])]


-- First Bool is if Strict is a language extension
-- Second Bool is if this pattern in this context is going to be evaluated strictly
patHint :: Bool -> Bool -> Pat_ -> [Idea]
patHint :: Bool -> Bool -> Pat_ -> [Idea]
patHint lang :: Bool
lang strict :: Bool
strict o :: Pat_
o@(PApp _ name :: QName S
name args :: [Pat_]
args) | [Pat_] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pat_]
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 3 Bool -> Bool -> Bool
&& (Pat_ -> Bool) -> [Pat_] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Pat_ -> Bool
forall l. Pat l -> Bool
isPWildCard [Pat_]
args =
  [String -> Pat_ -> Pat_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Use record patterns" Pat_
o (S -> QName S -> [PatField S] -> Pat_
forall l. l -> QName l -> [PatField l] -> Pat l
PRec S
an QName S
name []) [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
R.Pattern (Pat_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Pat_
o) [] (Pat_ -> String
forall a. Pretty a => a -> String
prettyPrint (Pat_ -> String) -> Pat_ -> String
forall a b. (a -> b) -> a -> b
$ S -> QName S -> [PatField S] -> Pat_
forall l. l -> QName l -> [PatField l] -> Pat l
PRec S
an QName S
name [])] ]
patHint lang :: Bool
lang strict :: Bool
strict o :: Pat_
o@(PVar _ v :: Name S
v) | Name S -> String
forall a. Pretty a => a -> String
prettyPrint Name S
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "otherwise" = [String -> Pat_ -> Pat_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Used otherwise as a pattern" Pat_
o (S -> Pat_
forall l. l -> Pat l
PWildCard S
an) []]

patHint lang :: Bool
lang strict :: Bool
strict o :: Pat_
o@(PBangPat _ x :: Pat_
x) | Bool
strict, Pat_ -> Bool
forall l. Pat l -> Bool
f Pat_
x = [String -> Pat_ -> Pat_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Redundant bang pattern" Pat_
o Pat_
x [Refactoring SrcSpan
r]]
    where f :: Pat l -> Bool
f (PParen _ x :: Pat l
x) = Pat l -> Bool
f Pat l
x
          f (PAsPat _ _ x :: Pat l
x) = Pat l -> Bool
f Pat l
x
          f PLit{} = Bool
True
          f PApp{} = Bool
True
          f PInfixApp{} = Bool
True
          f PTuple{} = Bool
True
          f PList{} = Bool
True
          f PRec{} = Bool
True
          f (PatTypeSig _ x :: Pat l
x _) = Pat l -> Bool
f Pat l
x
          f _ = 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 (Pat_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Pat_
o) [("x", Pat_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Pat_
x)] "x"
patHint False strict :: Bool
strict o :: Pat_
o@(PIrrPat _ x :: Pat_
x) | Pat_ -> Bool
forall l. Pat l -> Bool
f Pat_
x = [String -> Pat_ -> Pat_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Redundant irrefutable pattern" Pat_
o Pat_
x [Refactoring SrcSpan
r]]
    where f :: Pat l -> Bool
f (PParen _ x :: Pat l
x) = Pat l -> Bool
f Pat l
x
          f (PAsPat _ _ x :: Pat l
x) = Pat l -> Bool
f Pat l
x
          f PWildCard{} = Bool
True
          f PVar{} = Bool
True
          f _ = 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 (Pat_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Pat_
o) [("x", Pat_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Pat_
x)] "x"
patHint lang :: Bool
lang strict :: Bool
strict o :: Pat_
o@(PAsPat u :: S
u v :: Name S
v PWildCard{}) = [String -> Pat_ -> Name S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Redundant as-pattern" Pat_
o Name S
v []]
patHint _ _ _ = []


expHint :: Exp_ -> [Idea]
expHint :: Exp_ -> [Idea]
expHint o :: Exp_
o@(Case _ _ [Alt _ PWildCard{} (UnGuardedRhs _ e :: Exp_
e) Nothing]) =
  [String -> Exp_ -> Exp_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Redundant case" Exp_
o Exp_
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 (Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp_
o) [("x", Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp_
e)] "x"
expHint o :: Exp_
o@(Case _ (Var _ x :: QName S
x) [Alt _ (PVar _ y :: Name S
y) (UnGuardedRhs _ e :: Exp_
e) Nothing])
    | QName S
x QName S -> QName S -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= S -> Name S -> QName S
forall l. l -> Name l -> QName l
UnQual S
an Name S
y =
      [String -> Exp_ -> Exp_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Redundant case" Exp_
o Exp_
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 (Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp_
o) [("x", Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp_
e)] "x"
expHint _ = []