{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE TypeFamilies #-}

-- Contains functions to help making Typeable instances from Typed instances.
--
-- Warning: The TypeRep of parameters comes from the Typed instances even if they might have a Typeable instance.
-- This propably won't be a problem when they are just being used for casting, but it is an ugly hack.
module Data.Type.Typeable
	( toTypeable
	, toTypeable1
	, toTypeable2
	, toTypeable3
	, toTypeable4
	, toTypeable5
	, toTypeable6
	, toTypeable7
	) where

import Data.Type.Framework
import Data.Type.Generated
import Data.Typeable

migrateTypeRep :: Typed t => t -> TypeRep
migrateTypeRep = mapTypeID (\p s -> mkTyConApp (mkTyCon (s++'@':p)) []) mkAppTy . typeID

toTypeable  :: forall t. Typed (Type t) => t -> TypeRep
toTypeable _ = migrateTypeRep (type_ :: Type t)

toTypeable1 :: forall t a. Typed (TypeX t) => t a -> TypeRep
toTypeable1 _ = migrateTypeRep (type_ :: TypeX t)

toTypeable2 :: forall t a b. Typed (TypeXX t) => t a b -> TypeRep
toTypeable2 _ = migrateTypeRep (type_ :: TypeXX t)

toTypeable3 :: forall t a b c. Typed (TypeXXX t) => t a b c -> TypeRep
toTypeable3 _ = migrateTypeRep (type_ :: TypeXXX t)

toTypeable4 :: forall t a b c d. Typed (TypeXXXX t) => t a b c d -> TypeRep
toTypeable4 _ = migrateTypeRep (type_ :: TypeXXXX t)

toTypeable5 :: forall t a b c d e. Typed (TypeXXXXX t) => t a b c d e -> TypeRep
toTypeable5 _ = migrateTypeRep (type_ :: TypeXXXXX t)

toTypeable6 :: forall t a b c d e f. Typed (TypeXXXXXX t) => t a b c d e f -> TypeRep
toTypeable6 _ = migrateTypeRep (type_ :: TypeXXXXXX t)

toTypeable7 :: forall t a b c d e f g. Typed (TypeXXXXXXX t) => t a b c d e f g -> TypeRep
toTypeable7 _ = migrateTypeRep (type_ :: TypeXXXXXXX t)