Source file `dom.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
open Js

let setInnerHtml elt s = elt##.innerHTML := string s

let setText elt = function
  | None ->
      ()
  | Some s ->
      elt##.textContent := some (string s)

let addClass elt s = elt##.classList##add (string s)

let addClasses elt l = List.iter (addClass elt) l

let removeClass elt s = elt##.classList##remove (string s)

let containsClass elt s = elt##.classList##contains (string s)

let setAttribute elt key value = elt##setAttribute (string key) (string value)

let removeAttribute elt key = elt##removeAttribute (string key)

let getAttribute elt key = Opt.to_option (elt##getAttribute (string key))

let setCSS elt styles =
  let styles =
    String.concat "; " (List.map (fun (k, v) -> k ^ ": " ^ v) styles)
  in
  setAttribute elt "style" styles

let addCSS elt styles =
  let styles =
    String.concat "; " (List.map (fun (k, v) -> k ^ ": " ^ v) styles)
  in
  let styles =
    match getAttribute elt "style" with
    | None ->
        styles
    | Some old_styles ->
        old_styles ^ "; " ^ styles
  in
  setAttribute elt "style" styles

let appendChild = Dom.appendChild

let removeChild = Dom.removeChild

let appendChildren parent children = List.iter (Dom.appendChild parent) children

let children parent = Dom.list_of_nodeList parent##.childNodes

let removeChildi parent i =
  match List.nth_opt (children parent) i with
  | None ->
      ()
  | Some child ->
      removeChild parent child

let removeChildren parent = List.iter (removeChild parent) (children parent)

let replaceChildren parent children =
  removeChildren parent ;
  appendChildren parent children

let by_id s = Dom_html.getElementById s

let addListener elt ev f =
  ignore
  @@ Dom.addEventListener elt (Dom.Event.make ev)
       (Dom.handler (fun e -> bool (f e)))

module El = struct
  let create ?(classes = []) ?(styles = []) ?(listen = []) ?(attr = []) ?text f
      children =
    let elt = f Dom_html.document in
    List.iter (fun (ev, f) -> addListener elt ev f) listen ;
    addClasses elt classes ;
    setCSS elt styles ;
    List.iter (fun (k, v) -> setAttribute elt k v) attr ;
    setText elt text ;
    appendChildren elt children ;
    elt

  let button ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createButton children

  let div ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createDiv children

  let a ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createA children

  let span ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createSpan children

  let form ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createForm children

  let option ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createOption children

  let select ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createSelect children

  let input ?classes ?styles ?listen ?attr ?text () =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createInput []

  let iframe ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createIframe children

  let label ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createLabel children

  let ul ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createUl children

  let li ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createLi children

  let img ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createImg children

  let script ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createScript children

  let table ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createTable children

  let tr ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createTr children

  let th ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createTh children

  let td ?classes ?styles ?listen ?attr ?text children =
    create ?classes ?styles ?listen ?attr ?text Dom_html.createTd children
end

let encapse s = "\"" ^ s ^ "\""

let strings_to_array l = "[" ^ String.concat "," l ^ "]"

let strings_to_object l =
  let s =
    "{"
    ^ String.concat "," (List.map (fun (k, v) -> encapse k ^ ":" ^ v) l)
    ^ "}"
  in
  try _JSON##parse (string s)
  with _ ->
    log_str ("cannot parse json " ^ s) ;
    Unsafe.obj [||]