Language/Symantic/Expr/Char.hs

   1 {-# LANGUAGE DefaultSignatures #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE ScopedTypeVariables #-}
   5 {-# LANGUAGE TypeFamilies #-}
   6 {-# LANGUAGE TypeOperators #-}
   7 -- | Expression for 'Char'.
   8 module Language.Symantic.Expr.Char where
   9
  10 import Control.Monad
  11 import qualified Data.Char as Char
  12 import qualified Data.Text as Text
  13
  14 import Language.Symantic.Type
  15 import Language.Symantic.Repr
  16 import Language.Symantic.Expr.Root
  17 import Language.Symantic.Expr.Error
  18 import Language.Symantic.Expr.From
  19 import Language.Symantic.Trans.Common
  20
  21 -- * Class 'Sym_Char'
  22 -- | Symantic.
  23 class Sym_Char repr where
  24         char :: Char -> repr Char
  25         char_toUpper :: repr Char -> repr Char
  26
  27         default char :: Trans t repr => Char -> t repr Char
  28         default char_toUpper :: Trans t repr => t repr Char -> t repr Char
  29
  30         char         = trans_lift . char
  31         char_toUpper = trans_map1 char_toUpper
  32 instance Sym_Char Repr_Host where
  33         char         = Repr_Host
  34         char_toUpper = liftM Char.toUpper
  35 instance Sym_Char Repr_Text where
  36         char a = Repr_Text $ \_p _v ->
  37                 Text.pack (show a)
  38         char_toUpper = repr_text_app1 "char_toUpper"
  39 instance
  40  ( Sym_Char r1
  41  , Sym_Char r2
  42  ) => Sym_Char (Dup r1 r2) where
  43         char x = char x `Dup` char x
  44         char_toUpper (c1 `Dup` c2) = char_toUpper c1 `Dup` char_toUpper c2
  45
  46 -- * Type 'Expr_Char'
  47 -- | Expression.
  48 data Expr_Char (root:: *)
  49 type instance Root_of_Expr      (Expr_Char root)      = root
  50 type instance Type_of_Expr      (Expr_Char root)      = Type_Char
  51 type instance Sym_of_Expr       (Expr_Char root) repr = Sym_Char repr
  52 type instance Error_of_Expr ast (Expr_Char root)      = No_Error_Expr