{-

Raise a warning if you have redundant brackets in nested infix expressions.

<TEST>
yes = 1 + (2 * 3) -- @Ignore 1 + 2 * 3
yes = (2 * 3) + 1 -- @Ignore 2 * 3 + 1
no = (1 + 2) * 3
no = 3 * (1 + 2)
no = 1 + 2 * 3
no = 2 * 3 + 1
yes = (a >>= f) >>= g -- @Ignore a >>= f >>= g
no = (a >>= \x -> b) >>= g
</TEST>
-}

module Hint.Fixities(fixitiesHint) where

import Hint.Type(DeclHint,Idea(..),rawIdea,toSSA)
import Config.Type
import Control.Monad
import Data.List.Extra
import Data.Map
import Data.Generics.Uniplate.DataOnly
import Refact.Types

import GHC.Types.Fixity(compareFixity)
import Fixity
import GHC.Hs
import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
import GHC.Types.SrcLoc
import GHC.Types.Name.Reader
import GHC.Types.Name.Occurrence

fixitiesHint :: [Setting] -> DeclHint
fixitiesHint :: [Setting] -> DeclHint
fixitiesHint [Setting]
settings Scope
_ ModuleEx
_ LHsDecl GhcPs
x =
  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Map String Fixity -> LHsExpr GhcPs -> [Idea]
infixBracket Map String Fixity
fixities) (forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
x :: [LHsExpr GhcPs])
   where
     fixities :: Map String Fixity
fixities = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Setting -> Map String Fixity
getFixity [Setting]
settings forall a. Monoid a => a -> a -> a
`mappend` forall k a. Ord k => [(k, a)] -> Map k a
fromList (FixityInfo -> (String, Fixity)
toFixity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FixityInfo]
defaultFixities)
     getFixity :: Setting -> Map String Fixity
getFixity (Infix FixityInfo
x) = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k a. k -> a -> Map k a
Data.Map.singleton (FixityInfo -> (String, Fixity)
toFixity FixityInfo
x)
     getFixity Setting
_ = forall a. Monoid a => a
mempty

infixBracket :: Map String Fixity -> LHsExpr GhcPs -> [Idea]
infixBracket :: Map String Fixity -> LHsExpr GhcPs -> [Idea]
infixBracket Map String Fixity
fixities = Maybe
  (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
   GenLocated SrcSpanAnnA (HsExpr GhcPs)
   -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
f forall a. Maybe a
Nothing
  where
    msg :: String
msg = String
"Redundant bracket due to operator fixities"
    f :: Maybe
  (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
   GenLocated SrcSpanAnnA (HsExpr GhcPs)
   -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
f Maybe
  (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
   GenLocated SrcSpanAnnA (HsExpr GhcPs)
   -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
p GenLocated SrcSpanAnnA (HsExpr GhcPs)
o = forall {a}.
Outputable a =>
Maybe
  (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
   GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
cur Maybe
  (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
   GenLocated SrcSpanAnnA (HsExpr GhcPs)
   -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
p GenLocated SrcSpanAnnA (HsExpr GhcPs)
o forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Maybe
  (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
   GenLocated SrcSpanAnnA (HsExpr GhcPs)
   -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
f (forall a. a -> Maybe a
Just (Int
i, GenLocated SrcSpanAnnA (HsExpr GhcPs)
o, GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
gen)) GenLocated SrcSpanAnnA (HsExpr GhcPs)
x | (Int
i, (GenLocated SrcSpanAnnA (HsExpr GhcPs)
x, GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
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 GenLocated SrcSpanAnnA (HsExpr GhcPs)
o]
    cur :: Maybe
  (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
   GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
cur Maybe
  (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
   GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a)
p GenLocated SrcSpanAnnA (HsExpr GhcPs)
v = do
      Just (Int
i, GenLocated SrcSpanAnnA (HsExpr GhcPs)
o, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a
gen) <- [Maybe
  (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
   GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a)
p]
      Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
x <- [forall a. Brackets a => a -> Maybe a
remParen GenLocated SrcSpanAnnA (HsExpr GhcPs)
v]
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Map String Fixity -> Int -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
redundantInfixBracket Map String Fixity
fixities Int
i GenLocated SrcSpanAnnA (HsExpr GhcPs)
o GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Ignore String
msg (forall a. SrcSpanAnn' a -> SrcSpan
locA (forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
v)) (forall a. Outputable a => a -> String
unsafePrettyPrint GenLocated SrcSpanAnnA (HsExpr GhcPs)
o)
        (forall a. a -> Maybe a
Just (forall a. Outputable a => a -> String
unsafePrettyPrint (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a
gen GenLocated SrcSpanAnnA (HsExpr GhcPs)
x))) [] [forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace (forall a. Brackets a => a -> RType
findType GenLocated SrcSpanAnnA (HsExpr GhcPs)
v) (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
v) [(String
"x", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)] String
"x"]

redundantInfixBracket :: Map String Fixity -> Int -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
redundantInfixBracket :: Map String Fixity -> Int -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
redundantInfixBracket Map String Fixity
fixities Int
i LHsExpr GhcPs
parent LHsExpr GhcPs
child
    | L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ (Unqual OccName
p)))) LHsExpr GhcPs
_) <- LHsExpr GhcPs
parent
    , L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ (Unqual OccName
c)))) (L SrcSpanAnnA
_ HsExpr GhcPs
cr)) <- LHsExpr GhcPs
child =
    let (OccName
lop, OccName
rop)
            | Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = (OccName
c, OccName
p)
            | Bool
otherwise = (OccName
p, OccName
c)
    in
    case Fixity -> Fixity -> (Bool, Bool)
compareFixity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map String Fixity
fixities forall k a. Ord k => Map k a -> k -> Maybe a
Data.Map.!? OccName -> String
occNameString OccName
lop) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Map String Fixity
fixities forall k a. Ord k => Map k a -> k -> Maybe a
Data.Map.!? OccName -> String
occNameString OccName
rop) of
    Just (Bool
False, Bool
r)
        | Int
i forall a. Eq a => a -> a -> Bool
== Int
0 -> Bool -> Bool
not (forall p. HsExpr p -> Bool
needParenAsChild HsExpr GhcPs
cr Bool -> Bool -> Bool
|| Bool
r)
        | Bool
otherwise -> Bool
r
    Maybe (Bool, Bool)
_ -> Bool
False
    | Bool
otherwise = Bool
False

needParenAsChild :: HsExpr p -> Bool
needParenAsChild :: forall p. HsExpr p -> Bool
needParenAsChild HsLet{} = Bool
True
needParenAsChild HsDo{} = Bool
True
needParenAsChild HsLam{} = Bool
True
needParenAsChild HsLamCase{} = Bool
True
needParenAsChild HsCase{} = Bool
True
needParenAsChild HsIf{} = Bool
True
needParenAsChild HsExpr p
_ = Bool
False