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

module Data.Type.Framework
	( TypeID()
	, TypeClass(..)
	, Typed(..)
	, makeTypeID
	, applyTypeID
	, mapTypeID
	) where

import Data.Type.Kind
import Unsafe.Coerce (unsafeCoerce)

-- | An unique identifier for types.
-- The order given is arbitrary but stable.
data TypeID
	= TypeID String String
	| TypeApp TypeID TypeID
	deriving (Eq,Ord)

-- | Used internally when defining instances of 'Typed'.
makeTypeID
	:: String -- ^ Module name of which the type constructor is part of.
	-> String -- ^ Fully qualified type constructor name.
	-> TypeID -- ^ The TypeID of the given type constructor.
{-# INLINE makeTypeID #-}
makeTypeID = TypeID

-- | Used internally when defining instances of 'Typed'.
applyTypeID
	:: TypeID -- ^ The incomplete TypeID to which the type parameter is being applied to.
	-> TypeID -- ^ The TypeID that is given as a parameter.
	-> TypeID -- ^ Resulting type id.
{-# INLINE applyTypeID #-}
applyTypeID = TypeApp

-- | Used mainly internally, but may be useful for defining custom 'show' like functions for 'TypeID's.
--
-- Extracts the raw data that was used to construct 'TypeID's.
mapTypeID
	:: (String -> String -> r) -- ^ Extract the data given to 'makeTypeID'
	-> (r -> r -> r)           -- ^ Extract the data given to 'applyTypeID'
	-> TypeID                  -- ^ The TypeID from which the data needs to be extracted.
	-> r                       -- ^ The extract.
mapTypeID conf appf (TypeApp c p) = appf (mapTypeID conf appf c) (mapTypeID conf appf p)
mapTypeID conf appf (TypeID mod name)  = conf mod name

instance Show TypeID where
	show (TypeID mod name) = name ++ '@' : mod
	show (TypeApp f p@(TypeApp _ _)) = show f ++ " (" ++ show p ++ ")"
	show (TypeApp f p) = show f ++ ' ' : show p

-- | Class for all the 'Type', 'TypeX', ... types.
class TypeClass t where
	type_          :: t
	kindOf         :: t -> Kind

-- | This is the replacement class for 'Data.Typeable.Typeable'.
-- use 'Data.Type.deriveTyped' to derive instances of this class.
class TypeClass t => Typed t where
	typeID :: t -> TypeID