package vue-jsoo

  1. Overview
  2. Docs

Source file vue_component.ml

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
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
open Mjs

(** ml types *)

type js_type =
  | JString of string
  | JObject of any
  | JNumber of float
  | JInt of int
  | JBool of bool
  | JArray of any list
  | JOther of ((js_string t -> any) callback * any)

type prop_object = {
  pr_default : js_type;
  pr_required : bool option;
  pr_validator : (string -> bool) option;
}

type prop_options =
  | PrType of js_type
  | PrTypeArray of js_type list
  | PrObj of prop_object

type props_options = PrsArray of string list | PrsObj of (string * prop_options) list

type 'all component_element =
  | CTemplate of string
  | CRender of (('all t, any -> any) meth_callback * ('all t, any -> any) meth_callback js_array t)

module Internal = struct

  class type prop_object_js = object
    method type_ : (js_string t -> any) callback readonly_prop
    method default : any optdef readonly_prop
    method required : bool t optdef readonly_prop
    method validator : (js_string t -> bool t) callback optdef readonly_prop
  end

  type vnode = any

  class type binding = object
    method name : js_string t readonly_prop
    method value : any optdef readonly_prop
    method oldValue : any optdef readonly_prop
    method expression : js_string t optdef readonly_prop
    method arg : js_string t optdef readonly_prop
    method modifiers : bool t table optdef readonly_prop
  end

  class type model = object
    method prop : js_string t optdef readonly_prop
    method event : js_string t optdef readonly_prop
  end

  class type ['data, 'all] component_common = object
    (* options / dom *)
    method render : ('all t, any -> any) meth_callback optdef readonly_prop
    method staticRenderFns : ('all t, any -> any) meth_callback js_array t optdef readonly_prop
    (* options / data *)
    method data : ('all t, unit -> 'data t) meth_callback optdef readonly_prop
    method computed : ('all t, unit -> any optdef) meth_callback table optdef readonly_prop
    method methods : any table optdef readonly_prop
    method watch : ('all t, any -> any -> any) meth_callback table optdef readonly_prop
    (* options / lifecycle hooks *)
    method beforeCreate : ('all t, unit) meth_callback optdef readonly_prop
    method created : ('all t, unit) meth_callback optdef readonly_prop
    method beforeMount : ('all t, unit) meth_callback optdef readonly_prop
    method mounted : ('all t, unit) meth_callback optdef readonly_prop
    method beforeUpdate : ('all t, unit) meth_callback optdef readonly_prop
    method updated : ('all t, unit) meth_callback optdef readonly_prop
    method activated : ('all t, unit) meth_callback optdef readonly_prop
    method deactivated : ('all t, unit) meth_callback optdef readonly_prop
    method beforeDestroy : ('all t, unit) meth_callback optdef readonly_prop
    method destroyed : ('all t, unit) meth_callback optdef readonly_prop
    method errorCaptured : (any -> any -> js_string t -> bool t optdef) callback optdef readonly_prop
    (* options / assets *)
    method directives : (Dom.element t -> binding t -> vnode -> vnode -> unit) callback table table optdef readonly_prop
    method filters : (any -> any) callback table optdef readonly_prop
    method delimiters : js_string t js_array t optdef readonly_prop
    method functional : bool t optdef readonly_prop
    method model : model t optdef readonly_prop
    method inheritAttrs : bool t optdef readonly_prop
    method comments : bool t optdef readonly_prop
  end

  class type ['data, 'all] component_arg = object
    inherit ['data, 'all] component_common
    (* options / data *)
    method props : any optdef readonly_prop
    (* options / dom *)
    method template : js_string t optdef readonly_prop
    (* options / assets *)
    method components : ('data, 'all) component_arg t table optdef readonly_prop
    (* option / composition *)
    method mixins : any js_array t optdef readonly_prop
    method extends : any optdef readonly_prop
    (* options / misc *)
    method name : js_string t optdef readonly_prop
    (* route hooks *)
    method beforeRouteEnter : (Vue_nav.push_args t -> Vue_nav.push_args t -> (any -> unit) -> unit) callback optdef readonly_prop
    method beforeRouteUpdate : ('all t, Vue_nav.push_args t -> Vue_nav.push_args t -> (any -> unit) -> unit) meth_callback optdef readonly_prop
    method beforeRouteLeave : ('all t, Vue_nav.push_args t -> Vue_nav.push_args t -> (any -> unit) -> unit) meth_callback optdef readonly_prop
  end

  type 'all vue_instance = 'all t

  class type app = object
    method component : js_string t -> ('data, 'all) component_arg t optdef -> 'all vue_instance meth
    method component_extend : js_string t -> ('data, 'all) component_arg t optdef -> 'all vue_instance constr meth
  end

  let js_type_cs : js_type -> (js_string t -> Unsafe.any) callback = function
    | JString _ -> Unsafe.pure_js_expr "String"
    | JObject _ -> Unsafe.pure_js_expr "Object"
    | JNumber _ | JInt _ -> Unsafe.pure_js_expr "Number"
    | JBool _ -> Unsafe.pure_js_expr "Boolean"
    | JArray _ -> Unsafe.pure_js_expr "Array"
    | JOther (cons, _) -> cons

  let js_prop_obj {pr_default; pr_required; pr_validator} : prop_object_js t =
    let default = match pr_default, pr_required with
      | _, Some true -> undefined
      | JString s, _ -> def @@ to_any (string s)
      | JNumber f, _ -> def @@ to_any (number_of_float f)
      | JInt i, _ -> def @@ to_any i
      | JBool b, _ -> def @@ to_any (bool b)
      | JObject o, _ -> def @@ to_any (wrap_callback (fun () -> o))
      | JArray a, _ -> def @@ to_any (wrap_callback (fun () -> of_list a))
      | JOther (_, a), _ -> def @@ to_any (wrap_callback (fun () -> a))
    in
    object%js
      val type_ = js_type_cs pr_default
      val default = default
      val required = optdef bool pr_required
      val validator = optdef (fun v -> wrap_callback (fun s -> bool (v (to_string s)))) pr_validator
    end

  let make_prop = function
    | PrType s -> to_any @@ js_type_cs s
    | PrTypeArray a -> to_any @@ of_listf js_type_cs a
    | PrObj o -> to_any @@ js_prop_obj o

  let make_props = function
    | PrsObj l ->
      to_any @@ Table.make @@ List.map (fun (name, pr) -> name, make_prop pr) l
    | PrsArray l ->
      to_any (of_listf string l)

  type ('data, 'all) component_args = {
    template : string option;
    props : props_options option;
    data : ('all t -> 'data t) option ;
    render : ('all t, any -> any) meth_callback option;
    static_renders : ('all t, any -> any) meth_callback js_array t option;
    computed : ('all t -> any optdef) table_cons option;
    watch : ('all t -> any -> any -> any) table_cons option;
    methods : any table_cons option;
    lifecycle : (string * ('all t -> unit)) list;
    error_captured : (any -> any -> string -> bool option) option;
    directives : (string * (string * (Dom.element t -> binding t -> vnode -> vnode -> unit)) list) list option;
    filters : (string * (any -> any)) list option;
    components : (top, top) component_arg t table_cons;
    mixins : any list option;
    extends : any option;
    name : string option;
    delimiters : (string * string) option;
    functional : bool option;
    model : (string option * string option) option;
    inherit_attrs : bool option;
    comments : bool option;
    hook_enter : (Vue_nav.push_obj -> Vue_nav.push_obj -> 'all Vue_nav.next) option;
    hook_update : ('all t -> Vue_nav.push_obj -> Vue_nav.push_obj -> 'all Vue_nav.next) option;
    hook_leave : ('all t -> Vue_nav.push_obj -> Vue_nav.push_obj -> 'all Vue_nav.next) option;
  }

  let make_arg c : ('data, 'all) component_arg t =
    object%js
      val template = optdef string c.template
      val props = optdef make_props c.props
      val data = optdef (fun f -> wrap_meth_callback (fun d () -> f d)) c.data
      val render = Optdef.option c.render
      val staticRenderFns = Optdef.option c.static_renders
      val computed = optdef (to_tablef (fun c -> wrap_meth_callback (fun this () -> c this))) c.computed
      val watch = optdef (to_tablef wrap_meth_callback) c.watch
      val methods = optdef to_table c.methods
      val beforeCreate = optdef wrap_meth_callback @@ List.assoc_opt "beforeCreate" c.lifecycle
      val created = optdef wrap_meth_callback @@ List.assoc_opt "created" c.lifecycle
      val beforeMount = optdef wrap_meth_callback @@ List.assoc_opt "beforeMount" c.lifecycle
      val mounted = optdef wrap_meth_callback @@ List.assoc_opt "mounted" c.lifecycle
      val beforeUpdate = optdef wrap_meth_callback @@ List.assoc_opt "beforeUpdate" c.lifecycle
      val updated = optdef wrap_meth_callback @@ List.assoc_opt "updated" c.lifecycle
      val activated = optdef wrap_meth_callback @@ List.assoc_opt "activated" c.lifecycle
      val deactivated = optdef wrap_meth_callback @@ List.assoc_opt "deactivated" c.lifecycle
      val beforeDestroy = optdef wrap_meth_callback @@ List.assoc_opt "beforeDestroy" c.lifecycle
      val destroyed = optdef wrap_meth_callback @@ List.assoc_opt "destroyed" c.lifecycle
      val errorCaptured = optdef (fun f -> wrap_callback (fun x y s -> optdef bool @@ f x y (to_string s))) c.error_captured
      val directives = optdef (Table.makef (fun l -> Table.makef wrap_callback l)) c.directives
      val filters = optdef (Table.makef wrap_callback) c.filters
      val components = to_tablef_def coerce c.components
      val mixins = optdef of_list c.mixins
      val extends = Optdef.option c.extends
      val name = optdef string c.name
      val delimiters = optdef (fun (a, b) -> array [| string a; string b |]) c.delimiters
      val functional = optdef bool c.functional
      val model = optdef (fun (prop, event) -> object%js val prop = optdef string prop val event = optdef string event end) c.model
      val inheritAttrs = optdef bool c.inherit_attrs
      val comments = optdef bool c.comments
      val beforeRouteEnter = optdef Vue_nav.wrap_hook c.hook_enter
      val beforeRouteUpdate = optdef Vue_nav.wrap_meth_hook c.hook_update
      val beforeRouteLeave = optdef Vue_nav.wrap_meth_hook c.hook_leave
    end

  let make_arg_js ?template ?render ?static_renders ?props ?data ?computed ?methods ?watch
      ?(lifecycle = []) ?error_captured ?directives ?filters ?(components= L [])
      ?mixins ?extends ?name ?delimiters ?functional ?model ?inherit_attrs ?comments
      ?enter ?update ?leave () =
    make_arg {
      template; props; data; render; static_renders; computed; watch; methods; lifecycle;
      error_captured; directives; filters; components; mixins; extends; name;
      delimiters; functional; model; inherit_attrs; comments;
      hook_enter = enter; hook_update = update; hook_leave = leave }

end

type ('data, 'all) component_args = ('data, 'all) Internal.component_args = {
  template : string option;
  props : props_options option;
  data : ('all t -> 'data t) option ;
  render : ('all t, any -> any) meth_callback option;
  static_renders : ('all t, any -> any) meth_callback js_array t option;
  computed : ('all t -> any optdef) table_cons option;
  watch : ('all t -> any -> any -> any) table_cons option;
  methods : any table_cons option;
  lifecycle : (string * ('all t -> unit)) list;
  error_captured : (any -> any -> string -> bool option) option;
  directives : (string * (string * (Dom.element t -> Internal.binding t -> Internal.vnode -> Internal.vnode -> unit)) list) list option;
  filters : (string * (any -> any)) list option;
  components : (top, top) Internal.component_arg t table_cons;
  mixins : any list option;
  extends : any option;
  name : string option;
  delimiters : (string * string) option;
  functional : bool option;
  model : (string option * string option) option;
  inherit_attrs : bool option;
  comments : bool option;
  hook_enter : (Vue_nav.push_obj -> Vue_nav.push_obj -> 'all Vue_nav.next) option;
  hook_update : ('all t -> Vue_nav.push_obj -> Vue_nav.push_obj -> 'all Vue_nav.next) option;
  hook_leave : ('all t -> Vue_nav.push_obj -> Vue_nav.push_obj -> 'all Vue_nav.next) option;
}

let empty = {
  template = None; props = None; data = None; render = None; static_renders = None;
  computed = None; watch = None; methods = None; lifecycle = []; error_captured = None;
  directives = None; filters = None; components = L []; mixins = None; extends = None;
  name = None; delimiters = None; functional = None; model = None; inherit_attrs = None;
  comments = None; hook_enter = None; hook_update = None; hook_leave = None
}

let prop ?required pr_default = PrObj { pr_default; pr_required = required; pr_validator = None}

type 'a component = 'a Internal.vue_instance

let make ?template ?render ?static_renders ?props ?data ?computed ?methods ?watch
    ?lifecycle ?error_captured ?directives ?filters ?components
    ?mixins ?extends ?delimiters ?functional ?model ?inherit_attrs ?comments
    ?enter ?update ?leave ?app ?(version= !Version.v) name =
  let arg = Internal.make_arg_js ?template ?render ?static_renders ?props ?data
      ?computed ?methods ?watch ?lifecycle ?error_captured ?directives ?filters
      ?components ?mixins ?extends ?delimiters ?functional ?model ?inherit_attrs
      ?comments ?enter ?update ?leave () in
  let v : Internal.app t = match app, version with
    | None, `v3 ->
      failwith "vue3 only accepts components attached to a root"
    | None, `v2 -> Unsafe.pure_js_expr "Vue"
    | Some v, _ -> Unsafe.coerce v in
  match extends, mixins with
  | None, None -> v##component (string name) (def arg)
  | _ ->
    let cs = v##component_extend (string name) (def arg) in
    new%js cs

(** functors *)

module type Tables_S = sig
  type all

  val methods_t : any table
  val watch_t : (all t -> any -> any -> any) table
  val computed_t : (all t -> any optdef) table
  val components_t : (top, top) Internal.component_arg t table

  val add_method : string -> (all t -> 'a) -> unit
  val add_method0 : string -> (all t -> 'a) -> unit
  val add_method1 : string -> (all t -> 'a -> 'b) -> unit
  val add_method2 : string -> (all t -> 'a -> 'b -> 'c) -> unit
  val add_method3 : string -> (all t -> 'a -> 'b -> 'c -> 'd) -> unit
  val add_method4 : string -> (all t -> 'a -> 'b -> 'c -> 'd -> 'e) -> unit
  val add_watch : string -> (all t -> 'a -> 'a -> 'b) -> unit
  val add_computed : string -> (all t -> 'a optdef) -> unit
  val add_2way_computed : string ->
    get:(all t -> 'a optdef) -> set:(all t -> 'b -> unit) -> unit
  val add_component : string -> ('a, 'b) Internal.component_arg t -> unit

  val merge_lists_component :
    ?computed:(string * (all t -> any optdef)) list ->
    ?methods:(string * any) list ->
    ?watch:(string * (all t -> any -> any -> any)) list ->
    ?components:(string * (top, top) Internal.component_arg t) list ->
    unit -> unit
end

module Tables(S : sig type all end) = struct
  type all = S.all
  let methods_t = Table.create ()
  let watch_t = Table.create ()
  let computed_t = Table.create ()
  let components_t = Table.create ()

  let add_method name m =
    Table.add methods_t name (to_any (wrap_meth_callback m))
  let add_method0 name m = add_method name m
  let add_method1 name m = add_method name m
  let add_method2 name m = add_method name m
  let add_method3 name m = add_method name m
  let add_method4 name m = add_method name m
  let add_watch name w = Table.add watch_t name (to_any (wrap_meth_callback w))
  let add_computed name c =
    Table.add computed_t name (fun this -> Optdef.map (c this) to_any)
  let add_2way_computed name ~get ~set = Table.add computed_t name @@
    coerce @@ Unsafe.obj [|
      "get", to_any @@ wrap_meth_callback (fun this () -> get this);
      "set", to_any @@ wrap_meth_callback (fun this value -> set this value) |]
  let add_component name c = Table.add components_t name @@ coerce c

  let merge_lists_component ?(computed=[]) ?(methods=[]) ?(watch=[]) ?(components=[]) () =
    Table.add_list methods_t methods;
    Table.add_list computed_t computed;
    Table.add_list watch_t watch;
    Table.add_list components_t components
end


module Make(S : sig
    type data
    type all
    val name : string
    val element : all component_element
    val props : props_options option
  end) = struct

  include Tables(struct type all = S.all end)

  let component : S.all component ref = ref (Unsafe.obj [||])

  let make ?(export=true) ?(data : (all t -> S.data t) option)
      ?computed ?methods ?watch ?components ?enter ?update ?lifecycle ?mixins ?app ?version () =
    merge_lists_component ?computed ?methods ?watch ?components ();
    let template, render, static_renders = match S.element with
      | CTemplate t -> Some t, None, None
      | CRender (r, s) -> None, Some r, Some s in
    component := make ?data ?template ?render ?static_renders ?props:S.props
        ~methods:(T methods_t) ~watch:(T watch_t) ~computed:(T computed_t)
        ?enter ?update ?lifecycle ?mixins ?app ?version S.name;
    if export then Mjs.export S.name !component;
    !component

  let get () = !component
end
OCaml

Innovation. Community. Security.