{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Symantic for 'Enum'.
module Language.Symantic.Lib.Enum where

import Control.Monad (liftM)
import qualified Data.Function as Fun
import Data.Proxy
import Data.Type.Equality ((:~:)(Refl))
import qualified Prelude
import Prelude hiding (Enum(..))
import Prelude (Enum)

import Language.Symantic.Parsing
import Language.Symantic.Typing
import Language.Symantic.Compiling
import Language.Symantic.Interpreting
import Language.Symantic.Transforming
import Language.Symantic.Lib.Lambda

-- * Class 'Sym_Enum'
class Sym_Enum term where
	toEnum   :: Enum a => term Int -> term a
	fromEnum :: Enum a => term a -> term Int
	succ     :: Enum a => term a -> term a
	pred     :: Enum a => term a -> term a
	
	default succ     :: (Trans t term, Enum a) => t term a -> t term a
	default pred     :: (Trans t term, Enum a) => t term a -> t term a
	default toEnum   :: (Trans t term, Enum a) => t term Int -> t term a
	default fromEnum :: (Trans t term, Enum a) => t term a -> t term Int
	
	toEnum   = trans_map1 toEnum
	fromEnum = trans_map1 fromEnum
	succ     = trans_map1 succ
	pred     = trans_map1 pred

type instance Sym_of_Iface (Proxy Enum) = Sym_Enum
type instance TyConsts_of_Iface (Proxy Enum) = Proxy Enum ': TyConsts_imported_by Enum
type instance TyConsts_imported_by Enum =
 '[ Proxy Int
 ]

instance Sym_Enum HostI where
	toEnum   = liftM Prelude.toEnum
	fromEnum = liftM Prelude.fromEnum
	succ     = liftM Prelude.succ
	pred     = liftM Prelude.pred
instance Sym_Enum TextI where
	toEnum   = textI1 "toEnum"
	fromEnum = textI1 "fromEnum"
	succ     = textI1 "succ"
	pred     = textI1 "pred"
instance (Sym_Enum r1, Sym_Enum r2) => Sym_Enum (DupI r1 r2) where
	toEnum   = dupI1 @Sym_Enum toEnum
	fromEnum = dupI1 @Sym_Enum fromEnum
	succ     = dupI1 @Sym_Enum succ
	pred     = dupI1 @Sym_Enum pred

instance
 ( Read_TyNameR TyName cs rs
 , Inj_TyConst cs Enum
 ) => Read_TyNameR TyName cs (Proxy Enum ': rs) where
	read_TyNameR _cs (TyName "Enum") k = k (ty @Enum)
	read_TyNameR _rs raw k = read_TyNameR (Proxy @rs) raw k
instance Show_TyConst cs => Show_TyConst (Proxy Enum ': cs) where
	show_TyConst TyConstZ{} = "Enum"
	show_TyConst (TyConstS c) = show_TyConst c

instance Proj_TyConC cs (Proxy Enum)
data instance TokenT meta (ts::[*]) (Proxy Enum)
 = Token_Term_Enum_fromEnum (EToken meta ts)
 | Token_Term_Enum_toEnum   (EToken meta '[Proxy Token_Type])
 | Token_Term_Enum_succ     (EToken meta ts)
 | Token_Term_Enum_pred     (EToken meta ts)
deriving instance (Eq meta, Eq_Token meta ts) => Eq (TokenT meta ts (Proxy Enum))
deriving instance (Show meta, Show_Token meta ts) => Show (TokenT meta ts (Proxy Enum))
instance -- CompileI
 ( Read_TyName TyName cs
 , Inj_TyConst        cs Enum
 , Inj_TyConst        cs (->)
 , Inj_TyConst        cs Int
 , Proj_TyCon         cs
 , Compile cs is
 ) => CompileI cs is (Proxy Enum) where
	compileI tok ctx k =
		case tok of
		 Token_Term_Enum_toEnum tok_ty_a ->
			-- toEnum :: Enum a => Int -> a
			compile_Type tok_ty_a $ \(ty_a::Type cs a) ->
			check_Kind
			 (At Nothing SKiType)
			 (At (Just tok_ty_a) $ kind_of ty_a) $ \Refl ->
			check_TyCon (At (Just tok_ty_a) (ty @Enum :$ ty_a)) $ \TyCon ->
			k (ty @Int ~> ty_a) $ TermO $
				Fun.const $ lam toEnum
		 Token_Term_Enum_fromEnum tok_a ->
			-- fromEnum :: Enum a => a -> Int
			compileO tok_a ctx $ \ty_a (TermO a) ->
			check_TyCon (At (Just tok_a) (ty @Enum :$ ty_a)) $ \TyCon ->
			k (ty @Int) $ TermO $
				\c -> fromEnum (a c)
		 Token_Term_Enum_succ tok_a -> op1_from tok_a succ
		 Token_Term_Enum_pred tok_a -> op1_from tok_a pred
		where
		op1_from tok_a
		 (op::forall term a. (Sym_Enum term, Enum a)
			 => term a -> term a) =
		 -- succ :: Enum a => a -> a
		 -- pred :: Enum a => a -> a
			compileO tok_a ctx $ \ty_a (TermO x) ->
			check_TyCon (At (Just tok_a) (ty @Enum :$ ty_a)) $ \TyCon ->
			k ty_a $ TermO $
			 \c -> op (x c)
instance -- TokenizeT
 Inj_Token meta ts Enum =>
 TokenizeT meta ts (Proxy Enum) where
	tokenizeT _t = mempty
	 { tokenizers_infix = tokenizeTMod []
		 [ tokenize1 "succ" infixN5 Token_Term_Enum_succ
		 , tokenize1 "pred" infixN5 Token_Term_Enum_pred
		 , (TeName "toEnum",) ProTok_Term
			 { protok_term = \meta -> ProTokPi $ \a ->
				ProTok $ inj_EToken meta $ Token_Term_Enum_toEnum a
			 , protok_fixity = infixN5
			 }
		 , tokenize1 "fromEnum" infixN5 Token_Term_Enum_fromEnum
		 ]
	 }
instance Gram_Term_AtomsT meta ts (Proxy Enum) g