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 (Proxy 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 ClassInstancesFor Text where
  37         proveConstraintFor _ (TyApp _ (TyConst _ _ q) c)
  38          | Just HRefl <- proj_ConstKiTy @_ @Text c
  39          = case () of
  40                  _ | Just Refl <- proj_Const @Eq q                -> Just Dict
  41                    | Just Refl <- proj_Const @MT.MonoFoldable q   -> Just Dict
  42                    | Just Refl <- proj_Const @MT.MonoFunctor q    -> Just Dict
  43                    | Just Refl <- proj_Const @Monoid q            -> Just Dict
  44                    | Just Refl <- proj_Const @Ord q               -> Just Dict
  45                    | Just Refl <- proj_Const @Seqs.IsSequence q   -> Just Dict
  46                    | Just Refl <- proj_Const @Seqs.SemiSequence q -> Just Dict
  47                    | Just Refl <- proj_Const @Show q              -> Just Dict
  48                  _ -> Nothing
  49         proveConstraintFor _c _q = Nothing
  50 instance TypeInstancesFor Text where
  51         expandFamFor _c len f (c `TypesS` TypesZ)
  52          | Just HRefl <- proj_ConstKi @_ @Element f
  53          , Just HRefl <- proj_ConstKiTy @_ @Text c
  54          = Just $ tyConstLen @(K (MT.Element Text)) @(MT.Element Text) len
  55         expandFamFor _c _len _fam _as = Nothing
  56
  57 -- Compiling
  58 instance Gram_Term_AtomsFor src ss g Text -- TODO
  59 instance ModuleFor src ss Text
  60
  61 -- ** 'Type's
  62 tyText :: Source src => Inj_Len vs => Type src vs Text
  63 tyText = tyConst @(K Text) @Text
  64
  65 -- ** 'Term's
  66 teText :: Source src => Inj_Sym ss Text => Text -> Term src ss ts '[] Text
  67 teText t = Term noConstraint tyText $ teSym @Text $ text t