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

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