-
Notifications
You must be signed in to change notification settings - Fork 2
/
TsRecord.purs
257 lines (202 loc) · 7.05 KB
/
TsRecord.purs
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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
module TsBridge.Types.TsRecord
( Mod
, ModField
, Opt
, RO
, TsRecord
, class Get
, class GetKey
, class GetKeyRL
, class GetMods
, class GetModsRL
, class ToRecord
, class ToRecordBuilder
, class TsBridgeTsRecord
, class TsBridgeTsRecordRL
, get
, getMods
, getModsRL
, toRecord
, toRecordBuilder
, tsBridgeTsRecord
, tsBridgeTsRecordRL
, type (~)
) where
import Prelude
import DTS as DTS
import Data.Array as Array
import Data.Maybe (Maybe, fromJust)
import Data.Reflectable (class Reflectable, reflectType)
import Data.Symbol (class IsSymbol, reflectSymbol)
import Data.Variant.Encodings.Flat (class IsRecordWithoutKey)
import Partial.Unsafe (unsafePartial)
import Prim.Boolean (False, True)
import Prim.Row as Row
import Prim.RowList (class RowToList, RowList)
import Prim.RowList as RL
import Record.Builder as RB
import TsBridge.Core (class TsBridgeBy, tsBridgeBy)
import TsBridge.Monad (TsBridgeM)
import Type.Data.Boolean (class If)
import Type.Proxy (Proxy(..))
import Unsafe.Coerce (unsafeCoerce)
import Untagged.TypeCheck (class HasRuntimeType)
import Untagged.Union (UndefinedOr, uorToMaybe)
-------------------------------------------------------------------------------
--- Types
-------------------------------------------------------------------------------
foreign import data TsRecord :: Row (ModField Type) -> Type
type role TsRecord representational
foreign import data ModField :: Type -> Type
type role ModField representational
foreign import data Mod :: Row Boolean -> Type -> ModField Type
type role Mod phantom representational
infixr 9 type Mod as ~
instance (Row.Lacks sym rts) => IsRecordWithoutKey sym (TsRecord rts) where
isRecordWithoutKey _ = Proxy
instance HasRuntimeType (TsRecord rts) where
hasRuntimeType _ _ = true
type Opt = (optional :: True)
type RO = (readOnly :: True)
-------------------------------------------------------------------------------
--- ToRecord
-------------------------------------------------------------------------------
class ToRecord rts r | rts -> r where
toRecord :: TsRecord rts -> Record r
instance (ToRecordBuilder rl rts r, RowToList rts rl) => ToRecord rts r where
toRecord x = RB.buildFromScratch $ toRecordBuilder prxRl x
where
prxRl = Proxy :: _ rl
---
class ToRecordBuilder :: RowList (ModField Type) -> Row (ModField Type) -> Row Type -> Constraint
class ToRecordBuilder rl rts r | rl rts -> r where
toRecordBuilder :: forall proxy. proxy rl -> TsRecord rts -> RB.Builder {} { | r }
instance ToRecordBuilder RL.Nil rts () where
toRecordBuilder _ _ = identity
instance
( ToRecordBuilder rl' rts r'
, Row.Cons sym (Mod mods a) rtsx rts
, Row.Cons sym a_ r' r
, Row.Lacks sym r'
, IsSymbol sym
, Get sym rts a_
) =>
ToRecordBuilder (RL.Cons sym (Mod mods a) rl') rts r
where
toRecordBuilder _ tsRec = buildHead <<< buildTail
where
val :: a_
val = get prxSym tsRec
buildHead = RB.insert prxSym val
buildTail = toRecordBuilder prxRl' tsRec
prxRl' = Proxy :: _ rl'
prxSym = Proxy :: _ sym
-------------------------------------------------------------------------------
class Get :: Symbol -> Row (ModField Type) -> Type -> Constraint
class
Get sym rts a
| sym rts
sym rts -> a
where
get :: Proxy sym -> TsRecord rts -> a
instance
( GetKey "optional" mods False optional
, If optional (Maybe a) a a_
, Row.Cons sym (Mod mods a) rtsx rts
, Reflectable optional Boolean
, IsSymbol sym
) =>
Get sym rts a_ where
get _ tsRec =
if isOptional then
unsafeCoerce $ getKeyMaybe key tsRec
else
unsafeCoerce $ unsafeGetKey key tsRec
where
key = reflectSymbol prxSym
isOptional = reflectType prxOptional
prxOptional = Proxy :: _ optional
prxSym = Proxy :: _ sym
foreign import getKeyImpl :: forall rts a. String -> TsRecord rts -> UndefinedOr a
getKeyMaybe :: forall rts a. String -> TsRecord rts -> Maybe a
getKeyMaybe key = getKeyImpl key >>> uorToMaybe
unsafeGetKey :: forall rts a. String -> TsRecord rts -> a
unsafeGetKey key = unsafePartial (getKeyImpl key >>> uorToMaybe >>> fromJust)
-------------------------------------------------------------------------------
class GetKey :: forall k. Symbol -> Row k -> k -> k -> Constraint
class GetKey sym r fail match | sym r fail -> match
instance (RowToList r rl, GetKeyRL sym rl fail match) => GetKey sym r fail match
class GetKeyRL :: forall k. Symbol -> RowList k -> k -> k -> Constraint
class GetKeyRL sym rl fail match | sym rl fail -> match
instance GetKeyRL sym RL.Nil fail fail
instance GetKeyRL sym (RL.Cons sym a rl') fail a
else instance (GetKeyRL sym' rl' fail match) => GetKeyRL sym' (RL.Cons sym a rl') fail match
-------------------------------------------------------------------------------
-- TsBridgeTsRecord
-------------------------------------------------------------------------------
class TsBridgeTsRecord :: Type -> Row (ModField Type) -> Constraint
class TsBridgeTsRecord tok r where
tsBridgeTsRecord :: tok -> Proxy (TsRecord r) -> TsBridgeM DTS.TsType
instance (RowToList r rl, TsBridgeTsRecordRL tok rl) => TsBridgeTsRecord tok r where
tsBridgeTsRecord tok _ = DTS.TsTypeRecord <$> tsBridgeTsRecordRL tok (Proxy :: _ rl)
---
class TsBridgeTsRecordRL :: Type -> RowList (ModField Type) -> Constraint
class TsBridgeTsRecordRL tok rl where
tsBridgeTsRecordRL :: tok -> Proxy rl -> TsBridgeM (Array DTS.TsRecordField)
instance TsBridgeTsRecordRL tok RL.Nil where
tsBridgeTsRecordRL _ _ = pure []
instance
( TsBridgeBy tok t
, TsBridgeTsRecordRL tok rl
, IsSymbol s
, GetMods mods
) =>
TsBridgeTsRecordRL tok (RL.Cons s (Mod mods t) rl) where
tsBridgeTsRecordRL tok _ = do
x <- tsBridgeBy tok (Proxy :: _ t)
xs <- tsBridgeTsRecordRL tok (Proxy :: _ rl)
let k = reflectSymbol (Proxy :: _ s)
pure $
Array.cons (DTS.TsRecordField k mods x) xs
where
mods = getMods (Proxy :: _ mods)
-------------------------------------------------------------------------------
--- Tests
-------------------------------------------------------------------------------
class GetMods :: Row Boolean -> Constraint
class GetMods r where
getMods :: Proxy r -> DTS.PropModifiers
instance (RowToList r rl, GetModsRL rl) => GetMods r where
getMods _ = getModsRL prxRl
where
prxRl = Proxy :: _ rl
---
class GetModsRL :: RowList Boolean -> Constraint
class GetModsRL rl where
getModsRL :: Proxy rl -> DTS.PropModifiers
instance GetModsRL RL.Nil where
getModsRL _ = { optional: false, readonly: false }
instance
( GetModsRL rl'
, Reflectable optional Boolean
) =>
GetModsRL (RL.Cons "optional" optional rl')
where
getModsRL _ = head tail
where
head = _ { optional = reflectType prxOptional }
tail = getModsRL prxRl'
prxRl' = Proxy :: _ rl'
prxOptional = Proxy :: _ optional
instance
( GetModsRL rl'
, Reflectable readonly Boolean
) =>
GetModsRL (RL.Cons "readonly" readonly rl')
where
getModsRL _ = head tail
where
head = _ { readonly = reflectType prxReadonly }
tail = getModsRL prxRl'
prxRl' = Proxy :: _ rl'
prxReadonly = Proxy :: _ readonly