1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
module Script.Expr.Class (
ExprType(..),
ExprTypeConstr1(..),
TypeDeconstructor(..),
RecordSelector(..),
ExprListUnpacker(..),
ExprEnumerator(..),
) where
import Data.Kind
import Data.Maybe
import Data.Scientific
import Data.Text (Text)
import Data.Text qualified as T
import Data.Typeable
import Data.Void
class Typeable a => ExprType a where
textExprType :: proxy a -> Text
textExprValue :: a -> Text
matchTypeConstructor :: proxy a -> TypeDeconstructor a
matchTypeConstructor _ = NoTypeDeconstructor
recordMembers :: [(Text, RecordSelector a)]
recordMembers = []
exprExpansionConvTo :: ExprType b => Maybe (a -> b)
exprExpansionConvTo = Nothing
exprExpansionConvFrom :: ExprType b => Maybe (b -> a)
exprExpansionConvFrom = Nothing
exprListUnpacker :: proxy a -> Maybe (ExprListUnpacker a)
exprListUnpacker _ = Nothing
exprEnumerator :: proxy a -> Maybe (ExprEnumerator a)
exprEnumerator _ = Nothing
class (Typeable a, forall b. ExprType b => ExprType (a b)) => ExprTypeConstr1 (a :: Type -> Type) where
textExprTypeConstr1 :: proxy a -> Text -> Text
data TypeDeconstructor a
= NoTypeDeconstructor
| forall c x. (ExprTypeConstr1 c, ExprType x, c x ~ a) => TypeDeconstructor1 (Proxy c) (Proxy x)
data RecordSelector a = forall b. ExprType b => RecordSelector (a -> b)
data ExprListUnpacker a = forall e. ExprType e => ExprListUnpacker (a -> [e]) (Proxy a -> Proxy e)
data ExprEnumerator a = ExprEnumerator (a -> a -> [a]) (a -> a -> a -> [a])
instance ExprType () where
textExprType _ = "Unit"
textExprValue () = "()"
instance ExprType Integer where
textExprType _ = T.pack "integer"
textExprValue x = T.pack (show x)
exprExpansionConvTo = listToMaybe $ catMaybes
[ cast (T.pack . show :: Integer -> Text)
]
exprEnumerator _ = Just $ ExprEnumerator enumFromTo enumFromThenTo
instance ExprType Scientific where
textExprType _ = T.pack "number"
textExprValue x = T.pack (show x)
exprExpansionConvTo = listToMaybe $ catMaybes
[ cast (T.pack . show :: Scientific -> Text)
]
instance ExprType Bool where
textExprType _ = T.pack "bool"
textExprValue True = T.pack "true"
textExprValue False = T.pack "false"
instance ExprType Text where
textExprType _ = T.pack "string"
textExprValue x = T.pack (show x)
instance ExprType Void where
textExprType _ = T.pack "void"
textExprValue _ = T.pack "<void>"
instance ExprType a => ExprType [ a ] where
textExprType _ = textExprTypeConstr1 @[] Proxy (textExprType @a Proxy)
textExprValue x = "[" <> T.intercalate ", " (map textExprValue x) <> "]"
matchTypeConstructor _ = TypeDeconstructor1 Proxy Proxy
exprListUnpacker _ = Just $ ExprListUnpacker id (const Proxy)
instance ExprTypeConstr1 [] where
textExprTypeConstr1 _ x = "[" <> x <> "]"
instance ExprType a => ExprType (Maybe a) where
textExprType _ = textExprType @a Proxy <> "?"
textExprValue (Just x) = textExprValue x
textExprValue Nothing = "Nothing"
instance (ExprType a, ExprType b) => ExprType (Either a b) where
textExprType _ = textExprType @a Proxy <> "|" <> textExprType @b Proxy
textExprValue (Left x) = "Left " <> textExprValue x
textExprValue (Right x) = "Right " <> textExprValue x
|