]> Git — Sourcephile - haskell/symantic.git/blob - symantic-lib/Language/Symantic/Lib/Text.hs
Cosmetic cleanup.
[haskell/symantic.git] / 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 (TyConsts_of_Ifaces is) Text =>
70 CompileI 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