module Hint.Fixities(fixitiesHint) where
import Hint.Type(DeclHint,Idea(..),rawIdea,toSS)
import Config.Type
import Control.Monad
import Data.List.Extra
import Data.Map
import Data.Generics.Uniplate.DataOnly
import Refact.Types
import GHC.Types.Basic (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 =
(LHsExpr GhcPs -> [Idea]) -> [LHsExpr 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) (LHsDecl GhcPs -> [LHsExpr GhcPs]
forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
x :: [LHsExpr GhcPs])
where
fixities :: Map String Fixity
fixities = (Setting -> Map String Fixity) -> [Setting] -> Map String Fixity
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, LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs -> [Idea]
f Maybe (Int, LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)
forall a. Maybe a
Nothing
where
msg :: String
msg = String
"Redundant bracket due to operator fixities"
f :: Maybe (Int, LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs -> [Idea]
f Maybe (Int, LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)
p LHsExpr GhcPs
o = Maybe (Int, LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs -> [Idea]
forall a.
Outputable a =>
Maybe (Int, LHsExpr GhcPs, LHsExpr GhcPs -> a)
-> LHsExpr GhcPs -> [Idea]
cur Maybe (Int, LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)
p LHsExpr 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, LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs -> [Idea]
f ((Int, LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)
-> Maybe (Int, LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)
forall a. a -> Maybe a
Just (Int
i, LHsExpr GhcPs
o, LHsExpr GhcPs -> LHsExpr GhcPs
gen)) LHsExpr GhcPs
x | (Int
i, (LHsExpr GhcPs
x, LHsExpr GhcPs -> LHsExpr GhcPs
gen)) <- Int
-> [(LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)]
-> [(Int, (LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs))]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 ([(LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)]
-> [(Int, (LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs))])
-> [(LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)]
-> [(Int, (LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs))]
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> [(LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)]
forall on. Uniplate on => on -> [(on, on -> on)]
holes LHsExpr GhcPs
o]
cur :: Maybe (Int, LHsExpr GhcPs, LHsExpr GhcPs -> a)
-> LHsExpr GhcPs -> [Idea]
cur Maybe (Int, LHsExpr GhcPs, LHsExpr GhcPs -> a)
p LHsExpr GhcPs
v = do
Just (Int
i, LHsExpr GhcPs
o, LHsExpr GhcPs -> a
gen) <- [Maybe (Int, LHsExpr GhcPs, LHsExpr GhcPs -> a)
p]
Just LHsExpr GhcPs
x <- [LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
forall a. Brackets a => a -> Maybe a
remParen LHsExpr 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
o LHsExpr GhcPs
x
Idea -> [Idea]
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 (LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
v) (LHsExpr GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint LHsExpr GhcPs
o)
(String -> Maybe String
forall a. a -> Maybe a
Just (a -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (LHsExpr GhcPs -> a
gen LHsExpr GhcPs
x))) [] [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace (LHsExpr GhcPs -> RType
forall a. Brackets a => a -> RType
findType LHsExpr GhcPs
v) (LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr GhcPs
v) [(String
"x", LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr 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 SrcSpan
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ (L SrcSpan
_ (HsVar XVar GhcPs
_ (L SrcSpan
_ (Unqual p)))) LHsExpr GhcPs
_) <- LHsExpr GhcPs
parent
, L SrcSpan
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ (L SrcSpan
_ (HsVar XVar GhcPs
_ (L SrcSpan
_ (Unqual c)))) (L SrcSpan
_ 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
!? OccName -> String
occNameString OccName
lop) Maybe (Fixity -> (Bool, Bool))
-> Maybe Fixity -> Maybe (Bool, Bool)
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
!? 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 :: 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