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