Language/Symantic/Compiling/Text.hs

   1 {-# LANGUAGE UndecidableInstances #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 -- | Symantic for 'Text'.
   4 module Language.Symantic.Compiling.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.Term
  14 import Language.Symantic.Interpreting
  15 import Language.Symantic.Transforming.Trans
  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 Consts_of_Iface (Proxy Text) = Proxy Text ': Consts_imported_by Text
  25 type instance Consts_imported_by Text =
  26  [ Proxy Eq
  27  , Proxy Monoid
  28  , Proxy Ord
  29  ]
  30
  31 instance Sym_Text HostI where
  32         text = HostI
  33 instance Sym_Text TextI where
  34         text a = TextI $ \_p _v ->
  35                 Text.pack (show a)
  36 instance (Sym_Text r1, Sym_Text r2) => Sym_Text (DupI r1 r2) where
  37         text x = text x `DupI` text x
  38
  39 instance Const_from Text cs => Const_from Text (Proxy Text ': cs) where
  40         const_from "Text" k = k (ConstZ kind)
  41         const_from s k = const_from s $ k . ConstS
  42 instance Show_Const cs => Show_Const (Proxy Text ': cs) where
  43         show_const ConstZ{} = "Text"
  44         show_const (ConstS c) = show_const c
  45
  46 instance -- Proj_ConC
  47  ( Proj_Const cs Text
  48  , Proj_Consts cs (Consts_imported_by Text)
  49  ) => Proj_ConC cs (Proxy Text) where
  50         proj_conC _ (TyConst q :$ TyConst c)
  51          | Just Refl <- eq_skind (kind_of_const c) SKiType
  52          , Just Refl <- proj_const c (Proxy::Proxy Text)
  53          = case () of
  54                  _ | Just Refl <- proj_const q (Proxy::Proxy Eq)     -> Just Con
  55                    | Just Refl <- proj_const q (Proxy::Proxy Monoid) -> Just Con
  56                    | Just Refl <- proj_const q (Proxy::Proxy Ord)    -> Just Con
  57                  _ -> Nothing
  58         proj_conC _c _q = Nothing
  59 data instance TokenT meta (ts::[*]) (Proxy Text)
  60  = Token_Term_Text Text
  61 deriving instance Eq_Token meta ts => Eq (TokenT meta ts (Proxy Text))
  62 deriving instance Show_Token meta ts => Show (TokenT meta ts (Proxy Text))
  63 instance -- Term_fromI
  64  Inj_Const (Consts_of_Ifaces is) Text =>
  65  Term_fromI is (Proxy Text) where
  66         term_fromI tok _ctx k =
  67                 case tok of
  68                  Token_Term_Text i -> k tyText $ TermLC $ \_c -> text i
  69
  70 -- | The 'Text' 'Type'
  71 tyText :: Inj_Const cs Text => Type cs Text
  72 tyText = TyConst inj_const
  73
  74 sym_Text :: Proxy Sym_Text
  75 sym_Text = Proxy
  76
  77 {-
  78 syText :: IsString a => Syntax a
  79 syText = Syntax "Text" []
  80 -}