]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Compiling/Text.hs
Use GHC-8.0.1's TypeInType to handle kinds better, and migrate Compiling.
[haskell/symantic.git] / Language / Symantic / Compiling / Text.hs
1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE DefaultSignatures #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE FlexibleInstances #-}
5 {-# LANGUAGE MultiParamTypeClasses #-}
6 {-# LANGUAGE OverloadedStrings #-}
7 {-# LANGUAGE Rank2Types #-}
8 {-# LANGUAGE ScopedTypeVariables #-}
9 {-# LANGUAGE TypeFamilies #-}
10 {-# LANGUAGE TypeOperators #-}
11 {-# LANGUAGE UndecidableInstances #-}
12 {-# OPTIONS_GHC -fno-warn-orphans #-}
13 -- | Symantic for 'Text'.
14 module Language.Symantic.Compiling.Text where
15
16 import qualified Data.Function as Fun
17 import Data.Proxy
18 import Data.String (IsString)
19 import Data.Text (Text)
20 import qualified Data.Text as Text
21 import Data.Type.Equality ((:~:)(Refl))
22
23 import Language.Symantic.Typing
24 import Language.Symantic.Compiling.Term
25 import Language.Symantic.Interpreting
26 import Language.Symantic.Transforming.Trans
27
28 -- * Class 'Sym_Text'
29 class Sym_Text term where
30 text :: Text -> term Text
31 default text :: Trans t term => Text -> t term Text
32 text = trans_lift . text
33
34 type instance Sym_of_Iface (Proxy Text) = Sym_Text
35 type instance Consts_of_Iface (Proxy Text) = Proxy Text ': Consts_imported_by Text
36 type instance Consts_imported_by Text =
37 [ Proxy Eq
38 , Proxy Monoid
39 , Proxy Ord
40 ]
41
42 instance Sym_Text HostI where
43 text = HostI
44 instance Sym_Text TextI where
45 text a = TextI $ \_p _v ->
46 Text.pack (show a)
47 instance (Sym_Text r1, Sym_Text r2) => Sym_Text (DupI r1 r2) where
48 text x = text x `DupI` text x
49
50 instance Const_from Text cs => Const_from Text (Proxy Text ': cs) where
51 const_from "Text" k = k (ConstZ kind)
52 const_from s k = const_from s $ k . ConstS
53 instance Show_Const cs => Show_Const (Proxy Text ': cs) where
54 show_const ConstZ{} = "Text"
55 show_const (ConstS c) = show_const c
56
57 instance -- Proj_ConC
58 ( Proj_Const cs Text
59 , Proj_Consts cs (Consts_imported_by Text)
60 ) => Proj_ConC cs (Proxy Text) where
61 proj_conC _ (TyConst q :$ TyConst c)
62 | Just Refl <- eq_skind (kind_of_const c) SKiType
63 , Just Refl <- proj_const c (Proxy::Proxy Text)
64 = Just $ case () of
65 _ | Just Refl <- proj_const q (Proxy::Proxy Eq) -> Just Con
66 | Just Refl <- proj_const q (Proxy::Proxy Monoid) -> Just Con
67 | Just Refl <- proj_const q (Proxy::Proxy Ord) -> Just Con
68 _ -> Nothing
69 proj_conC _c _q = Nothing
70 instance -- Term_fromI
71 ( AST ast
72 , Lexem ast ~ LamVarName
73 , Inj_Const (Consts_of_Ifaces is) Text
74 , Show_Const (Consts_of_Ifaces is)
75 ) => Term_fromI is (Proxy Text) ast where
76 term_fromI ast _ctx k =
77 case ast_lexem ast of
78 "text" -> text_from
79 _ -> Left $ Error_Term_unsupported
80 where
81 text_from =
82 let ty = tyText in
83 from_lex (Text.pack $ show_type ty) ast $ \(i::Text) ->
84 k ty $ TermLC $ Fun.const $ text i
85
86 -- | The 'Text' 'Type'
87 tyText :: Inj_Const cs Text => Type cs Text
88 tyText = TyConst inj_const
89
90 sym_Text :: Proxy Sym_Text
91 sym_Text = Proxy
92
93 syText :: IsString a => Syntax a
94 syText = Syntax "Text" []