symantic-lib/Language/Symantic/Lib/Text.hs

   1 {-# LANGUAGE UndecidableInstances #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 -- | Symantic for 'Text'.
   4 module Language.Symantic.Lib.Text where
   5
   6 import Data.Proxy
   7 import Data.Text (Text)
   8 import qualified Data.Text as Text
   9 import Data.Type.Equality ((:~:)(Refl))
  10
  11 import Language.Symantic.Parsing
  12 import Language.Symantic.Typing
  13 import Language.Symantic.Compiling
  14 import Language.Symantic.Interpreting
  15 import Language.Symantic.Transforming
  16
  17 -- * Class 'Sym_Text'
  18 class Sym_Text term where
  19         text :: Text -> term Text
  20         default text :: Trans t term => Text -> t term Text
  21         text = trans_lift . text
  22
  23 type instance Sym_of_Iface (Proxy Text) = Sym_Text
  24 type instance TyConsts_of_Iface (Proxy Text) = Proxy Text ': TyConsts_imported_by Text
  25 type instance TyConsts_imported_by Text =
  26  [ Proxy Eq
  27  , Proxy Monoid
  28  , Proxy Ord
  29  , Proxy Show
  30  ]
  31
  32 instance Sym_Text HostI where
  33         text = HostI
  34 instance Sym_Text TextI where
  35         text a = TextI $ \_p _v ->
  36                 Text.pack (show a)
  37 instance (Sym_Text r1, Sym_Text r2) => Sym_Text (DupI r1 r2) where
  38         text x = text x `DupI` text x
  39
  40 instance
  41  ( Read_TyNameR TyName cs rs
  42  , Inj_TyConst cs Text
  43  ) => Read_TyNameR TyName cs (Proxy Text ': rs) where
  44         read_TyNameR _cs (TyName "Text") k = k (ty @Text)
  45         read_TyNameR _rs raw k = read_TyNameR (Proxy @rs) raw k
  46 instance Show_TyConst cs => Show_TyConst (Proxy Text ': cs) where
  47         show_TyConst TyConstZ{} = "Text"
  48         show_TyConst (TyConstS c) = show_TyConst c
  49
  50 instance -- Proj_TyConC
  51  ( Proj_TyConst cs Text
  52  , Proj_TyConsts cs (TyConsts_imported_by Text)
  53  ) => Proj_TyConC cs (Proxy Text) where
  54         proj_TyConC _ (TyConst q :$ TyConst c)
  55          | Just Refl <- eq_skind (kind_of_TyConst c) SKiType
  56          , Just Refl <- proj_TyConst c (Proxy @Text)
  57          = case () of
  58                  _ | Just Refl <- proj_TyConst q (Proxy @Eq)     -> Just TyCon
  59                    | Just Refl <- proj_TyConst q (Proxy @Monoid) -> Just TyCon
  60                    | Just Refl <- proj_TyConst q (Proxy @Ord)    -> Just TyCon
  61                    | Just Refl <- proj_TyConst q (Proxy @Show)   -> Just TyCon
  62                  _ -> Nothing
  63         proj_TyConC _c _q = Nothing
  64 data instance TokenT meta (ts::[*]) (Proxy Text)
  65  = Token_Term_Text Text
  66 deriving instance Eq_Token meta ts => Eq (TokenT meta ts (Proxy Text))
  67 deriving instance Show_Token meta ts => Show (TokenT meta ts (Proxy Text))
  68 instance -- CompileI
  69  Inj_TyConst cs Text =>
  70  CompileI cs is (Proxy Text) where
  71         compileI tok _ctx k =
  72                 case tok of
  73                  Token_Term_Text i -> k (ty @Text) $ TermO $ \_c -> text i
  74 instance -- TokenizeT
  75  -- Inj_Token meta ts Text =>
  76  TokenizeT meta ts (Proxy Text)
  77 instance Gram_Term_AtomsT meta ts (Proxy Text) g -- TODO