{-

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 =
  (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea])
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Map String Fixity -> LHsExpr GhcPs -> [Idea]
infixBracket Map String Fixity
fixities) (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
x :: [LHsExpr GhcPs])
   where
     fixities :: Map String Fixity
fixities = (Setting -> Map String Fixity) -> [Setting] -> Map String Fixity
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Setting -> Map String Fixity
getFixity [Setting]
settings Map String Fixity -> Map String Fixity -> Map String Fixity
forall a. Monoid a => a -> a -> a
`mappend` [(String, Fixity)] -> Map String Fixity
forall k a. Ord k => [(k, a)] -> Map k a
fromList (FixityInfo -> (String, Fixity)
toFixity (FixityInfo -> (String, Fixity))
-> [FixityInfo] -> [(String, Fixity)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FixityInfo]
defaultFixities)
     getFixity :: Setting -> Map String Fixity
getFixity (Infix FixityInfo
x) = (String -> Fixity -> Map String Fixity)
-> (String, Fixity) -> Map String Fixity
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Fixity -> Map String Fixity
forall k a. k -> a -> Map k a
Data.Map.singleton (FixityInfo -> (String, Fixity)
toFixity FixityInfo
x)
     getFixity Setting
_ = Map String Fixity
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 Maybe
  (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
   GenLocated SrcSpanAnnA (HsExpr GhcPs)
   -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
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 = Maybe
  (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
   GenLocated SrcSpanAnnA (HsExpr GhcPs)
   -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
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 [Idea] -> [Idea] -> [Idea]
forall a. Semigroup a => a -> a -> a
<> [[Idea]] -> [Idea]
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 ((Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
 GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe
     (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs),
      GenLocated SrcSpanAnnA (HsExpr GhcPs)
      -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
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)) <- Int
-> [(GenLocated SrcSpanAnnA (HsExpr GhcPs),
     GenLocated SrcSpanAnnA (HsExpr GhcPs)
     -> GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [(Int,
     (GenLocated SrcSpanAnnA (HsExpr GhcPs),
      GenLocated SrcSpanAnnA (HsExpr GhcPs)
      -> GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 ([(GenLocated SrcSpanAnnA (HsExpr GhcPs),
   GenLocated SrcSpanAnnA (HsExpr GhcPs)
   -> GenLocated SrcSpanAnnA (HsExpr GhcPs))]
 -> [(Int,
      (GenLocated SrcSpanAnnA (HsExpr GhcPs),
       GenLocated SrcSpanAnnA (HsExpr GhcPs)
       -> GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [(GenLocated SrcSpanAnnA (HsExpr GhcPs),
     GenLocated SrcSpanAnnA (HsExpr GhcPs)
     -> GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [(Int,
     (GenLocated SrcSpanAnnA (HsExpr GhcPs),
      GenLocated SrcSpanAnnA (HsExpr GhcPs)
      -> GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [(GenLocated SrcSpanAnnA (HsExpr GhcPs),
     GenLocated SrcSpanAnnA (HsExpr GhcPs)
     -> GenLocated SrcSpanAnnA (HsExpr GhcPs))]
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 <- [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. Brackets a => a -> Maybe a
remParen GenLocated SrcSpanAnnA (HsExpr GhcPs)
v]
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Map String Fixity -> Int -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
redundantInfixBracket Map String Fixity
fixities Int
i LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
      Idea -> [Idea]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Idea -> [Idea]) -> Idea -> [Idea]
forall a b. (a -> b) -> a -> b
$
        Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Ignore String
msg (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
v)) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint GenLocated SrcSpanAnnA (HsExpr GhcPs)
o)
        (String -> Maybe String
forall a. a -> Maybe a
Just (a -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a
gen GenLocated SrcSpanAnnA (HsExpr GhcPs)
x))) [] [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> RType
forall a. Brackets a => a -> RType
findType GenLocated SrcSpanAnnA (HsExpr GhcPs)
v) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
v) [(String
"x", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
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 Int -> Int -> Bool
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 (Fixity -> Fixity -> (Bool, Bool))
-> Maybe Fixity -> Maybe (Fixity -> (Bool, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map String Fixity
fixities Map String Fixity -> String -> Maybe Fixity
forall k a. Ord k => Map k a -> k -> Maybe a
Data.Map.!? OccName -> String
occNameString OccName
lop) Maybe (Fixity -> (Bool, Bool))
-> Maybe Fixity -> Maybe (Bool, Bool)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Map String Fixity
fixities Map String Fixity -> String -> Maybe Fixity
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Bool -> Bool
not (HsExpr GhcPs -> Bool
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