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