0 | module Text.WebIDL.Encoder
5 | import Text.WebIDL.Types
14 | 0 Encoder : Type -> Type
15 | Encoder a = a -> String
17 | runEnc : forall a . Encoder a -> a -> String
20 | inParens : Encoder a -> Encoder a
21 | inParens f a = "(" ++ f a ++ ")"
23 | inBrackets : Encoder a -> Encoder a
24 | inBrackets f a = "[" ++ f a ++ "]"
26 | inBraces : Encoder a -> Encoder a
27 | inBraces f a = "{" ++ f a ++ "}"
29 | inAngles : Encoder a -> Encoder a
30 | inAngles f a = "<" ++ f a ++ ">"
32 | emaybe : Encoder a -> Encoder (Maybe a)
33 | emaybe f = maybe "" f
35 | sepList' : (sep : String) -> List String -> String
36 | sepList' sep = concat . intersperse sep
38 | sepList : (sep : String) -> Encoder a -> Encoder (List a)
39 | sepList sep f = sepList' sep . map f
41 | emptyIfNull : Foldable f => Encoder (f a) -> Encoder (f a)
42 | emptyIfNull f as = if null as then "" else f as
44 | spaced : List String -> String
45 | spaced = concat . intersperse " "
52 | other : Encoder Other
65 | eaInner : Encoder EAInner
67 | eaInner (Left ip :: eai) = "(" ++ eaInner ip ++ ") " ++ eaInner eai
68 | eaInner (Right o :: eai) = other o ++ " " ++ eaInner eai
71 | extAttribute : Encoder ExtAttribute
72 | extAttribute (Last (Left i)) = "(" ++ eaInner i ++ ")"
73 | extAttribute (Last (Right o)) = other o
74 | extAttribute (Cons (Left i) r) = "(" ++ eaInner i ++ ") " ++ extAttribute r
75 | extAttribute (Cons (Right o) r) = other o ++ " " ++ extAttribute r
78 | attributes : Encoder ExtAttributeList
79 | attributes = emptyIfNull . inBrackets $
sepList "," extAttribute
82 | attributed : Encoder a -> Encoder (Attributed a)
83 | attributed f (as,a) = attributes as ++ " " ++ f a
90 | intType : Encoder IntType
91 | intType Short = "short"
92 | intType Long = "long"
93 | intType LongLong = "long long"
96 | floatType : Encoder FloatType
97 | floatType Float = "float"
98 | floatType Dbl = "double"
101 | primitive : Encoder PrimitiveType
102 | primitive (Unsigned x) = "unsigned " ++ intType x
103 | primitive (Signed x) = intType x
104 | primitive (Unrestricted x) = "unrestricted " ++ floatType x
105 | primitive (Restricted x) = floatType x
106 | primitive Undefined = "undefined"
107 | primitive Boolean = "boolean"
108 | primitive Byte = "byte"
109 | primitive Octet = "octet"
110 | primitive BigInt = "bigint"
113 | constType : Encoder ConstType
114 | constType (CP x) = primitive x
115 | constType (CI x) = interpolate x
118 | idlType : Encoder IdlType
121 | unionMember : Encoder UnionMemberType
123 | unionList : SnocList String -> List UnionMemberType -> String
126 | union : Encoder UnionType
129 | distinguishable : Encoder Distinguishable
131 | idlType Any = "any"
132 | idlType (D $
MaybeNull x) = distinguishable x ++ "?"
133 | idlType (D $
NotNull x) = distinguishable x
134 | idlType (U $
MaybeNull x) = union x ++ "?"
135 | idlType (U $
NotNull x) = union x
136 | idlType (Promise x) = "Promise <" ++ idlType x ++ ">"
138 | unionMember (MkUnionMember a x) =
139 | attributes a ++ " " ++ distinguishable x
141 | union (UT fst snd rest) = unionList [< unionMember fst, unionMember snd] rest
143 | unionList ss [] = "(" ++ concat (intersperse " or " (ss <>> [])) ++ ")"
144 | unionList ss (h::t) = unionList (ss :< unionMember h) t
146 | distinguishable (P x) = primitive x
147 | distinguishable (S x) = show x
148 | distinguishable (I x) = "\{x}"
149 | distinguishable (B x) = show x
150 | distinguishable (Sequence a x) =
151 | "sequence <" ++ attributes a ++ idlType x ++ ">"
152 | distinguishable (FrozenArray a x) =
153 | "FrozenArray <" ++ attributes a ++ idlType x ++ ">"
154 | distinguishable (ObservableArray a x) =
155 | "ObservableArray <" ++ attributes a ++ idlType x ++ ">"
156 | distinguishable (Record x a y) =
157 | "record<" ++ show x ++ "," ++ attributes a ++ idlType y ++ ">"
158 | distinguishable Object = "object"
159 | distinguishable Symbol = "symbol"
161 | optionalType : Encoder OptionalType
162 | optionalType Nothing = ""
163 | optionalType (Just (a,x)) = "," ++ attributes a ++ idlType x
170 | constValue : Encoder ConstValue
171 | constValue (B True) = "true"
172 | constValue (B False) = "false"
173 | constValue (F x) = "\{x}"
174 | constValue (I x) = "\{x}"
177 | defaultV : Encoder Default
179 | defaultV EmptyList = "= []"
180 | defaultV EmptySet = "= {}"
181 | defaultV Null = "= null"
182 | defaultV (S x) = "= " ++ "\{x}"
183 | defaultV (C x) = "= " ++ constValue x
186 | arg (MkArg as t n) = spaced [attributes as, idlType t, n.value]
188 | vararg : Encoder Arg
189 | vararg (MkArg as t n) = spaced [attributes as, idlType t ++ "...", n.value]
191 | optArg : Encoder OptArg
192 | optArg (MkOptArg as tas t n d) =
196 | , attributed idlType (tas,t)
202 | argumentList : Encoder ArgumentList
203 | argumentList (VarArg args va) =
204 | sepList' "," (map arg args ++ [vararg va])
206 | argumentList (NoVarArg args optArgs) =
207 | sepList' "," (map arg args ++ map optArg optArgs)
209 | optArgList : Encoder ArgumentList
210 | optArgList (NoVarArg Nil Nil) = ""
211 | optArgList x = inParens argumentList x
217 | member : (key : String) -> List String -> String
218 | member "" vs = spaced vs ++ ";"
219 | member k vs = spaced (k :: vs) ++ ";"
222 | const : Encoder Const
223 | const (MkConst t n v) = member "const" [constType t,n.value,"=",constValue v]
226 | special : Encoder Special
227 | special Getter = "getter"
228 | special Setter = "setter"
229 | special Deleter = "deleter"
232 | op : Encoder a -> Encoder (Op a)
233 | op f (MkOp s t n a) =
234 | member "" [f s, idlType t, maybe "" value n, inParens argumentList a]
237 | regularOperation : Encoder RegularOperation
238 | regularOperation = op (const "")
241 | specialOperation : Encoder SpecialOperation
242 | specialOperation = op special
245 | operation : Encoder Operation
246 | operation = op (maybe "" special)
248 | callbackInterfaceMember : Encoder CallbackInterfaceMember
249 | callbackInterfaceMember = collapseNS . hliftA2 runEnc [const,regularOperation]
251 | callbackInterfaceMembers : Encoder CallbackInterfaceMembers
252 | callbackInterfaceMembers = sepList " " $
attributed callbackInterfaceMember
254 | inheritance : Encoder Inheritance
255 | inheritance = maybe "" $
\i => " : " ++ i.value
257 | dictMemberRest : Encoder DictionaryMemberRest
258 | dictMemberRest (Required as t n) =
259 | member "required" [attributes as,idlType t,n.value]
260 | dictMemberRest (Optional t n d) =
261 | member "" [idlType t, n.value, defaultV d]
263 | dictMembers : Encoder DictionaryMembers
264 | dictMembers = sepList " " $
attributed dictMemberRest
266 | readonly : Encoder a -> Encoder (Readonly a)
267 | readonly f = ("readonly " ++) . f . value
269 | inherit : Encoder a -> Encoder (Inherit a)
270 | inherit f = ("inherit " ++) . f . value
272 | attribute : Encoder Attribute
273 | attribute (MkAttribute as t n) =
274 | member "attribute" [attributes as, idlType t, n.value]
276 | stringifier : Encoder Stringifier
278 | ("stringifier " ++)
280 | . hliftA2 runEnc [attribute,readonly attribute,regularOperation,const ";"]
282 | static : Encoder StaticMember
286 | . hliftA2 runEnc [attribute,readonly attribute,regularOperation]
288 | maplike : Encoder Maplike
289 | maplike (MkMaplike l r) =
290 | member "maplike" ["<",attributed idlType l,",",attributed idlType r,">"]
292 | setlike : Encoder Setlike
293 | setlike (MkSetlike p) = member "setlike" ["<",attributed idlType p,">"]
295 | namespaceMember : Encoder NamespaceMember
297 | collapseNS . hliftA2 runEnc [regularOperation,readonly attribute]
299 | namespaceMembers : Encoder NamespaceMembers
300 | namespaceMembers = sepList " " $
attributed namespaceMember
302 | constructor_ : Encoder Constructor
303 | constructor_ (MkConstructor args) =
304 | member "constructor" [inParens argumentList args]
306 | partialInterfaceMember : Encoder PartialInterfaceMember
307 | partialInterfaceMember (IConst x) = const x
308 | partialInterfaceMember (IOp x) = operation x
309 | partialInterfaceMember (IAttr x) = attribute x
310 | partialInterfaceMember (IAttrRO x) = readonly attribute x
311 | partialInterfaceMember (IAttrInh x) = inherit attribute x
312 | partialInterfaceMember (IMap x) = maplike x
313 | partialInterfaceMember (IMapRO x) = readonly maplike x
314 | partialInterfaceMember (ISet x) = setlike x
315 | partialInterfaceMember (ISetRO x) = readonly setlike x
316 | partialInterfaceMember (IStr x) = stringifier x
317 | partialInterfaceMember (IStatic x) = static x
318 | partialInterfaceMember (IIterable p o) =
319 | member "iterable" ["<",attributed idlType p,optionalType o,">"]
320 | partialInterfaceMember (IAsync p o a) =
321 | member "async iterable"
322 | ["<",attributed idlType p,optionalType o,">",optArgList a]
324 | mixinMember : Encoder MixinMember
325 | mixinMember (MConst x) = const x
326 | mixinMember (MOp x) = regularOperation x
327 | mixinMember (MAttr x) = attribute x
328 | mixinMember (MAttrRO x) = readonly attribute x
329 | mixinMember (MStr x) = stringifier x
331 | partialInterfaceMembers : Encoder PartialInterfaceMembers
332 | partialInterfaceMembers = sepList " " $
attributed partialInterfaceMember
334 | mixinMembers : Encoder MixinMembers
335 | mixinMembers = sepList " " $
attributed mixinMember
338 | interfaceMember : Encoder InterfaceMember
340 | collapseNS . hliftA2 runEnc [constructor_,partialInterfaceMember]
342 | interfaceMembers : Encoder InterfaceMembers
343 | interfaceMembers = sepList " " $
attributed interfaceMember
349 | def : ExtAttributeList -> (key : String) -> List String -> String
350 | def as "" ss = attributes as ++ spaced ss ++ ";"
351 | def as key ss = attributes as ++ spaced (key :: ss) ++ ";"
353 | callback : Encoder Callback
354 | callback (MkCallback as n t args) =
355 | def as "callback" [n.value, "=", idlType t, inParens argumentList args]
357 | callbackInterface : Encoder CallbackInterface
358 | callbackInterface (MkCallbackInterface as n ms) =
359 | def as "callback interface"
360 | [n.value, inBraces callbackInterfaceMembers ms]
362 | dictionary : Encoder Dictionary
363 | dictionary (MkDictionary as n i ms) =
364 | def as "dictionary"
365 | [n.value, inheritance i, inBraces dictMembers ms]
367 | enum : Encoder Enum
368 | enum (MkEnum as n vs) =
369 | def as "enum" [n.value, inBraces (sepList "," interpolate) (forget vs)]
371 | iface : Encoder Interface
372 | iface (MkInterface as n i ms) =
373 | def as "interface" [n.value, inheritance i, inBraces interfaceMembers ms]
375 | includes : Encoder Includes
376 | includes (MkIncludes as a b) = def as "" [a.value,"includes",b.value]
378 | mixin : Encoder Mixin
379 | mixin (MkMixin as n ms) =
380 | def as "interface mixin" [n.value, inBraces mixinMembers ms]
382 | nspace : Encoder Namespace
383 | nspace (MkNamespace as n ms) =
384 | def as "namespace" [n.value, inBraces namespaceMembers ms]
386 | pdictionary : Encoder PDictionary
387 | pdictionary (MkPDictionary as n ms) =
388 | def as "partial dictionary" [n.value, inBraces dictMembers ms]
390 | pinterface : Encoder PInterface
391 | pinterface (MkPInterface as n ms) =
392 | def as "partial interface" [n.value, inBraces partialInterfaceMembers ms]
394 | pmixin : Encoder PMixin
395 | pmixin (MkPMixin as n ms) =
396 | def as "partial interface mixin" [n.value, inBraces mixinMembers ms]
398 | pnamespace : Encoder PNamespace
399 | pnamespace (MkPNamespace as n ms) =
400 | def as "partial namespace" [n.value, inBraces namespaceMembers ms]
402 | typedef : Encoder Typedef
403 | typedef (MkTypedef as tas t n) =
404 | def as "typedef" [attributes tas, idlType t, n.value]
407 | definition : Encoder Definition
413 | , callbackInterface
424 | part : Encoder Part
425 | part = collapseNS . hliftA2 runEnc [pdictionary,pinterface,pmixin,pnamespace]
428 | partOrDef : Encoder PartOrDef
429 | partOrDef (Z p) = part p
430 | partOrDef (S $
Z d) = definition d