module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TypeOperatorsChecker where
import PrelNames (eqTyConName)
import qualified Name as GHC (nameOccName)
import qualified OccName as GHC (isTcOcc, isSymOcc)
import Data.Generics.Uniplate.Data()
import Data.Generics.Uniplate.Operations
import Language.Haskell.Tools.Refactor
import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
chkTypeOperatorsType :: CheckNode Type
chkTypeOperatorsType = conditional chkTypeOperatorsType' TypeOperators
chkTypeOperatorsAssertion :: CheckNode Assertion
chkTypeOperatorsAssertion = conditional chkTypeOperatorsAssertion' TypeOperators
chkTypeOperatorsInstHead :: CheckNode InstanceHead
chkTypeOperatorsInstHead = conditional chkTypeOperatorsInstHead' TypeOperators
chkTypeOperatorsDecl :: CheckNode Decl
chkTypeOperatorsDecl = conditional chkTypeOperatorsDecl' TypeOperators
chkTypeOperatorsType' :: CheckNode Type
chkTypeOperatorsType' t@(InfixTypeApp _ op _)
| Just name <- semanticsName op
, name == eqTyConName
= return t
| otherwise = addEvidence TypeOperators t
chkTypeOperatorsType' t = return t
chkTypeOperatorsAssertion' :: CheckNode Assertion
chkTypeOperatorsAssertion' a@InfixAssert{} = addEvidence TypeOperators a
chkTypeOperatorsAssertion' a = return a
chkTypeOperatorsInstHead' :: CheckNode InstanceHead
chkTypeOperatorsInstHead' ih@InfixInstanceHead{} = addEvidence TypeOperators ih
chkTypeOperatorsInstHead' ih = return ih
chkTypeOperatorsDecl' :: CheckNode Decl
chkTypeOperatorsDecl' d = do
let dhs = universeBi d :: [DeclHead]
anyNeedsTO <- liftM or $ mapM isOperatorM dhs
if anyNeedsTO then addEvidence TypeOperators d
else return d
isOperatorM :: DeclHead -> ExtMonad Bool
isOperatorM dh = do
let mSemName = declHeadSemName dh
case mSemName of
Just semName
| occ <- GHC.nameOccName semName
, GHC.isTcOcc occ && GHC.isSymOcc occ
-> return True
| otherwise -> return False
Nothing -> return True