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