]> Git — Sourcephile - haskell/symantic.git/blob - symantic-lib/Language/Symantic/Lib/Text.hs
Add README.md to extra-doc-files.
[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.Text (Text)
7 import qualified Data.MonoTraversable as MT
8 import qualified Data.Sequences as Seqs
9 import qualified Data.Text as Text
10
11 import Language.Symantic.Grammar
12 import Language.Symantic
13 import Language.Symantic.Lib.Char ()
14 import Language.Symantic.Lib.MonoFunctor (Element)
15
16 -- * Class 'Sym_Text'
17 type instance Sym Text = Sym_Text
18 class Sym_Text term where
19 text :: Text -> term Text
20 default text :: Sym_Text (UnT term) => Trans term => Text -> term Text
21 text = trans . text
22
23 -- Interpreting
24 instance Sym_Text Eval where
25 text = Eval
26 instance Sym_Text View where
27 text a = View $ \_p _v ->
28 Text.pack (show a)
29 instance (Sym_Text r1, Sym_Text r2) => Sym_Text (Dup r1 r2) where
30 text x = text x `Dup` text x
31
32 -- Transforming
33 instance (Sym_Text term, Sym_Lambda term) => Sym_Text (BetaT term)
34
35 -- Typing
36 instance NameTyOf Text where
37 nameTyOf _c = ["Text"] `Mod` "Text"
38 instance ClassInstancesFor Text where
39 proveConstraintFor _ (TyApp _ (TyConst _ _ q) c)
40 | Just HRefl <- proj_ConstKiTy @_ @Text c
41 = case () of
42 _ | Just Refl <- proj_Const @Eq q -> Just Dict
43 | Just Refl <- proj_Const @MT.MonoFoldable q -> Just Dict
44 | Just Refl <- proj_Const @MT.MonoFunctor q -> Just Dict
45 | Just Refl <- proj_Const @Monoid q -> Just Dict
46 | Just Refl <- proj_Const @Ord q -> Just Dict
47 | Just Refl <- proj_Const @Seqs.IsSequence q -> Just Dict
48 | Just Refl <- proj_Const @Seqs.SemiSequence q -> Just Dict
49 | Just Refl <- proj_Const @Show q -> Just Dict
50 _ -> Nothing
51 proveConstraintFor _c _q = Nothing
52 instance TypeInstancesFor Text where
53 expandFamFor _c len f (c `TypesS` TypesZ)
54 | Just HRefl <- proj_ConstKi @_ @Element f
55 , Just HRefl <- proj_ConstKiTy @_ @Text c
56 = Just $ tyConstLen @(K (MT.Element Text)) @(MT.Element Text) len
57 expandFamFor _c _len _fam _as = Nothing
58
59 -- Compiling
60 instance Gram_Term_AtomsFor src ss g Text -- TODO
61 instance ModuleFor src ss Text
62
63 -- ** 'Type's
64 tyText :: Source src => LenInj vs => Type src vs Text
65 tyText = tyConst @(K Text) @Text
66
67 -- ** 'Term's
68 teText :: Source src => SymInj ss Text => Text -> Term src ss ts '[] (() #> Text)
69 teText t = Term noConstraint tyText $ teSym @Text $ text t