package bonsai

  1. Overview
  2. Docs
package bonsai
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file table_view.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
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
open! Core
open! Bonsai_web
open! Bonsai.Let_syntax

module Theming = struct
  type t =
    [ `Legacy_don't_use_theme
    | `Themed
    ]
end

module Themed = struct
  type t =
    { header_cell : Vdom.Attr.t
    ; header_row : Vdom.Attr.t
    ; header : Vdom.Attr.t
    ; cell : Vdom.Attr.t
    ; cell_focused : Vdom.Attr.t
    ; row : Vdom.Attr.t
    ; row_focused : Vdom.Attr.t
    ; body : Vdom.Attr.t
    ; table : Vdom.Attr.t
    }

  module Legacy_style =
  [%css
  stylesheet {|
  .header_cell {
    text-align: center;
    font-weight: bold;
  }|}]

  module Prt_view = Bonsai_web_ui_view.For_components.Prt

  let create theme = function
    | `Legacy_don't_use_theme ->
      { header_cell = Legacy_style.header_cell
      ; header_row = Vdom.Attr.empty
      ; header = Vdom.Attr.class_ "prt-table-header"
      ; cell = Vdom.Attr.class_ "prt-table-cell"
      ; cell_focused = Vdom.Attr.class_ "prt-table-cell-selected"
      ; row = Vdom.Attr.class_ "prt-table-row"
      ; row_focused = Vdom.Attr.class_ "prt-table-row-selected"
      ; body = Vdom.Attr.empty
      ; table = Vdom.Attr.empty
      }
    | `Themed ->
      let styling = Prt_view.styling theme in
      { header_cell = styling.header_cell
      ; header_row = styling.header_row
      ; header = styling.header
      ; cell = styling.cell
      ; cell_focused = styling.cell_focused
      ; row = styling.row
      ; row_focused = styling.row_focused
      ; body = styling.body
      ; table = styling.table
      }
  ;;
end

(* These styles make the table functional and interactive;
   they are applied regardless of theme. *)
module Functional_style =
[%css
stylesheet
  {|

/* The default value for the [overflow-anchor] CSS property is [auto], which
   permits the browser to scroll the page in order to minimize content shifts.
   This interacts poorly with the PRT because our virtual-dom diff-and-patch
   algorithm often removes and re-inserts elements. To fix this, we disable
   overflow-anchor for all elements that contain a partial render table. */
:has(.partial_render_table_container) {
  overflow-anchor: none;
}

.partial_render_table_container {
  width: max-content;
  position: relative;
}

.partial_render_table_container * {
  box-sizing: border-box;
}

.partial_render_table_body {
  position: relative;
}

.sortable_header_cell {
  white-space: pre;
  cursor: pointer;
}

.header_label {
  user-select: none;
}

.leaf_header {
  resize: horizontal;
  overflow: hidden;
  box-sizing: border-box;
  padding-right:10px; /* Space for the resizer */
}

.partial_render_table_header {
  position: sticky;
  top: 0px;
  z-index: 99;
  border-collapse: collapse;
}

.row {
  contain: strict;
}

.cell {
  overflow:hidden;
  display:inline-block;
  contain: strict;
}
|}]

(* This function takes a vdom node and if it's an element, it adds extra attrs, classes, key,
   and style info to it, but if it's not an element, it wraps that node in a div that has those
   attributes.  This can be useful if you get a vdom node from the
   user of this API, and want to avoid excessive node wrapping. *)
let set_or_wrap ~attrs =
  let open Vdom.Node in
  function
  | Element e -> Element (Element.map_attrs e ~f:(fun a -> Vdom.Attr.(a @ many attrs)))
  | other -> div ~attrs [ other ]
;;

let int_to_px_string px = Int.to_string px ^ "px"
let float_to_px_string px = Virtual_dom.Dom_float.to_string_fixed 8 px ^ "px"

module Header_label = struct
  let wrap_clickable ~sortable ~handle_click contents =
    let attrs =
      if sortable then [ Functional_style.sortable_header_cell; handle_click ] else []
    in
    Vdom.Node.div ~attrs [ contents ]
  ;;

  (* As an externally exposed component with no prior style overrides,
     we don't allow opting out of theming to keep user code simpler. *)
  let wrap_with_icon
    ?(sort_indicator_attrs = [])
    (label : Vdom.Node.t)
    (sort_state : Bonsai_web_ui_partial_render_table_protocol.Sort_state.t)
    =
    match sort_state with
    | Not_sortable -> Vdom.Node.div [ Vdom.Node.span [ label ] ]
    | _ ->
      let get_arrow = function
        | `Asc -> "▲"
        | `Desc -> "▼"
      in
      let sort_indicator =
        let%map.Option indicator =
          match sort_state with
          | Not_sortable | Not_sorted -> None
          | Single_sort dir -> Some (get_arrow dir)
          | Multi_sort { dir; index } -> Some [%string "%{get_arrow dir} %{index#Int}"]
        in
        Vdom.Node.span ~attrs:sort_indicator_attrs [ Vdom.Node.text indicator ]
      in
      Vdom.Node.div
        ~attrs:
          [ Vdom.Attr.style
              (Css_gen.flex_container ~column_gap:(`Px 6) ~align_items:`Baseline ())
          ]
        [ Vdom.Node.span [ label ]
        ; sort_indicator |> Option.value ~default:Vdom.Node.none
        ]
  ;;
end

module Header = struct
  let attr_colspan i =
    match i with
    | 0 -> Vdom.Attr.style (Css_gen.display `None)
    | 1 -> Vdom.Attr.empty
    | i -> Vdom.Attr.create_float "colspan" (Int.to_float i)
  ;;

  module Header_cell = struct
    type t = Vdom.Node.t

    let leaf_view
      (themed_attrs : Themed.t)
      ~column_width
      ~set_column_width
      ~visible
      ~label
      ()
      =
      Vdom.Node.td
        ~attrs:
          [ themed_attrs.header_cell
          ; Bonsai_web_ui_element_size_hooks.Size_tracker.on_change
              (fun ~width ~height:_ -> set_column_width (`Px_float width))
          ; Vdom.Attr.colspan 1
          ; Functional_style.header_label
          ; Functional_style.leaf_header
          ; Vdom.Attr.style
              Css_gen.(width column_width @> if visible then empty else display `None)
          ]
        [ label ]
    ;;

    let spacer_view (themed_attrs : Themed.t) ~colspan () =
      Vdom.Node.td ~attrs:[ themed_attrs.header_cell; attr_colspan colspan ] []
    ;;

    let group_view (themed_attrs : Themed.t) ~colspan ~label () =
      Vdom.Node.td
        ~attrs:
          [ themed_attrs.header_cell
          ; attr_colspan colspan
          ; Functional_style.header_label
          ]
        [ label ]
    ;;
  end

  module Header_row = struct
    type t = Vdom.Node.t

    let view (themed_attrs : Themed.t) contents =
      Vdom.Node.tr ~attrs:[ themed_attrs.header_row ] contents
    ;;
  end

  type t = Vdom.Node.t

  (* Fun fact: the header is the only part of partial_render_table that is displayed
     as an actual HTML table! *)
  let view (themed_attrs : Themed.t) ~set_header_client_rect header_rows =
    Vdom.Node.table
      ~attrs:
        [ themed_attrs.header
        ; Bonsai_web_ui_element_size_hooks.Visibility_tracker.detect
            ()
            ~client_rect_changed:set_header_client_rect
        ; Functional_style.partial_render_table_header
        ]
      [ Vdom.Node.tbody header_rows ]
  ;;
end

module Cell = struct
  module Col_styles = struct
    type t = Vdom.Attr.t list

    (* Css_gen is really slow, so we need to re-use the results of all these functions
       whenever possible.  The difference between non-cached and cached css is the
       difference between 200ms stabilizations and 0.2ms stabiliations while scrolling.

       The reason that Css_gen is so slow is because apparently "sprintf" is _really_
       slow. *)
    let create
      (type column_id cmp)
      (module Col_cmp : Bonsai.Comparator
        with type t = column_id
         and type comparator_witness = cmp)
      ~(themed_attrs : Themed.t)
      ~row_height
      ~(col_widths : (column_id, [< `Hidden of float | `Visible of float ], cmp) Map.t)
      ~(leaves : column_id Header_tree.leaf list)
      =
      let height_styles =
        let h = int_to_px_string row_height in
        Css_gen.(
          create ~field:"height" ~value:h
          @> create ~field:"min-height" ~value:h
          @> create ~field:"max-height" ~value:h)
      in
      let styles_by_column =
        List.map
          leaves
          ~f:
            (fun
              { visible = is_visible; column_id; leaf_header = _; initial_width = _ } ->
          let width_styles =
            (* We use the previous width even when hidden, so that the rendering engine has
                   less work to do if re-adding a column. Columns that are not currently visible
                   are hidden via `display: None`. *)
            let width =
              match Map.find col_widths column_id with
              | None -> 0.0
              | Some (`Hidden width) | Some (`Visible width) -> width
            in
            let w = float_to_px_string width in
            Css_gen.(
              create ~field:"width" ~value:w
              @> create ~field:"min-width" ~value:w
              @> create ~field:"max-width" ~value:w)
          in
          let visible_styles =
            match is_visible with
            | false -> Css_gen.display `None
            | true -> Css_gen.empty
          in
          ( column_id
          , [ Vdom.Attr.style Css_gen.(height_styles @> width_styles @> visible_styles)
            ; themed_attrs.cell
            ] ))
        |> Map.of_alist_exn (module Col_cmp)
      in
      Staged.stage (fun column -> Map.find_exn styles_by_column column)
    ;;
  end

  type t = Vdom.Node.t

  let view (themed_attrs : Themed.t) ~is_focused ~col_styles ~on_cell_click content =
    let focused_attr =
      if is_focused then themed_attrs.cell_focused else Vdom.Attr.empty
    in
    set_or_wrap
      content
      ~attrs:
        (col_styles
         @ [ Vdom.Attr.on_click (fun _ -> on_cell_click)
           ; focused_attr
           ; Functional_style.cell
           ])
  ;;
end

module Row = struct
  module Styles = struct
    type t = Css_gen.t

    let create ~row_height ~row_width =
      let h = int_to_px_string row_height in
      let w = float_to_px_string row_width in
      let open Css_gen in
      create ~field:"height" ~value:h
      @> create ~field:"width" ~value:w
      @> flex_container ()
    ;;
  end

  type t = Vdom.Node.t

  let view (themed_attrs : Themed.t) ~styles ~is_focused ~extra_attrs cells =
    let focused_attr = if is_focused then themed_attrs.row_focused else Vdom.Attr.empty in
    Vdom.Node.lazy_
      (lazy
        (Vdom.Node.div
           ~attrs:
             ([ themed_attrs.row
              ; Vdom.Attr.style styles
              ; focused_attr
              ; Functional_style.row
              ]
              @ extra_attrs)
           cells))
  ;;
end

module Body = struct
  type t = Vdom.Node.t

  let view_impl (themed_attrs : Themed.t) ~padding_top ~padding_bottom ~rows =
    let style =
      Vdom.Attr.style
        (Css_gen.concat
           [ Css_gen.padding_top (`Px padding_top)
           ; Css_gen.padding_bottom (`Px padding_bottom)
           ])
    in
    Vdom.Node.div
      ~attrs:[ themed_attrs.body; style ]
      [ Vdom_node_with_map_children.make ~tag:"div" rows ]
  ;;

  let view themed_attrs ~padding_top ~padding_bottom ~rows =
    Vdom.Node.lazy_ (lazy (view_impl themed_attrs ~padding_top ~padding_bottom ~rows))
  ;;
end

module Table = struct
  let view
    (themed_attrs : Themed.t)
    ~private_body_classname
    ~vis_change_attr
    ~total_height
    head
    body
    =
    let body_container =
      Vdom.Node.div
      (* If the number is large enough, it will use scientific notation for unknown reasons.
           However, the number is accurate, and scientific notation is in spec.
           https://developer.mozilla.org/en-US/docs/Web/CSS/number *)
        ~attrs:
          [ Vdom.Attr.(
              many
                [ Functional_style.partial_render_table_body
                ; class_ private_body_classname
                ; Vdom.Attr.style Css_gen.(height (`Px total_height))
                ; vis_change_attr
                ])
          ]
        [ body ]
    in
    Vdom.Node.div
      ~attrs:[ themed_attrs.table; Functional_style.partial_render_table_container ]
      [ head; body_container ]
  ;;
end