{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
module Data.Typeable
(
Typeable
, typeOf
, typeRep
, (:~:)(Refl)
, (:~~:)(HRefl)
, cast
, eqT
, gcast
, gcast1
, gcast2
, Proxy (..)
, TypeRep
, rnfTypeRep
, showsTypeRep
, mkFunTy
, funResultTy
, splitTyConApp
, typeRepArgs
, typeRepTyCon
, typeRepFingerprint
, I.TyCon
, I.tyConPackage
, I.tyConModule
, I.tyConName
, I.rnfTyCon
, I.tyConFingerprint
, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7
, I.trLiftedRep
) where
import qualified Data.Typeable.Internal as I
import Data.Typeable.Internal (Typeable)
import Data.Type.Equality
import Data.Maybe
import Data.Proxy
import GHC.Fingerprint.Type
import GHC.Show
import GHC.Base
type TypeRep = I.SomeTypeRep
typeOf :: forall a. Typeable a => a -> TypeRep
typeOf :: forall a. Typeable a => a -> TypeRep
typeOf a
_ = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
I.someTypeRep (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
typeRep :: forall proxy a. Typeable a => proxy a -> TypeRep
typeRep :: forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep = proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
I.someTypeRep
showsTypeRep :: TypeRep -> ShowS
showsTypeRep :: TypeRep -> ShowS
showsTypeRep = TypeRep -> ShowS
forall a. Show a => a -> ShowS
shows
cast :: forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast :: forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x
| Just a :~~: b
HRefl <- TypeRep a
ta TypeRep a -> TypeRep b -> Maybe (a :~~: b)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`I.eqTypeRep` TypeRep b
tb = b -> Maybe b
forall a. a -> Maybe a
Just a
b
x
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
where
ta :: TypeRep a
ta = TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
I.typeRep :: I.TypeRep a
tb :: TypeRep b
tb = TypeRep b
forall {k} (a :: k). Typeable a => TypeRep a
I.typeRep :: I.TypeRep b
eqT :: forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT :: forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT
| Just a :~~: b
HRefl <- TypeRep a
ta TypeRep a -> TypeRep b -> Maybe (a :~~: b)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`I.eqTypeRep` TypeRep b
tb = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: b
forall {k} (a :: k). a :~: a
Refl
| Bool
otherwise = Maybe (a :~: b)
forall a. Maybe a
Nothing
where
ta :: TypeRep a
ta = TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
I.typeRep :: I.TypeRep a
tb :: TypeRep b
tb = TypeRep b
forall {k} (a :: k). Typeable a => TypeRep a
I.typeRep :: I.TypeRep b
gcast :: forall a b c. (Typeable a, Typeable b) => c a -> Maybe (c b)
gcast :: forall {k} (a :: k) (b :: k) (c :: k -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
gcast c a
x = ((a :~: b) -> c b) -> Maybe (a :~: b) -> Maybe (c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a :~: b
Refl -> c a
c b
x) (Maybe (a :~: b)
forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (a :~: b))
gcast1 :: forall c t t' a. (Typeable t, Typeable t')
=> c (t a) -> Maybe (c (t' a))
gcast1 :: forall {k} {k} (c :: k -> *) (t :: k -> k) (t' :: k -> k) (a :: k).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
x = ((t :~: t') -> c (t' a)) -> Maybe (t :~: t') -> Maybe (c (t' a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t :~: t'
Refl -> c (t a)
c (t' a)
x) (Maybe (t :~: t')
forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (t :~: t'))
gcast2 :: forall c t t' a b. (Typeable t, Typeable t')
=> c (t a b) -> Maybe (c (t' a b))
gcast2 :: forall {k} {k} {k} (c :: k -> *) (t :: k -> k -> k)
(t' :: k -> k -> k) (a :: k) (b :: k).
(Typeable t, Typeable t') =>
c (t a b) -> Maybe (c (t' a b))
gcast2 c (t a b)
x = ((t :~: t') -> c (t' a b))
-> Maybe (t :~: t') -> Maybe (c (t' a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t :~: t'
Refl -> c (t a b)
c (t' a b)
x) (Maybe (t :~: t')
forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (t :~: t'))
funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep
funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep
funResultTy (I.SomeTypeRep TypeRep a
f) (I.SomeTypeRep TypeRep a
x)
| Just * :~~: k
HRefl <- (TypeRep (*)
forall {k} (a :: k). Typeable a => TypeRep a
I.typeRep :: I.TypeRep Type) TypeRep (*) -> TypeRep k -> Maybe (* :~~: k)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`I.eqTypeRep` TypeRep a -> TypeRep k
forall k (a :: k). TypeRep a -> TypeRep k
I.typeRepKind TypeRep a
f
, I.Fun TypeRep arg
arg TypeRep res
res <- TypeRep a
f
, Just arg :~~: a
HRefl <- TypeRep arg
arg TypeRep arg -> TypeRep a -> Maybe (arg :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`I.eqTypeRep` TypeRep a
x
= TypeRep -> Maybe TypeRep
forall a. a -> Maybe a
Just (TypeRep res -> TypeRep
forall k (a :: k). TypeRep a -> TypeRep
I.SomeTypeRep TypeRep res
res)
| Bool
otherwise = Maybe TypeRep
forall a. Maybe a
Nothing
mkFunTy :: TypeRep -> TypeRep -> TypeRep
mkFunTy :: TypeRep -> TypeRep -> TypeRep
mkFunTy (I.SomeTypeRep TypeRep a
arg) (I.SomeTypeRep TypeRep a
res)
| Just k :~~: *
HRefl <- TypeRep a -> TypeRep k
forall k (a :: k). TypeRep a -> TypeRep k
I.typeRepKind TypeRep a
arg TypeRep k -> TypeRep (*) -> Maybe (k :~~: *)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`I.eqTypeRep` TypeRep (*)
liftedTy
, Just k :~~: *
HRefl <- TypeRep a -> TypeRep k
forall k (a :: k). TypeRep a -> TypeRep k
I.typeRepKind TypeRep a
res TypeRep k -> TypeRep (*) -> Maybe (k :~~: *)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`I.eqTypeRep` TypeRep (*)
liftedTy
= TypeRep (a -> a) -> TypeRep
forall k (a :: k). TypeRep a -> TypeRep
I.SomeTypeRep (TypeRep a -> TypeRep a -> TypeRep (a -> a)
forall k (fun :: k) arg res.
(k ~ *, fun ~~ (arg -> res)) =>
TypeRep arg -> TypeRep res -> TypeRep fun
I.Fun TypeRep a
TypeRep a
arg TypeRep a
TypeRep a
res)
| Bool
otherwise
= [Char] -> TypeRep
forall a. HasCallStack => [Char] -> a
error ([Char] -> TypeRep) -> [Char] -> TypeRep
forall a b. (a -> b) -> a -> b
$ [Char]
"mkFunTy: Attempted to construct function type from non-lifted "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char]
"type: arg="[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++TypeRep a -> [Char]
forall a. Show a => a -> [Char]
show TypeRep a
arg[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
", res="[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++TypeRep a -> [Char]
forall a. Show a => a -> [Char]
show TypeRep a
res
where liftedTy :: TypeRep (*)
liftedTy = TypeRep (*)
forall {k} (a :: k). Typeable a => TypeRep a
I.typeRep :: I.TypeRep Type
splitTyConApp :: TypeRep -> (TyCon, [TypeRep])
splitTyConApp :: TypeRep -> (TyCon, [TypeRep])
splitTyConApp (I.SomeTypeRep TypeRep a
x) = TypeRep a -> (TyCon, [TypeRep])
forall {k} (a :: k). TypeRep a -> (TyCon, [TypeRep])
I.splitApps TypeRep a
x
typeRepArgs :: TypeRep -> [TypeRep]
typeRepArgs :: TypeRep -> [TypeRep]
typeRepArgs TypeRep
ty = case TypeRep -> (TyCon, [TypeRep])
splitTyConApp TypeRep
ty of (TyCon
_, [TypeRep]
args) -> [TypeRep]
args
typeRepTyCon :: TypeRep -> TyCon
typeRepTyCon :: TypeRep -> TyCon
typeRepTyCon = TypeRep -> TyCon
I.someTypeRepTyCon
typeRepFingerprint :: TypeRep -> Fingerprint
typeRepFingerprint :: TypeRep -> Fingerprint
typeRepFingerprint = TypeRep -> Fingerprint
I.someTypeRepFingerprint
rnfTypeRep :: TypeRep -> ()
rnfTypeRep :: TypeRep -> ()
rnfTypeRep = TypeRep -> ()
I.rnfSomeTypeRep
typeOf1 :: forall t (a :: Type). Typeable t => t a -> TypeRep
typeOf1 :: forall (t :: * -> *) a. Typeable t => t a -> TypeRep
typeOf1 t a
_ = Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
I.someTypeRep (Proxy t
forall {k} (t :: k). Proxy t
Proxy :: Proxy t)
typeOf2 :: forall t (a :: Type) (b :: Type). Typeable t => t a b -> TypeRep
typeOf2 :: forall (t :: * -> * -> *) a b. Typeable t => t a b -> TypeRep
typeOf2 t a b
_ = Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
I.someTypeRep (Proxy t
forall {k} (t :: k). Proxy t
Proxy :: Proxy t)
typeOf3 :: forall t (a :: Type) (b :: Type) (c :: Type).
Typeable t => t a b c -> TypeRep
typeOf3 :: forall (t :: * -> * -> * -> *) a b c.
Typeable t =>
t a b c -> TypeRep
typeOf3 t a b c
_ = Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
I.someTypeRep (Proxy t
forall {k} (t :: k). Proxy t
Proxy :: Proxy t)
typeOf4 :: forall t (a :: Type) (b :: Type) (c :: Type) (d :: Type).
Typeable t => t a b c d -> TypeRep
typeOf4 :: forall (t :: * -> * -> * -> * -> *) a b c d.
Typeable t =>
t a b c d -> TypeRep
typeOf4 t a b c d
_ = Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
I.someTypeRep (Proxy t
forall {k} (t :: k). Proxy t
Proxy :: Proxy t)
typeOf5 :: forall t (a :: Type) (b :: Type) (c :: Type) (d :: Type) (e :: Type).
Typeable t => t a b c d e -> TypeRep
typeOf5 :: forall (t :: * -> * -> * -> * -> * -> *) a b c d e.
Typeable t =>
t a b c d e -> TypeRep
typeOf5 t a b c d e
_ = Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
I.someTypeRep (Proxy t
forall {k} (t :: k). Proxy t
Proxy :: Proxy t)
typeOf6 :: forall t (a :: Type) (b :: Type) (c :: Type)
(d :: Type) (e :: Type) (f :: Type).
Typeable t => t a b c d e f -> TypeRep
typeOf6 :: forall (t :: * -> * -> * -> * -> * -> * -> *) a b c d e f.
Typeable t =>
t a b c d e f -> TypeRep
typeOf6 t a b c d e f
_ = Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
I.someTypeRep (Proxy t
forall {k} (t :: k). Proxy t
Proxy :: Proxy t)
typeOf7 :: forall t (a :: Type) (b :: Type) (c :: Type)
(d :: Type) (e :: Type) (f :: Type) (g :: Type).
Typeable t => t a b c d e f g -> TypeRep
typeOf7 :: forall (t :: * -> * -> * -> * -> * -> * -> * -> *) a b c d e f g.
Typeable t =>
t a b c d e f g -> TypeRep
typeOf7 t a b c d e f g
_ = Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
I.someTypeRep (Proxy t
forall {k} (t :: k). Proxy t
Proxy :: Proxy t)