{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Symantic for 'Char'. module Language.Symantic.Lib.Char where import Control.Monad (liftM) import Data.Proxy import Data.Type.Equality ((:~:)(Refl)) import qualified Data.Char as Char import qualified Data.Text as Text import Language.Symantic.Parsing hiding (char) import qualified Language.Symantic.Grammar as Gram import Language.Symantic.Typing import Language.Symantic.Compiling import Language.Symantic.Interpreting import Language.Symantic.Transforming import Language.Symantic.Lib.Lambda import Language.Symantic.Lib.MonoFunctor (TyFam_MonoElement(..)) -- * Class 'Sym_Char' class Sym_Char term where char :: Char -> term Char char_toUpper :: term Char -> term Char char_toLower :: term Char -> term Char default char :: Trans t term => Char -> t term Char default char_toUpper :: Trans t term => t term Char -> t term Char default char_toLower :: Trans t term => t term Char -> t term Char char = trans_lift . char char_toUpper = trans_map1 char_toUpper char_toLower = trans_map1 char_toLower type instance Sym_of_Iface (Proxy Char) = Sym_Char type instance TyConsts_of_Iface (Proxy Char) = Proxy Char ': TyConsts_imported_by (Proxy Char) type instance TyConsts_imported_by (Proxy Char) = [ Proxy Bounded , Proxy Enum , Proxy Eq , Proxy Ord , Proxy Show ] instance Sym_Char HostI where char = HostI char_toUpper = liftM Char.toUpper char_toLower = liftM Char.toLower instance Sym_Char TextI where char a = TextI $ \_p _v -> Text.pack (show a) char_toUpper = textI1 "Char.toUpper" char_toLower = textI1 "Char.toLower" instance (Sym_Char r1, Sym_Char r2) => Sym_Char (DupI r1 r2) where char x = char x `DupI` char x char_toUpper = dupI1 @Sym_Char char_toUpper char_toLower = dupI1 @Sym_Char char_toLower instance ( Read_TyNameR TyName cs rs , Inj_TyConst cs Char ) => Read_TyNameR TyName cs (Proxy Char ': rs) where read_TyNameR _cs (TyName "Char") k = k (ty @Char) read_TyNameR _rs raw k = read_TyNameR (Proxy @rs) raw k instance Show_TyConst cs => Show_TyConst (Proxy Char ': cs) where show_TyConst TyConstZ{} = "Char" show_TyConst (TyConstS c) = show_TyConst c instance Proj_TyFamC cs TyFam_MonoElement Char instance -- Proj_TyConC ( Proj_TyConst cs Char , Proj_TyConsts cs (TyConsts_imported_by (Proxy Char)) ) => Proj_TyConC cs (Proxy Char) where proj_TyConC _ (TyConst q :$ TyConst c) | Just Refl <- eq_skind (kind_of_TyConst c) SKiType , Just Refl <- proj_TyConst c (Proxy @Char) = case () of _ | Just Refl <- proj_TyConst q (Proxy @Bounded) -> Just TyCon | Just Refl <- proj_TyConst q (Proxy @Enum) -> Just TyCon | Just Refl <- proj_TyConst q (Proxy @Eq) -> Just TyCon | Just Refl <- proj_TyConst q (Proxy @Ord) -> Just TyCon | Just Refl <- proj_TyConst q (Proxy @Show) -> Just TyCon _ -> Nothing proj_TyConC _c _q = Nothing data instance TokenT meta (ts::[*]) (Proxy Char) = Token_Term_Char Char | Token_Term_Char_toUpper | Token_Term_Char_toLower deriving instance Eq_Token meta ts => Eq (TokenT meta ts (Proxy Char)) deriving instance Show_Token meta ts => Show (TokenT meta ts (Proxy Char)) instance -- CompileI ( Inj_TyConst cs Char , Inj_TyConst cs (->) ) => CompileI cs is (Proxy Char) where compileI tok _ctx k = case tok of Token_Term_Char c -> k (ty @Char) $ TermO $ \_c -> char c Token_Term_Char_toUpper -> from_op char_toUpper Token_Term_Char_toLower -> from_op char_toLower where from_op (op::forall term. Sym_Char term => term Char -> term Char) = k (ty @Char ~> ty @Char) $ TermO $ \_c -> lam op instance -- TokenizeT Inj_Token meta ts Char => TokenizeT meta ts (Proxy Char) where tokenizeT _t = mempty { tokenizers_infix = tokenizeTMod [Mod_Name "Char"] [ tokenize0 "toLower" infixN5 Token_Term_Char_toLower , tokenize0 "toUpper" infixN5 Token_Term_Char_toUpper ] } instance -- Gram_Term_AtomsT ( Alt g , Gram_Rule g , Gram_Lexer g , Gram_Meta meta g , Inj_Token meta ts Char ) => Gram_Term_AtomsT meta ts (Proxy Char) g where gs_term_atomsT _t = [ rule "term_char" $ lexeme $ metaG $ (\c meta -> ProTok $ inj_EToken meta $ Token_Term_Char c) <$> Gram.between tickG tickG ( Gram.cf_of_Terminal (Gram.any `Gram.but` tickG) Gram.<+> '\'' <$ Gram.string "\\'" ) ] where tickG :: Gram_Terminal g' => g' Char tickG = Gram.char '\''