{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-

Raise an error if you are bracketing an atom, or are enclosed by a
list bracket.

<TEST>
-- expression bracket reduction
yes = (f x) x -- @Suggestion f x x
no = f (x x)
yes = (foo) -- foo
yes = (foo bar) -- @Suggestion foo bar
yes = foo (bar) -- @Warning bar
yes = foo ((x x)) -- @Suggestion (x x)
yes = (f x) ||| y -- @Suggestion f x ||| y
yes = if (f x) then y else z -- @Suggestion if f x then y else z
yes = if x then (f y) else z -- @Suggestion if x then f y else z
yes = (a foo) :: Int -- @Suggestion a foo :: Int
yes = [(foo bar)] -- @Suggestion [foo bar]
yes = foo ((x y), z) -- @Suggestion (x y, z)
yes = C { f = (e h) } -- @Suggestion C {f = e h}
yes = \ x -> (x && x) -- @Suggestion \x -> x && x
no = \(x -> y) -> z
yes = (`foo` (bar baz)) -- @Suggestion (`foo` bar baz)
yes = f ((x)) -- @Warning x
main = do f; (print x) -- @Suggestion do f print x
yes = f (x) y -- @Warning x
no = f (+x) y
no = f ($ x) y
no = ($ x)
yes = (($ x))  -- @Warning ($ x)
no = ($ 1)
yes = (($ 1)) -- @Warning ($ 1)
no = (+5)
yes = ((+5)) -- @Warning (+5)
issue909 = case 0 of { _ | n <- (0 :: Int) -> n }
issue909 = foo (\((x :: z) -> y) -> 9 + x * 7)
issue909 = foo (\((x : z) -> y) -> 9 + x * 7) -- \(x : z -> y) -> 9 + x * 7
issue909 = let ((x:: y) -> z) = q in q
issue909 = do {((x :: y) -> z) <- e; return 1}
issue970 = (f x +) (g x) -- f x + (g x)
issue969 = (Just \x -> x || x) *> Just True
issue1179 = do(this is a test) -- do this is a test
issue1212 = $(Git.hash)

-- type bracket reduction
foo :: (Int -> Int) -> Int
foo :: (Maybe Int) -> a -- @Suggestion Maybe Int -> a
instance Named (DeclHead S)
data Foo = Foo {foo :: (Maybe Foo)} -- @Suggestion foo :: Maybe Foo

-- pattern bracket reduction
foo (x:xs) = 1
foo (True) = 1 -- @Warning True
foo ((True)) = 1 -- @Warning True
f x = case x of (Nothing) -> 1; _ -> 2 -- Nothing

-- dollar reduction tests
no = groupFsts . sortFst $ mr
yes = split "to" $ names -- split "to" names
yes = white $ keysymbol -- white keysymbol
yes = operator foo $ operator -- operator foo operator
no = operator foo $ operator bar
yes = return $ Record{a=b}
no = f $ [1,2..5] -- f [1,2..5]

-- $/bracket rotation tests
yes = (b $ c d) ++ e -- b (c d) ++ e
yes = (a b $ c d) ++ e -- a b (c d) ++ e
no = (f . g $ a) ++ e
no = quickCheck ((\h -> cySucc h == succ h) :: Hygiene -> Bool)
foo = (case x of y -> z; q -> w) :: Int

-- backup fixity resolution
main = do a += b . c; return $ a . b

-- <$> bracket tests
yes = (foo . bar x) <$> baz q -- foo . bar x <$> baz q
no = foo . bar x <$> baz q

-- annotations
main = 1; {-# ANN module ("HLint: ignore Use camelCase" :: String) #-}
main = 1; {-# ANN module (1 + (2)) #-} -- 2

-- special case from esqueleto, see #224
main = operate <$> (select $ from $ \user -> return $ user ^. UserEmail)
-- unknown fixity, see #426
bad x = x . (x +? x . x)
-- special case people don't like to warn on
special = foo $ f{x=1}
special = foo $ Rec{x=1}
special = foo (f{x=1})
loadCradleOnlyonce = skipManyTill anyMessage (message @PublishDiagnosticsNotification)
-- These used to require a bracket
$(pure [])
$(x)
-- People aren't a fan of the record constructors being secretly atomic
function (Ctor (Rec { field })) = Ctor (Rec {field = 1})

-- type splices are a bit special
no = f @($x)
</TEST>
-}


module Hint.Bracket(bracketHint) where

import Hint.Type(DeclHint,Idea(..),rawIdea,warn,suggest,Severity(..),toRefactSrcSpan,toSS)
import Data.Data
import Data.List.Extra
import Data.Generics.Uniplate.DataOnly
import Refact.Types

import GHC.Hs
import GHC.Utils.Outputable
import GHC.Types.SrcLoc
import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable

bracketHint :: DeclHint
bracketHint :: DeclHint
bracketHint Scope
_ ModuleEx
_ LHsDecl GhcPs
x =
  (Located (HsExpr GhcPs) -> [Idea])
-> [Located (HsExpr GhcPs)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Located (HsExpr GhcPs)
x -> (Located (HsExpr GhcPs) -> String)
-> (Maybe (Located (HsExpr GhcPs))
    -> Located (HsExpr GhcPs) -> Bool)
-> Bool
-> Located (HsExpr GhcPs)
-> [Idea]
forall a.
(Data a, Outputable a, Brackets (Located a)) =>
(Located a -> String)
-> (Maybe (Located a) -> Located a -> Bool)
-> Bool
-> Located a
-> [Idea]
bracket Located (HsExpr GhcPs) -> String
prettyExpr Maybe (Located (HsExpr GhcPs)) -> Located (HsExpr GhcPs) -> Bool
isPartialAtom Bool
True Located (HsExpr GhcPs)
x [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ Located (HsExpr GhcPs) -> [Idea]
dollar Located (HsExpr GhcPs)
x) (LHsDecl GhcPs -> [Located (HsExpr GhcPs)]
forall from to. Biplate from to => from -> [to]
childrenBi ((HsDecl GhcPs -> HsDecl GhcPs) -> LHsDecl GhcPs -> LHsDecl GhcPs
forall from to. Biplate from to => (to -> to) -> from -> from
descendBi HsDecl GhcPs -> HsDecl GhcPs
splices (LHsDecl GhcPs -> LHsDecl GhcPs) -> LHsDecl GhcPs -> LHsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ (AnnDecl GhcPs -> AnnDecl GhcPs) -> LHsDecl GhcPs -> LHsDecl GhcPs
forall from to. Biplate from to => (to -> to) -> from -> from
descendBi AnnDecl GhcPs -> AnnDecl GhcPs
annotations LHsDecl GhcPs
x) :: [LHsExpr GhcPs]) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
  (Located (HsType GhcPs) -> [Idea])
-> [Located (HsType GhcPs)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Located (HsType GhcPs) -> String)
-> (Maybe (Located (HsType GhcPs))
    -> Located (HsType GhcPs) -> Bool)
-> Bool
-> Located (HsType GhcPs)
-> [Idea]
forall a.
(Data a, Outputable a, Brackets (Located a)) =>
(Located a -> String)
-> (Maybe (Located a) -> Located a -> Bool)
-> Bool
-> Located a
-> [Idea]
bracket Located (HsType GhcPs) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (\Maybe (Located (HsType GhcPs))
_ Located (HsType GhcPs)
_ -> Bool
False) Bool
False) (LHsDecl GhcPs -> [Located (HsType GhcPs)]
forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
x :: [LHsType 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 ((Located (Pat GhcPs) -> String)
-> (Maybe (Located (Pat GhcPs)) -> Located (Pat GhcPs) -> Bool)
-> Bool
-> Located (Pat GhcPs)
-> [Idea]
forall a.
(Data a, Outputable a, Brackets (Located a)) =>
(Located a -> String)
-> (Maybe (Located a) -> Located a -> Bool)
-> Bool
-> Located a
-> [Idea]
bracket Located (Pat GhcPs) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (\Maybe (Located (Pat GhcPs))
_ Located (Pat GhcPs)
_ -> Bool
False) Bool
False) (LHsDecl GhcPs -> [Located (Pat GhcPs)]
forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
x :: [LPat GhcPs]) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
  (LConDeclField GhcPs -> [Idea]) -> [LConDeclField GhcPs] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LConDeclField GhcPs -> [Idea]
fieldDecl (LHsDecl GhcPs -> [LConDeclField GhcPs]
forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
x)
   where
     -- Brackets the roots of annotations are fine, so we strip them.
     annotations :: AnnDecl GhcPs -> AnnDecl GhcPs
     annotations :: AnnDecl GhcPs -> AnnDecl GhcPs
annotations= (Located (HsExpr GhcPs) -> Located (HsExpr GhcPs))
-> AnnDecl GhcPs -> AnnDecl GhcPs
forall from to. Biplate from to => (to -> to) -> from -> from
descendBi ((Located (HsExpr GhcPs) -> Located (HsExpr GhcPs))
 -> AnnDecl GhcPs -> AnnDecl GhcPs)
-> (Located (HsExpr GhcPs) -> Located (HsExpr GhcPs))
-> AnnDecl GhcPs
-> AnnDecl GhcPs
forall a b. (a -> b) -> a -> b
$ \Located (HsExpr GhcPs)
x -> case (Located (HsExpr GhcPs)
x :: LHsExpr GhcPs) of
       L SrcSpan
_ (HsPar XPar GhcPs
_ Located (HsExpr GhcPs)
x) -> Located (HsExpr GhcPs)
x
       Located (HsExpr GhcPs)
x -> Located (HsExpr GhcPs)
x

     -- Brackets at the root of splices used to be required, but now they aren't
     splices :: HsDecl GhcPs -> HsDecl GhcPs
     splices :: HsDecl GhcPs -> HsDecl GhcPs
splices (SpliceD XSpliceD GhcPs
a SpliceDecl GhcPs
x) = XSpliceD GhcPs -> SpliceDecl GhcPs -> HsDecl GhcPs
forall p. XSpliceD p -> SpliceDecl p -> HsDecl p
SpliceD XSpliceD GhcPs
a (SpliceDecl GhcPs -> HsDecl GhcPs)
-> SpliceDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ ((Located (HsExpr GhcPs) -> Located (HsExpr GhcPs))
 -> SpliceDecl GhcPs -> SpliceDecl GhcPs)
-> SpliceDecl GhcPs
-> (Located (HsExpr GhcPs) -> Located (HsExpr GhcPs))
-> SpliceDecl GhcPs
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Located (HsExpr GhcPs) -> Located (HsExpr GhcPs))
-> SpliceDecl GhcPs -> SpliceDecl GhcPs
forall from to. Biplate from to => (to -> to) -> from -> from
descendBi SpliceDecl GhcPs
x ((Located (HsExpr GhcPs) -> Located (HsExpr GhcPs))
 -> SpliceDecl GhcPs)
-> (Located (HsExpr GhcPs) -> Located (HsExpr GhcPs))
-> SpliceDecl GhcPs
forall a b. (a -> b) -> a -> b
$ \Located (HsExpr GhcPs)
x -> case (Located (HsExpr GhcPs)
x :: LHsExpr GhcPs) of
       L SrcSpan
_ (HsPar XPar GhcPs
_ Located (HsExpr GhcPs)
x) -> Located (HsExpr GhcPs)
x
       Located (HsExpr GhcPs)
x -> Located (HsExpr GhcPs)
x
     splices HsDecl GhcPs
x = HsDecl GhcPs
x

-- If we find ourselves in the context of a section and we want to
-- issue a warning that a child therein has unneccessary brackets,
-- we'd rather report 'Found : (`Foo` (Bar Baz))' rather than 'Found :
-- `Foo` (Bar Baz)'. If left to 'unsafePrettyPrint' we'd get the
-- latter (in contrast to the HSE pretty printer). This patches things
-- up.
prettyExpr :: LHsExpr GhcPs -> String
prettyExpr :: Located (HsExpr GhcPs) -> String
prettyExpr s :: Located (HsExpr GhcPs)
s@(L SrcSpan
_ SectionL{}) = Located (HsExpr GhcPs) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (HsExpr GhcPs -> Located (HsExpr GhcPs)
forall e. e -> Located e
noLoc (XPar GhcPs -> Located (HsExpr GhcPs) -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar NoExtField
XPar GhcPs
noExtField Located (HsExpr GhcPs)
s) :: LHsExpr GhcPs)
prettyExpr s :: Located (HsExpr GhcPs)
s@(L SrcSpan
_ SectionR{}) = Located (HsExpr GhcPs) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (HsExpr GhcPs -> Located (HsExpr GhcPs)
forall e. e -> Located e
noLoc (XPar GhcPs -> Located (HsExpr GhcPs) -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar NoExtField
XPar GhcPs
noExtField Located (HsExpr GhcPs)
s) :: LHsExpr GhcPs)
prettyExpr Located (HsExpr GhcPs)
x = Located (HsExpr GhcPs) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint Located (HsExpr GhcPs)
x

-- 'Just _' if at least one set of parens were removed. 'Nothing' if
-- zero parens were removed.
remParens' :: Brackets (Located a) => Located a -> Maybe (Located a)
remParens' :: Located a -> Maybe (Located a)
remParens' = (Located a -> Located a) -> Maybe (Located a) -> Maybe (Located a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located a -> Located a
forall a. Brackets a => a -> a
go (Maybe (Located a) -> Maybe (Located a))
-> (Located a -> Maybe (Located a))
-> Located a
-> Maybe (Located a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> Maybe (Located a)
forall a. Brackets a => a -> Maybe a
remParen
  where
    go :: a -> a
go a
e = a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
e a -> a
go (a -> Maybe a
forall a. Brackets a => a -> Maybe a
remParen a
e)

isPartialAtom :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
-- Might be '$x', which was really '$ x', but TH enabled misparsed it.
isPartialAtom :: Maybe (Located (HsExpr GhcPs)) -> Located (HsExpr GhcPs) -> Bool
isPartialAtom Maybe (Located (HsExpr GhcPs))
_ (L SrcSpan
_ (HsSpliceE XSpliceE GhcPs
_ (HsTypedSplice XTypedSplice GhcPs
_ SpliceDecoration
DollarSplice IdP GhcPs
_ Located (HsExpr GhcPs)
_) )) = Bool
True
isPartialAtom Maybe (Located (HsExpr GhcPs))
_ (L SrcSpan
_ (HsSpliceE XSpliceE GhcPs
_ (HsUntypedSplice XUntypedSplice GhcPs
_ SpliceDecoration
DollarSplice IdP GhcPs
_ Located (HsExpr GhcPs)
_) )) = Bool
True
-- Might be '$(x)' where the brackets are required in GHC 8.10 and below
isPartialAtom (Just (L SrcSpan
_ HsSpliceE{})) Located (HsExpr GhcPs)
_ = Bool
True
isPartialAtom Maybe (Located (HsExpr GhcPs))
_ Located (HsExpr GhcPs)
x = Located (HsExpr GhcPs) -> Bool
isRecConstr Located (HsExpr GhcPs)
x Bool -> Bool -> Bool
|| Located (HsExpr GhcPs) -> Bool
isRecUpdate Located (HsExpr GhcPs)
x

bracket :: forall a . (Data a, Outputable a, Brackets (Located a)) => (Located a -> String) -> (Maybe (Located a) -> Located a -> Bool) -> Bool -> Located a -> [Idea]
bracket :: (Located a -> String)
-> (Maybe (Located a) -> Located a -> Bool)
-> Bool
-> Located a
-> [Idea]
bracket Located a -> String
pretty Maybe (Located a) -> Located a -> Bool
isPartialAtom Bool
root = (Data a, Outputable a, Brackets (Located a)) =>
Maybe (Int, Located a, Located a -> Located a)
-> Located a -> [Idea]
Maybe (Int, Located a, Located a -> Located a)
-> Located a -> [Idea]
f Maybe (Int, Located a, Located a -> Located a)
forall a. Maybe a
Nothing
  where
    msg :: String
msg = String
"Redundant bracket"
    -- 'f' is a (generic) function over types in 'Brackets
    -- (expressions, patterns and types). Arguments are, 'f (Maybe
    -- (index, parent, gen)) child'.
    f :: (Data a, Outputable a, Brackets (Located a)) => Maybe (Int, Located a , Located a -> Located a) -> Located a -> [Idea]
    -- No context. Removing parentheses from 'x' succeeds?
    f :: Maybe (Int, Located a, Located a -> Located a)
-> Located a -> [Idea]
f Maybe (Int, Located a, Located a -> Located a)
Nothing o :: Located a
o@(Located a -> Maybe (Located a)
forall a. Brackets (Located a) => Located a -> Maybe (Located a)
remParens' -> Just Located a
x)
      -- If at the root, or 'x' is an atom, 'x' parens are redundant.
      | Bool
root Bool -> Bool -> Bool
|| Located a -> Bool
forall a. Brackets a => a -> Bool
isAtom Located a
x
      , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Located a) -> Located a -> Bool
isPartialAtom Maybe (Located a)
forall a. Maybe a
Nothing Located a
x =
          (if Located a -> Bool
forall a. Brackets a => a -> Bool
isAtom Located a
x then String -> Located a -> Located a -> Idea
forall a b.
(Outputable a, Outputable b, Brackets (Located b)) =>
String -> Located a -> Located b -> Idea
bracketError else String -> Located a -> Located a -> Idea
forall a b.
(Outputable a, Outputable b, Brackets (Located b)) =>
String -> Located a -> Located b -> Idea
bracketWarning) String
msg Located a
o Located a
x Idea -> [Idea] -> [Idea]
forall a. a -> [a] -> [a]
: (Data a, Outputable a, Brackets (Located a)) => Located a -> [Idea]
Located a -> [Idea]
g Located a
x
    -- In some context, removing parentheses from 'x' succeeds and 'x'
    -- is atomic?
    f (Just (Int
_, Located a
p, Located a -> Located a
_)) o :: Located a
o@(Located a -> Maybe (Located a)
forall a. Brackets (Located a) => Located a -> Maybe (Located a)
remParens' -> Just Located a
x)
      | Located a -> Bool
forall a. Brackets a => a -> Bool
isAtom Located a
x
      , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Located a) -> Located a -> Bool
isPartialAtom (Located a -> Maybe (Located a)
forall a. a -> Maybe a
Just Located a
p) Located a
x =
          String -> Located a -> Located a -> Idea
forall a b.
(Outputable a, Outputable b, Brackets (Located b)) =>
String -> Located a -> Located b -> Idea
bracketError String
msg Located a
o Located a
x Idea -> [Idea] -> [Idea]
forall a. a -> [a] -> [a]
: (Data a, Outputable a, Brackets (Located a)) => Located a -> [Idea]
Located a -> [Idea]
g Located a
x
    -- In some context, removing parentheses from 'x' succeeds. Does
    -- 'x' actually need bracketing in this context?
    f (Just (Int
i, Located a
o, Located a -> Located a
gen)) v :: Located a
v@(Located a -> Maybe (Located a)
forall a. Brackets (Located a) => Located a -> Maybe (Located a)
remParens' -> Just Located a
x)
      | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Located a -> Located a -> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i Located a
o Located a
x, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Located a) -> Located a -> Bool
isPartialAtom (Located a -> Maybe (Located a)
forall a. a -> Maybe a
Just Located a
o) Located a
x =
          Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Suggestion String
msg (Located a -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located a
v) (Located a -> String
pretty Located a
o) (String -> Maybe String
forall a. a -> Maybe a
Just (Located a -> String
pretty (Located a -> Located a
gen Located a
x))) [] [Refactoring SrcSpan
r] Idea -> [Idea] -> [Idea]
forall a. a -> [a] -> [a]
: (Data a, Outputable a, Brackets (Located a)) => Located a -> [Idea]
Located a -> [Idea]
g Located a
x
      where
        typ :: RType
typ = Located a -> RType
forall a. Brackets a => a -> RType
findType Located a
v
        r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
typ (Located a -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located a
v) [(String
"x", Located a -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located a
x)] String
"x"
    -- Regardless of the context, there are no parentheses to remove
    -- from 'x'.
    f Maybe (Int, Located a, Located a -> Located a)
_ Located a
x = (Data a, Outputable a, Brackets (Located a)) => Located a -> [Idea]
Located a -> [Idea]
g Located a
x

    g :: (Data a, Outputable a, Brackets (Located a)) => Located a -> [Idea]
    -- Enumerate over all the immediate children of 'o' looking for
    -- redundant parentheses in each.
    g :: Located a -> [Idea]
g Located a
o = [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(Data a, Outputable a, Brackets (Located a)) =>
Maybe (Int, Located a, Located a -> Located a)
-> Located a -> [Idea]
Maybe (Int, Located a, Located a -> Located a)
-> Located a -> [Idea]
f ((Int, Located a, Located a -> Located a)
-> Maybe (Int, Located a, Located a -> Located a)
forall a. a -> Maybe a
Just (Int
i, Located a
o, Located a -> Located a
gen)) Located a
x | (Int
i, (Located a
x, Located a -> Located a
gen)) <- Int
-> [(Located a, Located a -> Located a)]
-> [(Int, (Located a, Located a -> Located a))]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 ([(Located a, Located a -> Located a)]
 -> [(Int, (Located a, Located a -> Located a))])
-> [(Located a, Located a -> Located a)]
-> [(Int, (Located a, Located a -> Located a))]
forall a b. (a -> b) -> a -> b
$ Located a -> [(Located a, Located a -> Located a)]
forall on. Uniplate on => on -> [(on, on -> on)]
holes Located a
o]

bracketWarning :: (Outputable a, Outputable b, Brackets (Located b))  => String -> Located a -> Located b -> Idea
bracketWarning :: String -> Located a -> Located b -> Idea
bracketWarning String
msg Located a
o Located b
x =
  String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
msg Located a
o Located b
x [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace (Located b -> RType
forall a. Brackets a => a -> RType
findType Located b
x) (Located a -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located a
o) [(String
"x", Located b -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located b
x)] String
"x"]

bracketError :: (Outputable a, Outputable b, Brackets (Located b)) => String -> Located a -> Located b -> Idea
bracketError :: String -> Located a -> Located b -> Idea
bracketError String
msg Located a
o Located b
x =
  String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
msg Located a
o Located b
x [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace (Located b -> RType
forall a. Brackets a => a -> RType
findType Located b
x) (Located a -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located a
o) [(String
"x", Located b -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located b
x)] String
"x"]

fieldDecl ::  LConDeclField GhcPs -> [Idea]
fieldDecl :: LConDeclField GhcPs -> [Idea]
fieldDecl o :: LConDeclField GhcPs
o@(L SrcSpan
loc f :: ConDeclField GhcPs
f@ConDeclField{cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_type=v :: Located (HsType GhcPs)
v@(L SrcSpan
l (HsParTy XParTy GhcPs
_ Located (HsType GhcPs)
c))}) =
   let r :: LConDeclField GhcPs
r = SrcSpan -> ConDeclField GhcPs -> LConDeclField GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (ConDeclField GhcPs
f{cd_fld_type :: Located (HsType GhcPs)
cd_fld_type=Located (HsType GhcPs)
c}) :: LConDeclField GhcPs in
   [Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Suggestion String
"Redundant bracket" SrcSpan
l
    (SDoc -> String
showSDocUnsafe (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ LConDeclField GhcPs -> SDoc
forall pass l.
(Outputable (XXConDeclField pass), Outputable (HsType pass)) =>
GenLocated l (ConDeclField pass) -> SDoc
ppr_fld LConDeclField GhcPs
o) -- Note this custom printer!
    (String -> Maybe String
forall a. a -> Maybe a
Just (SDoc -> String
showSDocUnsafe (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ LConDeclField GhcPs -> SDoc
forall pass l.
(Outputable (XXConDeclField pass), Outputable (HsType pass)) =>
GenLocated l (ConDeclField pass) -> SDoc
ppr_fld LConDeclField GhcPs
r))
    []
    [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Type (Located (HsType GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located (HsType GhcPs)
v) [(String
"x", Located (HsType GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located (HsType GhcPs)
c)] String
"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
     -- printer to work around (snarfed from
     -- https://hackage.haskell.org/package/ghc-lib-parser-8.8.1/docs/src/HsTypes.html#pprConDeclFields).
     ppr_fld :: GenLocated l (ConDeclField pass) -> SDoc
ppr_fld (L l
_ ConDeclField { cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names = [LFieldOcc pass]
ns, cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_type = LBangType pass
ty, cd_fld_doc :: forall pass. ConDeclField pass -> Maybe LHsDocString
cd_fld_doc = Maybe LHsDocString
doc })
       = [LFieldOcc pass] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppr_names [LFieldOcc pass]
ns SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> LBangType pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr LBangType pass
ty SDoc -> SDoc -> SDoc
<+> Maybe LHsDocString -> SDoc
ppr_mbDoc Maybe LHsDocString
doc
     ppr_fld (L l
_ (XConDeclField XXConDeclField pass
x)) = XXConDeclField pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr XXConDeclField pass
x

     ppr_names :: [a] -> SDoc
ppr_names [a
n] = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
n
     ppr_names [a]
ns = [SDoc] -> SDoc
sep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
ns))
fieldDecl LConDeclField GhcPs
_ = []

-- This function relies heavily on fixities having been applied to the
-- raw parse tree.
dollar :: LHsExpr GhcPs -> [Idea]
dollar :: Located (HsExpr GhcPs) -> [Idea]
dollar = (Located (HsExpr GhcPs) -> [Idea])
-> [Located (HsExpr GhcPs)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Located (HsExpr GhcPs) -> [Idea]
f ([Located (HsExpr GhcPs)] -> [Idea])
-> (Located (HsExpr GhcPs) -> [Located (HsExpr GhcPs)])
-> Located (HsExpr GhcPs)
-> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (HsExpr GhcPs) -> [Located (HsExpr GhcPs)]
forall on. Uniplate on => on -> [on]
universe
  where
    f :: Located (HsExpr GhcPs) -> [Idea]
f Located (HsExpr GhcPs)
x = [ (String
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Redundant $" Located (HsExpr GhcPs)
x Located (HsExpr GhcPs)
y [Refactoring SrcSpan
r]){ideaSpan :: SrcSpan
ideaSpan = Located (HsExpr GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located (HsExpr GhcPs)
d} | L SrcSpan
_ (OpApp XOpApp GhcPs
_ Located (HsExpr GhcPs)
a Located (HsExpr GhcPs)
d Located (HsExpr GhcPs)
b) <- [Located (HsExpr GhcPs)
x], Located (HsExpr GhcPs) -> Bool
isDol Located (HsExpr GhcPs)
d
            , let y :: Located (HsExpr GhcPs)
y = HsExpr GhcPs -> Located (HsExpr GhcPs)
forall e. e -> Located e
noLoc (XApp GhcPs
-> Located (HsExpr GhcPs) -> Located (HsExpr GhcPs) -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExtField
XApp GhcPs
noExtField Located (HsExpr GhcPs)
a Located (HsExpr GhcPs)
b) :: LHsExpr GhcPs
            , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Located (HsExpr GhcPs) -> Located (HsExpr GhcPs) -> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
0 Located (HsExpr GhcPs)
y Located (HsExpr GhcPs)
a
            , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Located (HsExpr GhcPs) -> Located (HsExpr GhcPs) -> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
1 Located (HsExpr GhcPs)
y Located (HsExpr GhcPs)
b
            , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Located (HsExpr GhcPs)) -> Located (HsExpr GhcPs) -> Bool
isPartialAtom (Located (HsExpr GhcPs) -> Maybe (Located (HsExpr GhcPs))
forall a. a -> Maybe a
Just Located (HsExpr GhcPs)
x) Located (HsExpr GhcPs)
b
            , let r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (Located (HsExpr GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located (HsExpr GhcPs)
x) [(String
"a", Located (HsExpr GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located (HsExpr GhcPs)
a), (String
"b", Located (HsExpr GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located (HsExpr GhcPs)
b)] String
"a b"]
          [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
          [ String
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Move brackets to avoid $" Located (HsExpr GhcPs)
x (Located (HsExpr GhcPs) -> Located (HsExpr GhcPs)
t Located (HsExpr GhcPs)
y) [Refactoring SrcSpan
r]
            |(Located (HsExpr GhcPs) -> Located (HsExpr GhcPs)
t, e :: Located (HsExpr GhcPs)
e@(L SrcSpan
_ (HsPar XPar GhcPs
_ (L SrcSpan
_ (OpApp XOpApp GhcPs
_ Located (HsExpr GhcPs)
a1 Located (HsExpr GhcPs)
op1 Located (HsExpr GhcPs)
a2))))) <- Located (HsExpr GhcPs)
-> [(Located (HsExpr GhcPs) -> Located (HsExpr GhcPs),
     Located (HsExpr GhcPs))]
splitInfix Located (HsExpr GhcPs)
x
            , Located (HsExpr GhcPs) -> Bool
isDol Located (HsExpr GhcPs)
op1
            , Located (HsExpr GhcPs) -> Bool
isVar Located (HsExpr GhcPs)
a1 Bool -> Bool -> Bool
|| Located (HsExpr GhcPs) -> Bool
isApp Located (HsExpr GhcPs)
a1 Bool -> Bool -> Bool
|| Located (HsExpr GhcPs) -> Bool
isPar Located (HsExpr GhcPs)
a1, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Located (HsExpr GhcPs) -> Bool
forall a. Brackets a => a -> Bool
isAtom Located (HsExpr GhcPs)
a2
            , Located (HsExpr GhcPs) -> String
varToStr Located (HsExpr GhcPs)
a1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"select" -- special case for esqueleto, see #224
            , let y :: Located (HsExpr GhcPs)
y = HsExpr GhcPs -> Located (HsExpr GhcPs)
forall e. e -> Located e
noLoc (HsExpr GhcPs -> Located (HsExpr GhcPs))
-> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XApp GhcPs
-> Located (HsExpr GhcPs) -> Located (HsExpr GhcPs) -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExtField
XApp GhcPs
noExtField Located (HsExpr GhcPs)
a1 (HsExpr GhcPs -> Located (HsExpr GhcPs)
forall e. e -> Located e
noLoc (XPar GhcPs -> Located (HsExpr GhcPs) -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar NoExtField
XPar GhcPs
noExtField Located (HsExpr GhcPs)
a2))
            , let r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (Located (HsExpr GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located (HsExpr GhcPs)
e) [(String
"a", Located (HsExpr GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located (HsExpr GhcPs)
a1), (String
"b", Located (HsExpr GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located (HsExpr GhcPs)
a2)] String
"a (b)" ]
          [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++  -- Special case of (v1 . v2) <$> v3
          [ (String
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Redundant bracket" Located (HsExpr GhcPs)
x Located (HsExpr GhcPs)
y [Refactoring SrcSpan
r]){ideaSpan :: SrcSpan
ideaSpan = SrcSpan
locPar}
          | L SrcSpan
_ (OpApp XOpApp GhcPs
_ (L SrcSpan
locPar (HsPar XPar GhcPs
_ o1 :: Located (HsExpr GhcPs)
o1@(L SrcSpan
locNoPar (OpApp XOpApp GhcPs
_ Located (HsExpr GhcPs)
_ (Located (HsExpr GhcPs) -> Bool
isDot -> Bool
True) Located (HsExpr GhcPs)
_)))) Located (HsExpr GhcPs)
o2 Located (HsExpr GhcPs)
v3) <- [Located (HsExpr GhcPs)
x], Located (HsExpr GhcPs) -> String
varToStr Located (HsExpr GhcPs)
o2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"<$>"
          , let y :: Located (HsExpr GhcPs)
y = HsExpr GhcPs -> Located (HsExpr GhcPs)
forall e. e -> Located e
noLoc (XOpApp GhcPs
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExtField
XOpApp GhcPs
noExtField Located (HsExpr GhcPs)
o1 Located (HsExpr GhcPs)
o2 Located (HsExpr GhcPs)
v3) :: LHsExpr GhcPs
          , let r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (SrcSpan -> SrcSpan
toRefactSrcSpan SrcSpan
locPar) [(String
"a", SrcSpan -> SrcSpan
toRefactSrcSpan SrcSpan
locNoPar)] String
"a"]
          [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
          [ String
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Redundant section" Located (HsExpr GhcPs)
x Located (HsExpr GhcPs)
y [Refactoring SrcSpan
r]
          | L SrcSpan
_ (HsApp XApp GhcPs
_ (L SrcSpan
_ (HsPar XPar GhcPs
_ (L SrcSpan
_ (SectionL XSectionL GhcPs
_ Located (HsExpr GhcPs)
a Located (HsExpr GhcPs)
b)))) Located (HsExpr GhcPs)
c) <- [Located (HsExpr GhcPs)
x]
          -- , error $ show (unsafePrettyPrint a, gshow b, unsafePrettyPrint c)
          , let y :: Located (HsExpr GhcPs)
y = HsExpr GhcPs -> Located (HsExpr GhcPs)
forall e. e -> Located e
noLoc (HsExpr GhcPs -> Located (HsExpr GhcPs))
-> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XOpApp GhcPs
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExtField
XOpApp GhcPs
noExtField Located (HsExpr GhcPs)
a Located (HsExpr GhcPs)
b Located (HsExpr GhcPs)
c :: LHsExpr GhcPs
          , let r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (Located (HsExpr GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located (HsExpr GhcPs)
x) [(String
"x", Located (HsExpr GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located (HsExpr GhcPs)
a), (String
"op", Located (HsExpr GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located (HsExpr GhcPs)
b), (String
"y", Located (HsExpr GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS Located (HsExpr GhcPs)
c)] String
"x op y"]

splitInfix :: LHsExpr GhcPs -> [(LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)]
splitInfix :: Located (HsExpr GhcPs)
-> [(Located (HsExpr GhcPs) -> Located (HsExpr GhcPs),
     Located (HsExpr GhcPs))]
splitInfix (L SrcSpan
l (OpApp XOpApp GhcPs
_ Located (HsExpr GhcPs)
lhs Located (HsExpr GhcPs)
op Located (HsExpr GhcPs)
rhs)) =
  [(SrcSpan -> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcPs -> Located (HsExpr GhcPs))
-> (Located (HsExpr GhcPs) -> HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XOpApp GhcPs
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExtField
XOpApp GhcPs
noExtField Located (HsExpr GhcPs)
lhs Located (HsExpr GhcPs)
op, Located (HsExpr GhcPs)
rhs), (\Located (HsExpr GhcPs)
lhs -> SrcSpan -> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XOpApp GhcPs
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExtField
XOpApp GhcPs
noExtField Located (HsExpr GhcPs)
lhs Located (HsExpr GhcPs)
op Located (HsExpr GhcPs)
rhs), Located (HsExpr GhcPs)
lhs)]
splitInfix Located (HsExpr GhcPs)
_ = []