{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-- | Expression for 'Char'.
module Language.Symantic.Expr.Char where

import Control.Monad
import qualified Data.Char as Char
import qualified Data.Text as Text

import Language.Symantic.Type
import Language.Symantic.Repr
import Language.Symantic.Expr.Root
import Language.Symantic.Expr.Error
import Language.Symantic.Expr.From
import Language.Symantic.Trans.Common

-- * Class 'Sym_Char'
-- | Symantic.
class Sym_Char repr where
	char :: Char -> repr Char
	char_toUpper :: repr Char -> repr Char
	
	default char :: Trans t repr => Char -> t repr Char
	default char_toUpper :: Trans t repr => t repr Char -> t repr Char
	
	char         = trans_lift . char
	char_toUpper = trans_map1 char_toUpper
instance Sym_Char Repr_Host where
	char         = Repr_Host
	char_toUpper = liftM Char.toUpper
instance Sym_Char Repr_Text where
	char a = Repr_Text $ \_p _v ->
		Text.pack (show a)
	char_toUpper = repr_text_app1 "char_toUpper"
instance
 ( Sym_Char r1
 , Sym_Char r2
 ) => Sym_Char (Repr_Dup r1 r2) where
	char x = char x `Repr_Dup` char x
	char_toUpper (c1 `Repr_Dup` c2) =
		char_toUpper c1 `Repr_Dup` char_toUpper c2

-- * Type 'Expr_Char'
-- | Expression.
data Expr_Char (root:: *)
type instance Root_of_Expr      (Expr_Char root)      = root
type instance Type_of_Expr      (Expr_Char root)      = Type_Char
type instance Sym_of_Expr       (Expr_Char root) repr = Sym_Char repr
type instance Error_of_Expr ast (Expr_Char root)      = No_Error_Expr