@@ -26,62 +26,91 @@ module GlobalVars =
26
26
/// ===========================================
27
27
/// Types
28
28
/// ===========================================
29
+
30
+ /// Quick checker for option type values
31
+ let OptionCheckValue value = function
32
+ | Some v when v = value -> true
33
+ | _ -> false
34
+
35
+ let unionToString ( x : 'a ) =
36
+ match FSharpValue.GetUnionFields( x, typeof< 'a>) with
37
+ | case, _ -> case.Name
38
+
29
39
type Flavor =
30
40
| Worker
31
41
| Web
32
- | Windows
33
- override x.ToString () =
34
- match FSharpValue.GetUnionFields( x, typeof< Flavor>) with
35
- | case, _ -> case.Name
42
+ | All
43
+ override x.ToString () = unionToString x
44
+
45
+ type Browser = XmlProvider< " sample.xml" , Global= true >
46
+
47
+ module JsonItems =
48
+ type ItemsType = JsonProvider< " inputfiles/sample.json" >
36
49
37
- type Browser = XmlProvider< " sample.xml" , Global= true >
50
+ let overriddenItems =
51
+ File.ReadAllText( GlobalVars.inputFolder + @" \overridingTypes.json" ) |> ItemsType.Parse
38
52
39
- type CommentType = JsonProvider< " inputfiles/comments.json" >
53
+ let removedItems =
54
+ File.ReadAllText( GlobalVars.inputFolder + @" \removedTypes.json" ) |> ItemsType.Parse
40
55
41
- type TypesFromJsonFile = JsonProvider< " inputfiles/sample.json" >
56
+ let addedItems =
57
+ File.ReadAllText( GlobalVars.inputFolder + @" \addedTypes.json" ) |> ItemsType.Parse
42
58
43
- let overridingTypes =
44
- File.ReadAllText(__ SOURCE_ DIRECTORY__ + @" \inputfiles\overridingTypes.json" ) |> TypesFromJsonFile.Parse
59
+ // This is the kind of items in the external json files that are used as a
60
+ // correction for the spec.
61
+ type ItemKind =
62
+ Property | Method | Constant | Constructor | Interface | Callback | Indexer
63
+ override x.ToString () = ( unionToString x) .ToLower()
45
64
46
- let removedTypes =
47
- File.ReadAllText(__ SOURCE_ DIRECTORY__ + @" \inputfiles\removedTypes.json" ) |> TypesFromJsonFile.Parse
65
+ let findItem ( allItems : ItemsType.Root []) ( itemName : string ) ( kind : ItemKind ) otherFilter =
66
+ let filter ( item : ItemsType.Root ) =
67
+ OptionCheckValue itemName item.Name &&
68
+ item.Kind.ToLower() = kind.ToString() &&
69
+ otherFilter item
70
+ allItems |> Array.tryFind filter
48
71
49
- let addedTypes =
50
- File.ReadAllText (__ SOURCE _ DIRECTORY __ + @" \inputfiles\addedTypes.json " ) |> TypesFromJsonFile.Parse
72
+ let matchInterface iName ( item : ItemsType.Root ) =
73
+ item.Interface.IsNone || item.Interface.Value = iName
51
74
52
- type MemberKind =
53
- Property | Method
54
- member this.ToString = if this = Property then " property" else " method"
75
+ let findOverriddenItem itemName ( kind : ItemKind ) iName =
76
+ findItem overriddenItems itemName kind ( matchInterface iName)
55
77
56
- let findTypeFromJsonArray ( jsonArray : TypesFromJsonFile.Root []) mName iName ( kind : MemberKind ) =
57
- jsonArray
58
- |> Array.tryFind ( fun t ->
59
- t.Name = mName && ( t.Interface.IsNone || t.Interface.Value = iName) && t.Kind = kind.ToString)
78
+ let findRemovedItem itemName ( kind : ItemKind ) iName =
79
+ findItem removedItems itemName kind ( matchInterface iName)
60
80
61
- let findOverridingType mName iName ( kind : MemberKind ) = findTypeFromJsonArray overridingTypes mName iName kind
62
- let findRemovedType mName iName ( kind : MemberKind ) = findTypeFromJsonArray removedTypes mName iName kind
63
- let findAddedType mName iName ( kind : MemberKind ) = findTypeFromJsonArray addedTypes mName iName kind
81
+ let findAddedItem itemName ( kind : ItemKind ) iName =
82
+ findItem addedItems itemName kind ( matchInterface iName)
64
83
65
- let getAllAddedInterfaces ( flavor : Flavor ) =
66
- addedTypes |> Array.filter ( fun t -> t.Kind = " interface" && ( t.Flavor.IsNone || t.Flavor.Value = flavor.ToString() || flavor = Windows))
84
+ let getItems ( allItems : ItemsType.Root []) ( kind : ItemKind ) ( flavor : Flavor ) =
85
+ allItems
86
+ |> Array.filter ( fun t ->
87
+ t.Kind.ToLower() = kind.ToString() &&
88
+ ( t.Flavor.IsNone || t.Flavor.Value = flavor.ToString() || flavor = All))
67
89
68
- let comments = File.ReadAllText(__ SOURCE_ DIRECTORY__ + @" \inputfiles\comments.json" ) |> CommentType.Parse
90
+ let getOverriddenItems kind flavor = getItems overriddenItems kind flavor
91
+ let getAddedItems kind flavor = getItems addedItems kind flavor
92
+ let getRemovedItems kind flavor = getItems removedItems kind flavor
69
93
70
- let GetCommentForProperty iName pName =
71
- match comments.Interfaces |> Array.tryFind ( fun i -> i.Name = iName) with
72
- | Some i ->
73
- match i.Members.Property |> Array.tryFind ( fun p -> p.Name = pName) with
74
- | Some p -> Some p.Comment
94
+ module Comments =
95
+ type CommentType = JsonProvider< " inputfiles/comments.json" >
96
+
97
+ let comments = File.ReadAllText(__ SOURCE_ DIRECTORY__ + @" \inputfiles\comments.json" ) |> CommentType.Parse
98
+
99
+ let GetCommentForProperty iName pName =
100
+ match comments.Interfaces |> Array.tryFind ( fun i -> i.Name = iName) with
101
+ | Some i ->
102
+ match i.Members.Property |> Array.tryFind ( fun p -> p.Name = pName) with
103
+ | Some p -> Some p.Comment
104
+ | _ -> None
75
105
| _ -> None
76
- | _ -> None
77
106
78
- let GetCommentForMethod iName mName =
79
- match comments.Interfaces |> Array.tryFind ( fun i -> i.Name = iName) with
80
- | Some i ->
81
- match i.Members.Method |> Array.tryFind ( fun m -> m.Name = mName) with
82
- | Some m -> Some m.Comment
107
+ let GetCommentForMethod iName mName =
108
+ match comments.Interfaces |> Array.tryFind ( fun i -> i.Name = iName) with
109
+ | Some i ->
110
+ match i.Members.Method |> Array.tryFind ( fun m -> m.Name = mName) with
111
+ | Some m -> Some m.Comment
112
+ | _ -> None
83
113
| _ -> None
84
- | _ -> None
85
114
86
115
// Printer for print to file
87
116
type Printer ( target : TextWriter ) =
@@ -107,7 +136,7 @@ type Printer(target : TextWriter) =
107
136
member this.printWithAddedIndent content =
108
137
Printf.kprintf ( fun s -> output.Append( " \r\n " + this.getCurIndent() + " " + s) |> ignore) content
109
138
110
- member this.dump () =
139
+ member this.emit () =
111
140
fprintf this.target " %s " ( output.ToString())
112
141
this.target.Flush()
113
142
@@ -163,20 +192,23 @@ type EventHandler =
163
192
EventName : string
164
193
EventType : string }
165
194
166
- /// Decide which members of a function to dump
167
- type DumpScope =
195
+ /// Decide which members of a function to emit
196
+ type EmitScope =
168
197
| StaticOnly
169
198
| InstanceOnly
170
199
| All
171
200
172
201
// Used to decide if a member should be emitted given its static property and
173
202
// the intended scope level.
174
- let inline matchScope scope ( x : ^a when ^a : ( member Static : Option<int > )) =
175
- if scope = DumpScope .All then true
203
+ let inline matchScope scope ( x : ^a when ^a : ( member Static : Option<'b > )) =
204
+ if scope = EmitScope .All then true
176
205
else
177
- let isStatic = ( ^a : ( member Static : Option< int>) x)
178
- if isStatic.IsSome then scope = DumpScope.StaticOnly
179
- else scope = DumpScope.InstanceOnly
206
+ let isStatic = ( ^a : ( member Static : Option< 'b>) x)
207
+ if isStatic.IsSome then scope = EmitScope.StaticOnly
208
+ else scope = EmitScope.InstanceOnly
209
+
210
+ let matchInterface iName ( x : JsonItems.ItemsType.Root ) =
211
+ x.Interface.IsNone || x.Interface.Value = iName
180
212
181
213
/// ===========================================
182
214
/// Shared data and helper functions
@@ -198,11 +230,6 @@ let AdjustParamName name =
198
230
| " continue" -> " _continue"
199
231
| _ -> name
200
232
201
- /// Quick checker for option type values
202
- let OptionCheckValue value = function
203
- | Some v when v = value -> true
204
- | _ -> false
205
-
206
233
/// Parse the xml input file
207
234
let browser =
208
235
( new StreamReader( Path.Combine( GlobalVars.inputFolder, " browser.webidl.xml" ))) .ReadToEnd() |> Browser.Parse
@@ -214,18 +241,18 @@ let worker =
214
241
/// (Member constraint aka duck typing)
215
242
/// reason is that ^a can be an interface, property or method, but they
216
243
/// all share a 'tag' property
217
- let inline ShouldKeep flavor ( i : ^a when ^a : ( member Tags : string option ) and ^a : ( member Name : string ) ) =
244
+ let inline ShouldKeep flavor ( i : ^a when ^a : ( member Tags : string option )) =
218
245
let filterByTag =
219
246
match (((((( ^a : ( member Tags : string option) i)))))) with
220
247
| Some tags ->
221
248
// Check if should be included
222
249
match flavor with
223
- | Web ->
250
+ | Flavor. Web ->
224
251
[ " MSAppOnly" ; " WinPhoneOnly" ]
225
252
|> Seq.exists ( fun t -> tags.Contains t)
226
253
|> not
227
- | Windows -> true
228
- | Worker ->
254
+ | Flavor.All -> true
255
+ | Flavor. Worker ->
229
256
[ " IEOnly" ]
230
257
|> Seq.exists ( fun t -> tags.Contains t)
231
258
|> not
@@ -277,29 +304,32 @@ let knownWorkerInterfaces =
277
304
278
305
let GetAllInterfacesByFlavor flavor =
279
306
match flavor with
280
- | Web -> allWebInterfaces |> Array.filter ( ShouldKeep Web)
281
- | Windows -> allWebInterfaces |> Array.filter ( ShouldKeep Windows )
282
- | Worker ->
307
+ | Flavor. Web -> allWebInterfaces |> Array.filter ( ShouldKeep Web)
308
+ | Flavor.All -> allWebInterfaces |> Array.filter ( ShouldKeep Flavor.All )
309
+ | Flavor. Worker ->
283
310
let isFromBrowserXml = allWebInterfaces |> Array.filter ( fun i -> knownWorkerInterfaces.Contains i.Name)
284
311
Array.append isFromBrowserXml allWorkerAdditionalInterfaces
285
312
286
313
let GetNonCallbackInterfacesByFlavor flavor =
287
314
match flavor with
288
- | Web -> allWebNonCallbackInterfaces |> Array.filter ( ShouldKeep Web)
289
- | Windows -> allWebNonCallbackInterfaces |> Array.filter ( ShouldKeep Windows )
290
- | Worker ->
315
+ | Flavor. Web -> allWebNonCallbackInterfaces |> Array.filter ( ShouldKeep Flavor. Web)
316
+ | Flavor.All -> allWebNonCallbackInterfaces |> Array.filter ( ShouldKeep Flavor.All )
317
+ | Flavor. Worker ->
291
318
let isFromBrowserXml =
292
319
allWebNonCallbackInterfaces |> Array.filter ( fun i -> knownWorkerInterfaces.Contains i.Name)
293
320
Array.append isFromBrowserXml allWorkerAdditionalInterfaces
294
321
295
322
let GetPublicInterfacesByFlavor flavor =
296
323
match flavor with
297
- | Web | Windows -> browser.Interfaces |> Array.filter ( ShouldKeep flavor)
298
- | Worker ->
324
+ | Flavor. Web | Flavor.All -> browser.Interfaces |> Array.filter ( ShouldKeep flavor)
325
+ | Flavor. Worker ->
299
326
let isFromBrowserXml = browser.Interfaces |> Array.filter ( fun i -> knownWorkerInterfaces.Contains i.Name)
300
327
Array.append isFromBrowserXml worker.Interfaces
301
328
302
- let GetCallbackFuncsByFlavor flavor = browser.CallbackFunctions |> Array.filter ( ShouldKeep flavor)
329
+ let GetCallbackFuncsByFlavor flavor =
330
+ browser.CallbackFunctions
331
+ |> Array.filter ( ShouldKeep flavor)
332
+ |> Array.filter ( fun cb -> flavor <> Flavor.Worker || knownWorkerInterfaces.Contains cb.Name)
303
333
304
334
/// Event name to event type map
305
335
let eNameToEType =
@@ -342,7 +372,7 @@ let tagNameToEleName =
342
372
| name when Seq.contains name iNames -> name
343
373
| _ -> raise ( Exception( " Element conflict occured! Typename: " + tagName))
344
374
345
- [ for i in GetNonCallbackInterfacesByFlavor Windows do
375
+ [ for i in GetNonCallbackInterfacesByFlavor Flavor.All do
346
376
yield ! [ for e in i.Elements do
347
377
yield ( e.Name, i.Name) ] ]
348
378
|> Seq.groupBy fst
@@ -380,15 +410,15 @@ let iNameToIDependList =
380
410
/// Distinct event type list, used in the "createEvent" function
381
411
let distinctETypeList =
382
412
let usedEvents =
383
- [ for i in GetNonCallbackInterfacesByFlavor Windows do
413
+ [ for i in GetNonCallbackInterfacesByFlavor Flavor.All do
384
414
match i.Events with
385
415
| Some es -> yield ! es.Events
386
416
| _ -> () ]
387
417
|> List.map ( fun e -> e.Type)
388
418
|> List.distinct
389
419
390
420
let unUsedEvents =
391
- GetNonCallbackInterfacesByFlavor Windows
421
+ GetNonCallbackInterfacesByFlavor Flavor.All
392
422
|> Array.filter ( fun i -> i.Extends = " Event" )
393
423
|> Array.map ( fun i -> i.Name)
394
424
|> Array.filter ( fun n -> n.EndsWith( " Event" ) && not ( List.contains n usedEvents))
@@ -475,8 +505,8 @@ let ehNameToEType =
475
505
476
506
let GetGlobalPollutor flavor =
477
507
match flavor with
478
- | Web | Windows -> browser.Interfaces |> Array.tryFind ( fun i -> i.PrimaryGlobal.IsSome)
479
- | Worker -> worker.Interfaces |> Array.tryFind ( fun i -> i.Global.IsSome)
508
+ | Flavor. Web | Flavor.All -> browser.Interfaces |> Array.tryFind ( fun i -> i.PrimaryGlobal.IsSome)
509
+ | Flavor. Worker -> worker.Interfaces |> Array.tryFind ( fun i -> i.Global.IsSome)
480
510
481
511
let GetGlobalPollutorName flavor =
482
512
match GetGlobalPollutor flavor with
0 commit comments