{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1999
-}

-- | This module is separate from "TcTypeable" because the functions in this
-- module are used in "ClsInst", and importing "TcTypeable" from "ClsInst"
-- would lead to an import cycle.
module TcTypeableValidity (tyConIsTypeable, typeIsTypeable) where

import GhcPrelude

import TyCoRep
import TyCon
import Type

import Data.Maybe (isJust)

-- | Is a particular 'TyCon' representable by @Typeable@?. These exclude type
-- families and polytypes.
tyConIsTypeable :: TyCon -> Bool
tyConIsTypeable :: TyCon -> Bool
tyConIsTypeable tc :: TyCon
tc =
       Maybe TyConRepName -> Bool
forall a. Maybe a -> Bool
isJust (TyCon -> Maybe TyConRepName
tyConRepName_maybe TyCon
tc)
    Bool -> Bool -> Bool
&& Type -> Bool
typeIsTypeable (Type -> Type
dropForAlls (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ TyCon -> Type
tyConKind TyCon
tc)

-- | Is a particular 'Type' representable by @Typeable@? Here we look for
-- polytypes and types containing casts (which may be, for instance, a type
-- family).
typeIsTypeable :: Type -> Bool
-- We handle types of the form (TYPE LiftedRep) specifically to avoid
-- looping on (tyConIsTypeable RuntimeRep). We used to consider (TYPE rr)
-- to be typeable without inspecting rr, but this exhibits bad behavior
-- when rr is a type family.
typeIsTypeable :: Type -> Bool
typeIsTypeable ty :: Type
ty
  | Just ty' :: Type
ty' <- Type -> Maybe Type
coreView Type
ty         = Type -> Bool
typeIsTypeable Type
ty'
typeIsTypeable ty :: Type
ty
  | Type -> Bool
isLiftedTypeKind Type
ty             = Bool
True
typeIsTypeable (TyVarTy _)          = Bool
True
typeIsTypeable (AppTy a :: Type
a b :: Type
b)          = Type -> Bool
typeIsTypeable Type
a Bool -> Bool -> Bool
&& Type -> Bool
typeIsTypeable Type
b
typeIsTypeable (FunTy a :: Type
a b :: Type
b)          = Type -> Bool
typeIsTypeable Type
a Bool -> Bool -> Bool
&& Type -> Bool
typeIsTypeable Type
b
typeIsTypeable (TyConApp tc :: TyCon
tc args :: [Type]
args)   = TyCon -> Bool
tyConIsTypeable TyCon
tc
                                   Bool -> Bool -> Bool
&& (Type -> Bool) -> [Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Type -> Bool
typeIsTypeable [Type]
args
typeIsTypeable (ForAllTy{})         = Bool
False
typeIsTypeable (LitTy _)            = Bool
True
typeIsTypeable (CastTy{})           = Bool
False
typeIsTypeable (CoercionTy{})       = Bool
False