{-# 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))
no = ($1)
yes = (($1)) -- @Warning ($1)
no = (+5)
yes = ((+5)) -- @Warning (+5)

-- 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
foo (A{}) = True -- A{}
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}

-- $/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})
</TEST>
-}


module Hint.Bracket(bracketHint) where

import Hint.Type(DeclHint',Idea(..),rawIdea',warn',suggest',Severity(..),toSS')
import Data.Data
import Data.Generics.Uniplate.Operations
import Refact.Types

import HsSyn
import Outputable
import SrcLoc
import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr

bracketHint :: DeclHint'
bracketHint :: DeclHint'
bracketHint _ _ x :: LHsDecl GhcPs
x =
  (LHsExpr GhcPs -> [Idea]) -> [LHsExpr GhcPs] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\x :: LHsExpr GhcPs
x -> (LHsExpr GhcPs -> String)
-> (LHsExpr GhcPs -> Bool) -> Bool -> LHsExpr GhcPs -> [Idea]
forall a.
(Data a, Data (SrcSpanLess a), HasSrcSpan a, Outputable a,
 Brackets' a) =>
(a -> String) -> (a -> Bool) -> Bool -> a -> [Idea]
bracket LHsExpr GhcPs -> String
prettyExpr LHsExpr GhcPs -> Bool
isPartialAtom Bool
True LHsExpr GhcPs
x [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ LHsExpr GhcPs -> [Idea]
dollar LHsExpr GhcPs
x) (LHsDecl GhcPs -> [LHsExpr GhcPs]
forall from to. Biplate from to => from -> [to]
childrenBi ((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]
++
  (LHsType GhcPs -> [Idea]) -> [LHsType GhcPs] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((LHsType GhcPs -> String)
-> (LHsType GhcPs -> Bool) -> Bool -> LHsType GhcPs -> [Idea]
forall a.
(Data a, Data (SrcSpanLess a), HasSrcSpan a, Outputable a,
 Brackets' a) =>
(a -> String) -> (a -> Bool) -> Bool -> a -> [Idea]
bracket LHsType GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (Bool -> LHsType GhcPs -> Bool
forall a b. a -> b -> a
const Bool
False) Bool
False) (LHsDecl GhcPs -> [LHsType GhcPs]
forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
x :: [LHsType GhcPs]) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
  (Pat GhcPs -> [Idea]) -> [Pat GhcPs] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Pat GhcPs -> String)
-> (Pat GhcPs -> Bool) -> Bool -> Pat GhcPs -> [Idea]
forall a.
(Data a, Data (SrcSpanLess a), HasSrcSpan a, Outputable a,
 Brackets' a) =>
(a -> String) -> (a -> Bool) -> Bool -> a -> [Idea]
bracket Pat GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (Bool -> Pat GhcPs -> Bool
forall a b. a -> b -> a
const Bool
False) Bool
False) (LHsDecl GhcPs -> [Pat GhcPs]
forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
x :: [Pat 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= (LHsExpr GhcPs -> LHsExpr GhcPs) -> AnnDecl GhcPs -> AnnDecl GhcPs
forall from to. Biplate from to => (to -> to) -> from -> from
descendBi ((LHsExpr GhcPs -> LHsExpr GhcPs)
 -> AnnDecl GhcPs -> AnnDecl GhcPs)
-> (LHsExpr GhcPs -> LHsExpr GhcPs)
-> AnnDecl GhcPs
-> AnnDecl GhcPs
forall a b. (a -> b) -> a -> b
$ \x :: LHsExpr GhcPs
x -> case (LHsExpr GhcPs
x :: LHsExpr GhcPs) of
       LL l :: SrcSpan
l (HsPar _ x) -> LHsExpr GhcPs
x
       x :: LHsExpr GhcPs
x -> LHsExpr 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 :: LHsExpr GhcPs -> String
prettyExpr s :: LHsExpr GhcPs
s@(LL _ SectionL{}) = LHsExpr GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar NoExt
XPar GhcPs
noExt LHsExpr GhcPs
s) :: LHsExpr GhcPs)
prettyExpr s :: LHsExpr GhcPs
s@(LL _ SectionR{}) = LHsExpr GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar NoExt
XPar GhcPs
noExt LHsExpr GhcPs
s) :: LHsExpr GhcPs)
prettyExpr x :: LHsExpr GhcPs
x = LHsExpr GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint LHsExpr GhcPs
x

-- Dirty, should add to Brackets type class I think
tyConToRtype :: String -> RType
tyConToRtype :: String -> RType
tyConToRtype "Exp"    = RType
Expr
tyConToRtype "Type"   = RType
Type
tyConToRtype "HsType" = RType
Type
tyConToRtype "Pat"    = RType
Pattern
tyConToRtype _        = RType
Expr

findType :: (Data a) => a -> RType
findType :: a -> RType
findType = String -> RType
tyConToRtype (String -> RType) -> (a -> String) -> a -> RType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> String
dataTypeName (DataType -> String) -> (a -> DataType) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DataType
forall a. Data a => a -> DataType
dataTypeOf

-- 'Just _' if at least one set of parens were removed. 'Nothing' if
-- zero parens were removed.
remParens' :: Brackets' a => a -> Maybe a
remParens' :: a -> Maybe a
remParens' = (a -> a) -> Maybe a -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Brackets' a => a -> a
go (Maybe a -> Maybe a) -> (a -> Maybe a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. Brackets' a => a -> Maybe a
remParen'
  where
    go :: a -> a
go e :: 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 :: LHsExpr GhcPs -> Bool
-- Might be '$x', which was really '$ x', but TH enabled misparsed it.
isPartialAtom :: LHsExpr GhcPs -> Bool
isPartialAtom (LL _ (HsSpliceE _ (HsTypedSplice _ HasDollar _ _) )) = Bool
True
isPartialAtom (LL _ (HsSpliceE _ (HsUntypedSplice _ HasDollar _ _) )) = Bool
True
isPartialAtom x :: 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, Data (SrcSpanLess a), HasSrcSpan a, Outputable a, Brackets' a) => (a -> String) -> (a -> Bool) -> Bool -> a -> [Idea]
bracket :: (a -> String) -> (a -> Bool) -> Bool -> a -> [Idea]
bracket pretty :: a -> String
pretty isPartialAtom :: a -> Bool
isPartialAtom root :: Bool
root = Maybe (Int, a, a -> a) -> a -> [Idea]
(HasSrcSpan a, Data a, Outputable a, Brackets' a) =>
Maybe (Int, a, a -> a) -> a -> [Idea]
f Maybe (Int, a, a -> a)
forall a. Maybe a
Nothing
  where
    msg :: String
msg = "Redundant bracket"
    -- 'f' is a (generic) function over types in 'Brackets'
    -- (expressions, patterns and types). Arguments are, 'f (Maybe
    -- (index, parent, gen)) child'.
    f :: (HasSrcSpan a, Data a, Outputable a, Brackets' a) => Maybe (Int, a , a -> a) -> a -> [Idea]
    -- No context. Removing parentheses from 'x' succeeds?
    f :: Maybe (Int, a, a -> a) -> a -> [Idea]
f Nothing o :: a
o@(a -> Maybe a
forall a. Brackets' a => a -> Maybe a
remParens' -> Just x :: a
x)
      -- If at the root, or 'x' is an atom, 'x' parens are redundant.
      | Bool
root Bool -> Bool -> Bool
|| a -> Bool
forall a. Brackets' a => a -> Bool
isAtom' a
x
      , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Bool
isPartialAtom a
x =
          (if a -> Bool
forall a. Brackets' a => a -> Bool
isAtom' a
x then String -> a -> a -> Idea
forall a b.
(HasSrcSpan a, HasSrcSpan b, Data (SrcSpanLess b), Outputable a,
 Outputable b) =>
String -> a -> b -> Idea
bracketError else String -> a -> a -> Idea
forall a b.
(HasSrcSpan a, HasSrcSpan b, Data (SrcSpanLess b), Outputable a,
 Outputable b) =>
String -> a -> b -> Idea
bracketWarning) String
msg a
o a
x Idea -> [Idea] -> [Idea]
forall a. a -> [a] -> [a]
: a -> [Idea]
(HasSrcSpan a, Data a, Outputable a, Brackets' a) => a -> [Idea]
g a
x
    -- In some context, removing parentheses from 'x' succeeds and 'x'
    -- is atomic?
    f Just{} o :: a
o@(a -> Maybe a
forall a. Brackets' a => a -> Maybe a
remParens' -> Just x :: a
x)
      | a -> Bool
forall a. Brackets' a => a -> Bool
isAtom' a
x
      , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Bool
isPartialAtom a
x =
          String -> a -> a -> Idea
forall a b.
(HasSrcSpan a, HasSrcSpan b, Data (SrcSpanLess b), Outputable a,
 Outputable b) =>
String -> a -> b -> Idea
bracketError String
msg a
o a
x Idea -> [Idea] -> [Idea]
forall a. a -> [a] -> [a]
: a -> [Idea]
(HasSrcSpan a, Data a, Outputable a, Brackets' a) => a -> [Idea]
g a
x
    -- In some context, removing parentheses from 'x' succeeds. Does
    -- 'x' actually need bracketing in this context?
    f (Just (i :: Int
i, o :: a
o, gen :: a -> a
gen)) v :: a
v@(a -> Maybe a
forall a. Brackets' a => a -> Maybe a
remParens' -> Just x :: a
x)
      | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> Bool
forall a. Brackets' a => Int -> a -> a -> Bool
needBracket' Int
i a
o a
x, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Bool
isPartialAtom a
x =
          Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea' Severity
Suggestion String
msg (a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc a
o) (a -> String
pretty a
o) (String -> Maybe String
forall a. a -> Maybe a
Just (a -> String
pretty (a -> a
gen a
x))) [] [Refactoring SrcSpan
r] Idea -> [Idea] -> [Idea]
forall a. a -> [a] -> [a]
: a -> [Idea]
(HasSrcSpan a, Data a, Outputable a, Brackets' a) => a -> [Idea]
g a
x
      where
        typ :: RType
typ = SrcSpanLess a -> RType
forall a. Data a => a -> RType
findType (a -> SrcSpanLess a
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc 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 (a -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' a
v) [("x", a -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' a
x)] "x"
    -- Regardless of the context, there are no parentheses to remove
    -- from 'x'.
    f _ x :: a
x = a -> [Idea]
(HasSrcSpan a, Data a, Outputable a, Brackets' a) => a -> [Idea]
g a
x

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

bracketWarning :: (HasSrcSpan a, HasSrcSpan b, Data (SrcSpanLess b), Outputable a, Outputable b) => String -> a -> b -> Idea
bracketWarning :: String -> a -> b -> Idea
bracketWarning msg :: String
msg o :: a
o x :: b
x =
  String -> a -> b -> [Refactoring SrcSpan] -> Idea
forall a b.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
suggest' String
msg a
o b
x [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace (SrcSpanLess b -> RType
forall a. Data a => a -> RType
findType (b -> SrcSpanLess b
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc b
x)) (a -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' a
o) [("x", b -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' b
x)] "x"]

bracketError :: (HasSrcSpan a, HasSrcSpan b, Data (SrcSpanLess b), Outputable a, Outputable b ) => String -> a -> b -> Idea
bracketError :: String -> a -> b -> Idea
bracketError msg :: String
msg o :: a
o x :: b
x =
  String -> a -> b -> [Refactoring SrcSpan] -> Idea
forall a b.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
warn' String
msg a
o b
x [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace (SrcSpanLess b -> RType
forall a. Data a => a -> RType
findType (b -> SrcSpanLess b
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc b
x)) (a -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' a
o) [("x", b -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' b
x)] "x"]

fieldDecl ::  LConDeclField GhcPs -> [Idea]
fieldDecl :: LConDeclField GhcPs -> [Idea]
fieldDecl o :: LConDeclField GhcPs
o@(LL loc :: SrcSpan
loc f :: SrcSpanLess (LConDeclField GhcPs)
f@ConDeclField{cd_fld_type=v@(LL l (HsParTy _ c))}) =
   let r :: LConDeclField GhcPs
r = SrcSpan -> SrcSpanLess (LConDeclField GhcPs) -> LConDeclField GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
LL SrcSpan
loc (SrcSpanLess (LConDeclField GhcPs)
ConDeclField GhcPs
f{cd_fld_type :: LHsType GhcPs
cd_fld_type=LHsType GhcPs
c}) :: LConDeclField GhcPs in
   [Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea' Severity
Suggestion "Redundant bracket" SrcSpan
loc
    (SDoc -> String
showSDocUnsafe (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ LConDeclField GhcPs -> SDoc
forall (pass :: Pass) a.
(OutputableBndr (IdP (GhcPass (NoGhcTcPass pass))),
 OutputableBndr (NameOrRdrName (IdP (GhcPass (NoGhcTcPass pass)))),
 OutputableBndr (IdP (GhcPass pass)),
 OutputableBndr (NameOrRdrName (IdP (GhcPass pass))), HasSrcSpan a,
 Outputable (XIPBinds (GhcPass pass)),
 Outputable (XViaStrategy (GhcPass pass)),
 Outputable (XIPBinds (GhcPass (NoGhcTcPass pass))),
 Outputable (XViaStrategy (GhcPass (NoGhcTcPass pass))),
 NoGhcTcPass pass ~ NoGhcTcPass (NoGhcTcPass pass),
 SrcSpanLess a ~ ConDeclField (GhcPass pass)) =>
a -> 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 :: Pass) a.
(OutputableBndr (IdP (GhcPass (NoGhcTcPass pass))),
 OutputableBndr (NameOrRdrName (IdP (GhcPass (NoGhcTcPass pass)))),
 OutputableBndr (IdP (GhcPass pass)),
 OutputableBndr (NameOrRdrName (IdP (GhcPass pass))), HasSrcSpan a,
 Outputable (XIPBinds (GhcPass pass)),
 Outputable (XViaStrategy (GhcPass pass)),
 Outputable (XIPBinds (GhcPass (NoGhcTcPass pass))),
 Outputable (XViaStrategy (GhcPass (NoGhcTcPass pass))),
 NoGhcTcPass pass ~ NoGhcTcPass (NoGhcTcPass pass),
 SrcSpanLess a ~ ConDeclField (GhcPass pass)) =>
a -> 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 (LHsType GhcPs -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' LHsType GhcPs
v) [("x", LHsType GhcPs -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' LHsType GhcPs
c)] "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 :: a -> SDoc
ppr_fld (LL _ ConDeclField { cd_fld_names = ns, cd_fld_type = ty, cd_fld_doc = doc })
       = [LFieldOcc (GhcPass pass)] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppr_names [LFieldOcc (GhcPass pass)]
ns SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> LBangType (GhcPass pass) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LBangType (GhcPass pass)
ty SDoc -> SDoc -> SDoc
<+> Maybe LHsDocString -> SDoc
ppr_mbDoc Maybe LHsDocString
doc
     ppr_fld (LL _ (XConDeclField x)) = NoExt -> SDoc
forall a. Outputable a => a -> SDoc
ppr NoExt
XXConDeclField (GhcPass pass)
x
     ppr_fld _ = SDoc
forall a. HasCallStack => a
undefined -- '{-# COMPLETE LL #-}'

     ppr_names :: [a] -> SDoc
ppr_names [n :: a
n] = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
n
     ppr_names ns :: [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 _ = []

-- This function relies heavily on fixities having been applied to the
-- raw parse tree.
dollar :: LHsExpr GhcPs -> [Idea]
dollar :: LHsExpr GhcPs -> [Idea]
dollar = (LHsExpr GhcPs -> [Idea]) -> [LHsExpr GhcPs] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsExpr GhcPs -> [Idea]
f ([LHsExpr GhcPs] -> [Idea])
-> (LHsExpr GhcPs -> [LHsExpr GhcPs]) -> LHsExpr GhcPs -> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> [LHsExpr GhcPs]
forall on. Uniplate on => on -> [on]
universe
  where
    f :: LHsExpr GhcPs -> [Idea]
f x :: LHsExpr GhcPs
x = [ String
-> LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring SrcSpan] -> Idea
forall a b.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
suggest' "Redundant $" LHsExpr GhcPs
x LHsExpr GhcPs
y [Refactoring SrcSpan
r]| o :: LHsExpr GhcPs
o@(LL loc :: SrcSpan
loc (OpApp _ a d b)) <- [LHsExpr GhcPs
x], LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
d
            , let y :: LHsExpr GhcPs
y = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExt
XApp GhcPs
noExt LHsExpr GhcPs
a LHsExpr GhcPs
b) :: LHsExpr GhcPs
            , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
forall a. Brackets' a => Int -> a -> a -> Bool
needBracket' 0 LHsExpr GhcPs
y LHsExpr GhcPs
a
            , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
forall a. Brackets' a => Int -> a -> a -> Bool
needBracket' 1 LHsExpr GhcPs
y LHsExpr GhcPs
b
            , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> Bool
isPartialAtom LHsExpr 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 (LHsExpr GhcPs -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' LHsExpr GhcPs
x) [("a", LHsExpr GhcPs -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' LHsExpr GhcPs
a), ("b", LHsExpr GhcPs -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' LHsExpr GhcPs
b)] "a b"]
          [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
          [ String
-> LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring SrcSpan] -> Idea
forall a b.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
suggest' "Move brackets to avoid $" LHsExpr GhcPs
x (LHsExpr GhcPs -> LHsExpr GhcPs
t LHsExpr GhcPs
y) [Refactoring SrcSpan
r]
            |(t :: LHsExpr GhcPs -> LHsExpr GhcPs
t, e :: LHsExpr GhcPs
e@(LL _ (HsPar _ (LL _ (OpApp _ a1 op1 a2))))) <- LHsExpr GhcPs -> [(LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)]
splitInfix LHsExpr 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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> Bool
forall a. Brackets' a => a -> Bool
isAtom' LHsExpr GhcPs
a2
            , LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
a1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "select" -- special case for esqueleto, see #224
            , let y :: LHsExpr GhcPs
y = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs)
-> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExt
XApp GhcPs
noExt LHsExpr GhcPs
a1 (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar NoExt
XPar GhcPs
noExt LHsExpr 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 (LHsExpr GhcPs -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' LHsExpr GhcPs
e) [("a", LHsExpr GhcPs -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' LHsExpr GhcPs
a1), ("b", LHsExpr GhcPs -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' LHsExpr GhcPs
a2)] "a (b)" ]
          [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++  -- Special case of (v1 . v2) <$> v3
          [ String
-> LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring SrcSpan] -> Idea
forall a b.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
suggest' "Redundant bracket" LHsExpr GhcPs
x LHsExpr GhcPs
y []
          | LL _ (OpApp _ (LL _ (HsPar _ o1@(LL _ (OpApp _ v1 (isDot -> True) v2)))) o2 v3) <- [LHsExpr GhcPs
x], LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
o2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "<$>"
          , let y :: LHsExpr GhcPs
y = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExt
XOpApp GhcPs
noExt LHsExpr GhcPs
o1 LHsExpr GhcPs
o2 LHsExpr GhcPs
v3) :: LHsExpr GhcPs]

splitInfix :: LHsExpr GhcPs -> [(LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)]
splitInfix :: LHsExpr GhcPs -> [(LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)]
splitInfix (LL l :: SrcSpan
l (OpApp _ lhs op rhs)) =
  [(SrcSpan -> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
LL SrcSpan
l (HsExpr GhcPs -> LHsExpr GhcPs)
-> (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs
-> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExt
XOpApp GhcPs
noExt LHsExpr GhcPs
lhs LHsExpr GhcPs
op, LHsExpr GhcPs
rhs), (\lhs :: LHsExpr GhcPs
lhs -> SrcSpan -> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
LL SrcSpan
l (XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExt
XOpApp GhcPs
noExt LHsExpr GhcPs
lhs LHsExpr GhcPs
op LHsExpr GhcPs
rhs), LHsExpr GhcPs
lhs)]
splitInfix _ = []