{-# LANGUAGE LambdaCase #-}
{-# 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)

-- no record dot syntax
referenceDesignator = ReferenceDesignator (p.placementReferenceDesignator)

-- record dot syntax
{-# LANGUAGE OverloadedRecordDot #-} \
referenceDesignator = ReferenceDesignator (p.placementReferenceDesignator) -- p.placementReferenceDesignator @NoRefactor: refactor requires GHC >= 9.2.1

-- 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)

-- template haskell is harder
issue1292 = [e| handleForeignCatch $ \ $(varP pylonExPtrVarName) -> $(quoteExp C.block modifiedStr) |]

-- no warnings for single-argument constraint contexts
foo :: (A) => ()
bar :: (A a) => ()
foo' :: ((A) => ()) -> ()
bar' :: ((A a) => ()) -> ()
data Dict c where Dict :: (c) => Dict c
data Dict' c a where Dict' :: (c a) => Dict' c a

-- issue1501: Redundant bracket hint resulted in a parse error
x = f $ \(Proxy @a) -> True
</TEST>
-}


module Hint.Bracket(bracketHint) where

import Hint.Type(DeclHint,Idea(..),rawIdea,warn,suggest,Severity(..),toRefactSrcSpan,toSSA)
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
import Language.Haskell.GhclibParserEx.GHC.Hs.Pat

bracketHint :: DeclHint
bracketHint :: DeclHint
bracketHint Scope
_ ModuleEx
_ LHsDecl GhcPs
x =
  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x -> forall a.
(Data a, Outputable a, Brackets (LocatedA a)) =>
(LocatedA a -> String)
-> (Maybe (LocatedA a) -> LocatedA a -> Bool)
-> Bool
-> LocatedA a
-> [Idea]
bracket LHsExpr GhcPs -> String
prettyExpr Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
isPartialAtom Bool
True GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x forall a. [a] -> [a] -> [a]
++ LHsExpr GhcPs -> [Idea]
dollar GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x) (forall from to. Biplate from to => from -> [to]
childrenBi (forall from to. Biplate from to => (to -> to) -> from -> from
descendBi HsDecl GhcPs -> HsDecl GhcPs
splices forall a b. (a -> b) -> a -> b
$ forall from to. Biplate from to => (to -> to) -> from -> from
descendBi AnnDecl GhcPs -> AnnDecl GhcPs
annotations LHsDecl GhcPs
x) :: [LHsExpr GhcPs]) forall a. [a] -> [a] -> [a]
++
  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a.
(Data a, Outputable a, Brackets (LocatedA a)) =>
(LocatedA a -> String)
-> (Maybe (LocatedA a) -> LocatedA a -> Bool)
-> Bool
-> LocatedA a
-> [Idea]
bracket forall a. Outputable a => a -> String
unsafePrettyPrint (\Maybe (LocatedA (BangType GhcPs))
_ LocatedA (BangType GhcPs)
_ -> Bool
False) Bool
False) (forall from to. Biplate from to => from -> [to]
childrenBi (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
preprocess LHsDecl GhcPs
x) :: [LHsType GhcPs]) forall a. [a] -> [a] -> [a]
++
  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a.
(Data a, Outputable a, Brackets (LocatedA a)) =>
(LocatedA a -> String)
-> (Maybe (LocatedA a) -> LocatedA a -> Bool)
-> Bool
-> LocatedA a
-> [Idea]
bracket forall a. Outputable a => a -> String
unsafePrettyPrint (\Maybe (LocatedA (Pat GhcPs))
_ LocatedA (Pat GhcPs)
_ -> Bool
False) Bool
False) (forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
x :: [LPat GhcPs]) forall a. [a] -> [a] -> [a]
++
  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LConDeclField GhcPs -> [Idea]
fieldDecl (forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
x)
   where
     preprocess :: GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
preprocess = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi LHsContext GhcPs -> LHsContext GhcPs
removeSingleAtomConstrCtxs
       where
         removeSingleAtomConstrCtxs :: LHsContext GhcPs -> LHsContext GhcPs
         removeSingleAtomConstrCtxs :: LHsContext GhcPs -> LHsContext GhcPs
removeSingleAtomConstrCtxs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \case
           [LocatedA (BangType GhcPs)
ty] | forall a. Brackets a => a -> Bool
isAtom LocatedA (BangType GhcPs)
ty -> []
           [LocatedA (BangType GhcPs)]
tys -> [LocatedA (BangType GhcPs)]
tys

     -- Brackets the roots of annotations are fine, so we strip them.
     annotations :: AnnDecl GhcPs -> AnnDecl GhcPs
     annotations :: AnnDecl GhcPs -> AnnDecl GhcPs
annotations= forall from to. Biplate from to => (to -> to) -> from -> from
descendBi forall a b. (a -> b) -> a -> b
$ \GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x -> case (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x :: LHsExpr GhcPs) of
       L SrcSpanAnn' (EpAnn AnnListItem)
_ (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ LHsExpr GhcPs
x LHsToken ")" GhcPs
_) -> LHsExpr GhcPs
x
       LHsExpr GhcPs
x -> LHsExpr 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) = forall p. XSpliceD p -> SpliceDecl p -> HsDecl p
SpliceD XSpliceD GhcPs
a forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall from to. Biplate from to => (to -> to) -> from -> from
descendBi SpliceDecl GhcPs
x forall a b. (a -> b) -> a -> b
$ \GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x -> case (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x :: LHsExpr GhcPs) of
       L SrcSpanAnn' (EpAnn AnnListItem)
_ (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ LHsExpr GhcPs
x LHsToken ")" GhcPs
_) -> LHsExpr GhcPs
x
       LHsExpr GhcPs
x -> LHsExpr 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 unnecessary 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 :: LHsExpr GhcPs -> String
prettyExpr s :: LHsExpr GhcPs
s@(L SrcSpanAnn' (EpAnn AnnListItem)
_ SectionL{}) = forall a. Outputable a => a -> String
unsafePrettyPrint (forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsPar LHsExpr GhcPs
s :: LHsExpr GhcPs)
prettyExpr s :: LHsExpr GhcPs
s@(L SrcSpanAnn' (EpAnn AnnListItem)
_ SectionR{}) = forall a. Outputable a => a -> String
unsafePrettyPrint (forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsPar LHsExpr GhcPs
s :: LHsExpr GhcPs)
prettyExpr LHsExpr GhcPs
x = forall a. Outputable a => a -> String
unsafePrettyPrint LHsExpr GhcPs
x

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

-- note(sf, 2022-06-02): i've completely bluffed my way through this.
-- see
-- https://gitlab.haskell.org/ghc/ghc/-/commit/7975202ba9010c581918413808ee06fbab9ac85f
-- for where splice expressions were refactored.
isPartialAtom :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
-- Might be '$x', which was really '$ x', but TH enabled misparsed it.
isPartialAtom :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
isPartialAtom Maybe (LHsExpr GhcPs)
_ (L SrcSpanAnn' (EpAnn AnnListItem)
_ (HsUntypedSplice XUntypedSplice GhcPs
_ HsUntypedSpliceExpr{})) = Bool
True
-- Might be '$(x)' where the brackets are required in GHC 8.10 and below
isPartialAtom (Just (L SrcSpanAnn' (EpAnn AnnListItem)
_ HsUntypedSplice{})) LHsExpr GhcPs
_ = Bool
True
isPartialAtom Maybe (LHsExpr GhcPs)
_ LHsExpr GhcPs
x = LHsExpr GhcPs -> Bool
isRecConstr LHsExpr GhcPs
x Bool -> Bool -> Bool
|| LHsExpr GhcPs -> Bool
isRecUpdate LHsExpr GhcPs
x

bracket :: forall a . (Data a, Outputable a, Brackets (LocatedA a)) => (LocatedA a -> String) -> (Maybe (LocatedA a) -> LocatedA a -> Bool) -> Bool -> LocatedA a -> [Idea]
bracket :: forall a.
(Data a, Outputable a, Brackets (LocatedA a)) =>
(LocatedA a -> String)
-> (Maybe (LocatedA a) -> LocatedA a -> Bool)
-> Bool
-> LocatedA a
-> [Idea]
bracket LocatedA a -> String
pretty Maybe (LocatedA a) -> LocatedA a -> Bool
isPartialAtom Bool
root = (Data a, Outputable a, Brackets (LocatedA a)) =>
Maybe (Int, LocatedA a, LocatedA a -> LocatedA a)
-> LocatedA a -> [Idea]
f 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 (LocatedA a)) => Maybe (Int, LocatedA a , LocatedA a -> LocatedA a) -> LocatedA a -> [Idea]
    -- No context. Removing parentheses from 'x' succeeds?
    f :: (Data a, Outputable a, Brackets (LocatedA a)) =>
Maybe (Int, LocatedA a, LocatedA a -> LocatedA a)
-> LocatedA a -> [Idea]
f Maybe (Int, LocatedA a, LocatedA a -> LocatedA a)
Nothing o :: LocatedA a
o@(forall a. Brackets (LocatedA a) => LocatedA a -> Maybe (LocatedA a)
remParens' -> Just LocatedA a
x)
      -- If at the root, or 'x' is an atom, 'x' parens are redundant.
      | Bool
root Bool -> Bool -> Bool
|| forall a. Brackets a => a -> Bool
isAtom LocatedA a
x
      , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Maybe (LocatedA a) -> LocatedA a -> Bool
isPartialAtom forall a. Maybe a
Nothing LocatedA a
x =
          (if forall a. Brackets a => a -> Bool
isAtom LocatedA a
x then forall a b.
(Outputable a, Outputable b, Brackets (LocatedA b)) =>
String -> LocatedA a -> LocatedA b -> Idea
bracketError else forall {e} {e} {a} {a}.
(Outputable e, Outputable e, Brackets (LocatedAn a e)) =>
String -> LocatedAn a e -> LocatedAn a e -> Idea
bracketWarning) String
msg LocatedA a
o LocatedA a
x forall a. a -> [a] -> [a]
: (Data a, Outputable a, Brackets (LocatedA a)) =>
LocatedA a -> [Idea]
g LocatedA a
x
    -- In some context, removing parentheses from 'x' succeeds and 'x'
    -- is atomic?
    f (Just (Int
_, LocatedA a
p, LocatedA a -> LocatedA a
_)) o :: LocatedA a
o@(forall a. Brackets (LocatedA a) => LocatedA a -> Maybe (LocatedA a)
remParens' -> Just LocatedA a
x)
      | forall a. Brackets a => a -> Bool
isAtom LocatedA a
x
      , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Maybe (LocatedA a) -> LocatedA a -> Bool
isPartialAtom (forall a. a -> Maybe a
Just LocatedA a
p) LocatedA a
x =
          forall a b.
(Outputable a, Outputable b, Brackets (LocatedA b)) =>
String -> LocatedA a -> LocatedA b -> Idea
bracketError String
msg LocatedA a
o LocatedA a
x forall a. a -> [a] -> [a]
: (Data a, Outputable a, Brackets (LocatedA a)) =>
LocatedA a -> [Idea]
g LocatedA a
x
    -- In some context, removing parentheses from 'x' succeeds. Does
    -- 'x' actually need bracketing in this context?
    f (Just (Int
i, LocatedA a
o, LocatedA a -> LocatedA a
gen)) v :: LocatedA a
v@(forall a. Brackets (LocatedA a) => LocatedA a -> Maybe (LocatedA a)
remParens' -> Just LocatedA a
x)
      | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i LocatedA a
o LocatedA a
x
      , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Maybe (LocatedA a) -> LocatedA a -> Bool
isPartialAtom (forall a. a -> Maybe a
Just LocatedA a
o) LocatedA a
x
      , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LPat GhcPs -> Bool
isSplicePat forall a b. (a -> b) -> a -> b
$ forall from to. Biplate from to => from -> [to]
universeBi LocatedA a
o -- over-appoximate ,see #1292
      = Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Suggestion String
msg (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA a
v) (LocatedA a -> String
pretty LocatedA a
o) (forall a. a -> Maybe a
Just (LocatedA a -> String
pretty (LocatedA a -> LocatedA a
gen LocatedA a
x))) [] [Refactoring SrcSpan
r] forall a. a -> [a] -> [a]
: (Data a, Outputable a, Brackets (LocatedA a)) =>
LocatedA a -> [Idea]
g LocatedA a
x
      where
        typ :: RType
typ = forall a. Brackets a => a -> RType
findType LocatedA a
v
        r :: Refactoring SrcSpan
r = forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
typ (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LocatedA a
v) [(String
"x", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LocatedA a
x)] String
"x"
    -- Regardless of the context, there are no parentheses to remove
    -- from 'x'.
    f Maybe (Int, LocatedA a, LocatedA a -> LocatedA a)
_ LocatedA a
x = (Data a, Outputable a, Brackets (LocatedA a)) =>
LocatedA a -> [Idea]
g LocatedA a
x

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

bracketWarning :: String -> LocatedAn a e -> LocatedAn a e -> Idea
bracketWarning String
msg LocatedAn a e
o LocatedAn a e
x =
  forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
msg (forall a e. LocatedAn a e -> Located e
reLoc LocatedAn a e
o) (forall a e. LocatedAn a e -> Located e
reLoc LocatedAn a e
x) [forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace (forall a. Brackets a => a -> RType
findType LocatedAn a e
x) (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LocatedAn a e
o) [(String
"x", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LocatedAn a e
x)] String
"x"]

bracketError :: (Outputable a, Outputable b, Brackets (LocatedA b)) => String -> LocatedA a -> LocatedA b -> Idea
bracketError :: forall a b.
(Outputable a, Outputable b, Brackets (LocatedA b)) =>
String -> LocatedA a -> LocatedA b -> Idea
bracketError String
msg LocatedA a
o LocatedA b
x =
  forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
msg (forall a e. LocatedAn a e -> Located e
reLoc LocatedA a
o) (forall a e. LocatedAn a e -> Located e
reLoc LocatedA b
x) [forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace (forall a. Brackets a => a -> RType
findType LocatedA b
x) (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LocatedA a
o) [(String
"x", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LocatedA b
x)] String
"x"]

fieldDecl ::  LConDeclField GhcPs -> [Idea]
fieldDecl :: LConDeclField GhcPs -> [Idea]
fieldDecl o :: LConDeclField GhcPs
o@(L SrcSpanAnn' (EpAnn AnnListItem)
loc f :: ConDeclField GhcPs
f@ConDeclField{cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_type=v :: XRec GhcPs (BangType GhcPs)
v@(L SrcSpanAnn' (EpAnn AnnListItem)
l (HsParTy XParTy GhcPs
_ XRec GhcPs (BangType GhcPs)
c))}) =
   let r :: LConDeclField GhcPs
r = forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn AnnListItem)
loc (ConDeclField GhcPs
f{cd_fld_type :: XRec GhcPs (BangType GhcPs)
cd_fld_type=XRec GhcPs (BangType GhcPs)
c}) :: LConDeclField GhcPs in
   [Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Suggestion String
"Redundant bracket" (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn AnnListItem)
l)
    (SDoc -> String
showSDocUnsafe forall a b. (a -> b) -> a -> b
$ forall {name} {l}.
(Outputable (XRec name (FieldOcc name)),
 Outputable (XRec name (BangType name)),
 Outputable (XXConDeclField name)) =>
GenLocated l (ConDeclField name) -> SDoc
ppr_fld LConDeclField GhcPs
o) -- Note this custom printer!
    (forall a. a -> Maybe a
Just (SDoc -> String
showSDocUnsafe forall a b. (a -> b) -> a -> b
$ forall {name} {l}.
(Outputable (XRec name (FieldOcc name)),
 Outputable (XRec name (BangType name)),
 Outputable (XXConDeclField name)) =>
GenLocated l (ConDeclField name) -> SDoc
ppr_fld LConDeclField GhcPs
r))
    []
    [forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Type (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA XRec GhcPs (BangType GhcPs)
v) [(String
"x", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA XRec GhcPs (BangType 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 Hs.Types.pprConDeclFields)
     ppr_fld :: GenLocated l (ConDeclField name) -> SDoc
ppr_fld (L l
_ ConDeclField { cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names = [XRec name (FieldOcc name)]
ns, cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_type = XRec name (BangType name)
ty, cd_fld_doc :: forall pass. ConDeclField pass -> Maybe (LHsDoc pass)
cd_fld_doc = Maybe (LHsDoc name)
doc })
       = forall name. Maybe (LHsDoc name) -> SDoc -> SDoc
pprMaybeWithDoc Maybe (LHsDoc name)
doc (forall {a}. Outputable a => [a] -> SDoc
ppr_names [XRec name (FieldOcc name)]
ns forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr XRec name (BangType name)
ty)
     ppr_fld (L l
_ (XConDeclField XXConDeclField name
x)) = forall a. Outputable a => a -> SDoc
ppr XXConDeclField name
x

     ppr_names :: [a] -> SDoc
ppr_names [a
n] = forall a. Outputable a => a -> SDoc
ppr a
n
     ppr_names [a]
ns = forall doc. IsLine doc => [doc] -> doc
sep (forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
comma (forall a b. (a -> b) -> [a] -> [b]
map 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 :: LHsExpr GhcPs -> [Idea]
dollar = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
-> [Idea]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall on. Uniplate on => on -> [on]
universe
  where
    f :: GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
-> [Idea]
f GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x = [ (forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Redundant $" (forall a e. LocatedAn a e -> Located e
reLoc GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x) (forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
y) [Refactoring SrcSpan
r]){ideaSpan :: SrcSpan
ideaSpan = forall a. SrcSpanAnn' a -> SrcSpan
locA (forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
d)} | L SrcSpanAnn' (EpAnn AnnListItem)
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
a LHsExpr GhcPs
d LHsExpr GhcPs
b) <- [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x], LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
d
            , let y :: LHsExpr GhcPs
y = forall a an. a -> LocatedAn an a
noLocA (forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
a LHsExpr GhcPs
b) :: LHsExpr GhcPs
            , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
0 LHsExpr GhcPs
y LHsExpr GhcPs
a
            , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
1 LHsExpr GhcPs
y LHsExpr GhcPs
b
            , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
isPartialAtom (forall a. a -> Maybe a
Just GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x) LHsExpr GhcPs
b
            , let r :: Refactoring SrcSpan
r = forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x) [(String
"a", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
a), (String
"b", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
b)] String
"a b"]
          forall a. [a] -> [a] -> [a]
++
          [ forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Move brackets to avoid $" (forall a e. LocatedAn a e -> Located e
reLoc GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x) (forall a e. LocatedAn a e -> Located e
reLoc (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
t GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
y)) [Refactoring SrcSpan
r]
            |(GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
t, e :: GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
e@(L SrcSpanAnn' (EpAnn AnnListItem)
_ (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ (L SrcSpanAnn' (EpAnn AnnListItem)
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
a1 LHsExpr GhcPs
op1 LHsExpr GhcPs
a2)) LHsToken ")" GhcPs
_))) <- LHsExpr GhcPs -> [(LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)]
splitInfix GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x
            , LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
op1
            , LHsExpr GhcPs -> Bool
isVar LHsExpr GhcPs
a1 Bool -> Bool -> Bool
|| LHsExpr GhcPs -> Bool
isApp LHsExpr GhcPs
a1 Bool -> Bool -> Bool
|| LHsExpr GhcPs -> Bool
isPar LHsExpr GhcPs
a1, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Brackets a => a -> Bool
isAtom LHsExpr GhcPs
a2
            , LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
a1 forall a. Eq a => a -> a -> Bool
/= String
"select" -- special case for esqueleto, see #224
            , let y :: GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
y = forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
a1 (forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsPar LHsExpr GhcPs
a2)
            , let r :: Refactoring SrcSpan
r = forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
e) [(String
"a", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
a1), (String
"b", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
a2)] String
"a (b)" ]
          forall a. [a] -> [a] -> [a]
++  -- Special case of (v1 . v2) <$> v3
          [ (forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Redundant bracket" (forall a e. LocatedAn a e -> Located e
reLoc GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x) (forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
y) [Refactoring SrcSpan
r]){ideaSpan :: SrcSpan
ideaSpan = forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn AnnListItem)
locPar}
          | L SrcSpanAnn' (EpAnn AnnListItem)
_ (OpApp XOpApp GhcPs
_ (L SrcSpanAnn' (EpAnn AnnListItem)
locPar (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ o1 :: LHsExpr GhcPs
o1@(L SrcSpanAnn' (EpAnn AnnListItem)
locNoPar (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ (LHsExpr GhcPs -> Bool
isDot -> Bool
True) LHsExpr GhcPs
_)) LHsToken ")" GhcPs
_)) LHsExpr GhcPs
o2 LHsExpr GhcPs
v3) <- [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x], LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
o2 forall a. Eq a => a -> a -> Bool
== String
"<$>"
          , let y :: LHsExpr GhcPs
y = forall a an. a -> LocatedAn an a
noLocA (forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
o1 LHsExpr GhcPs
o2 LHsExpr GhcPs
v3) :: LHsExpr GhcPs
          , let r :: Refactoring SrcSpan
r = forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (SrcSpan -> SrcSpan
toRefactSrcSpan (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn AnnListItem)
locPar)) [(String
"a", SrcSpan -> SrcSpan
toRefactSrcSpan (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn AnnListItem)
locNoPar))] String
"a"]
          forall a. [a] -> [a] -> [a]
++
          [ forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Redundant section" (forall a e. LocatedAn a e -> Located e
reLoc GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x) (forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
y) [Refactoring SrcSpan
r]
          | L SrcSpanAnn' (EpAnn AnnListItem)
_ (HsApp XApp GhcPs
_ (L SrcSpanAnn' (EpAnn AnnListItem)
_ (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ (L SrcSpanAnn' (EpAnn AnnListItem)
_ (SectionL XSectionL GhcPs
_ LHsExpr GhcPs
a LHsExpr GhcPs
b)) LHsToken ")" GhcPs
_)) LHsExpr GhcPs
c) <- [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x]
          -- , error $ show (unsafePrettyPrint a, gshow b, unsafePrettyPrint c)
          , let y :: LHsExpr GhcPs
y = forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
a LHsExpr GhcPs
b LHsExpr GhcPs
c :: LHsExpr GhcPs
          , let r :: Refactoring SrcSpan
r = forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs)
x) [(String
"x", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
a), (String
"op", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
b), (String
"y", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
c)] String
"x op y"]

splitInfix :: LHsExpr GhcPs -> [(LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)]
splitInfix :: LHsExpr GhcPs -> [(LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)]
splitInfix (L SrcSpanAnn' (EpAnn AnnListItem)
l (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
lhs LHsExpr GhcPs
op LHsExpr GhcPs
rhs)) =
  [(forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn AnnListItem)
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
lhs LHsExpr GhcPs
op, LHsExpr GhcPs
rhs), (\LHsExpr GhcPs
lhs -> forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn AnnListItem)
l (forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
lhs LHsExpr GhcPs
op LHsExpr GhcPs
rhs), LHsExpr GhcPs
lhs)]
splitInfix LHsExpr GhcPs
_ = []