{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Type variable.
module Language.LOL.Symantic.Type.Var
 ( module Language.LOL.Symantic.Type.Var
 , module Language.LOL.Symantic.Lib.Data.Peano
 ) where

import Data.Maybe (isJust)

import Language.LOL.Symantic.AST
import Language.LOL.Symantic.Type.Common
import Language.LOL.Symantic.Lib.Data.Peano

-- * Type 'Type_Var'
-- | The variable type.
data Type_Var (root:: * -> *) p where
	Type_Var :: SPeano p -> Type_Var root p
type instance Root_of_Type      (Type_Var root) = root
type instance Error_of_Type ast (Type_Var root) = ()

instance -- Type_Eq
 Type_Eq (Type_Var root) where
	type_eq (Type_Var x) (Type_Var y) = x `peano_eq` y
instance -- Eq
 Eq (Type_Var root h) where
	x == y = isJust $ x `type_eq` y
instance -- String_from_Type
 String_from_Type (Type_Var root) where
	string_from_type (Type_Var p) =
		"t" ++ show (integral_from_peano p::Integer)
instance -- Show
 Show (Type_Var root h) where
	show = string_from_type
instance -- Type_from AST
 ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , Implicit_HBool (Is_Last_Type (Type_Var root) root)
 ) => Type_from AST (Type_Var root) where
	type_from px_ty ast _k =
		Left $ error_type_unsupported px_ty ast
	 -- NOTE: no support so far.

-- | Convenient alias to include a 'Type_Var' within a type.
type_var :: Type_Root_Lift Type_Var root => SPeano p -> root p
type_var = type_root_lift . Type_Var