{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TypeSynonymInstancesChecker
( chkTypeSynonymInstancesDecl, chkInstancesDeclWith, chkInstanceRuleWith, collectTyArgs) where
import Language.Haskell.Tools.Refactor
import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad hiding (StandaloneDeriving)
{-# ANN module "HLint: ignore Redundant bracket" #-}
chkTypeSynonymInstancesDecl :: CheckNode Decl
chkTypeSynonymInstancesDecl = conditional (chkInstancesDeclWith $ chkInstanceRuleWith chkInstanceHead) TypeSynonymInstances
chkInstancesDeclWith :: CheckNode InstanceRule -> CheckNode Decl
chkInstancesDeclWith chkRule d@(StandaloneDeriving _ _ rule) = chkRule rule >> return d
chkInstancesDeclWith chkRule d@(InstanceDecl rule _) = chkRule rule >> return d
chkInstancesDeclWith _ d = return d
chkInstanceRuleWith :: CheckNode InstanceHead -> CheckNode InstanceRule
chkInstanceRuleWith chkHead r@(InstanceRule _ _ ihead) = chkHead ihead >> return r
chkInstanceRuleWith _ r = return r
chkInstanceHead :: CheckNode InstanceHead
chkInstanceHead ih = do
let types = collectTyArgs ih
mapM_ chkTypeArg types >> return ih
chkTypeArg :: Type -> ExtMonad Type
chkTypeArg ty =
maybeTM (return ty) (const . addEvidence TypeSynonymInstances $ ty) (semanticsTypeSynRhs ty)
collectTyArgs :: InstanceHead -> [Type]
collectTyArgs (InstanceHead _) = []
collectTyArgs (InfixInstanceHead t _) = [t]
collectTyArgs (ParenInstanceHead ih) = collectTyArgs ih
collectTyArgs (AppInstanceHead ih t) = t : collectTyArgs ih