package bonsai

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

Source file bonsai_web_ui_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
open! Core
open! Import
module Constants = Constants
module Fg_bg = Constants.Fg_bg
module Intent = Constants.Intent
module Card_title_kind = Constants.Card_title_kind
module Font_style = Constants.Font_style
module Font_size = Constants.Font_size
module Table = Table
include Layout

let primary_colors ((module T) : Theme.t) = T.singleton#constants.primary
let extreme_colors ((module T) : Theme.t) = T.singleton#constants.extreme

let extreme_primary_border_color ((module T) : Theme.t) =
  T.singleton#constants.extreme_primary_border
;;

let intent_colors ((module T) : Theme.t) (intent : Intent.t) =
  let { Intent.info; success; warning; error } = T.singleton#constants.intent in
  match intent with
  | Info -> info
  | Success -> success
  | Warning -> warning
  | Error -> error
;;

let button
      ((module T) : Theme.t)
      ?(attrs = [])
      ?(disabled = false)
      ?intent
      ?tooltip
      ~on_click
      text
  =
  T.singleton#button ~attrs ~disabled ~intent ~tooltip ~on_click [ Vdom.Node.text text ]
;;

let button'
      ((module T) : Theme.t)
      ?(attrs = [])
      ?(disabled = false)
      ?intent
      ?tooltip
      ~on_click
      content
  =
  T.singleton#button ~attrs ~disabled ~intent ~tooltip ~on_click content
;;

let tabs
      ((module T) : Theme.t)
      ?(attrs = [])
      ?(per_tab_attr = fun _ ~is_active:_ -> Vdom.Attr.empty)
      ~equal
      ~on_change
      ~active
      tabs
  =
  T.singleton#tabs ~attrs ~per_tab_attr ~on_change ~equal ~active tabs
;;

module type Enum = sig
  type t [@@deriving enumerate, equal, sexp_of]
end

let tabs_enum
      (type a)
      ((module T) : Theme.t)
      ?(attrs = [])
      ?(per_tab_attr = fun _ ~is_active:_ -> Vdom.Attr.empty)
      ?tab_to_vdom
      (module A : Enum with type t = a)
      ~on_change
      ~active
  =
  let tab_to_vdom =
    Option.value tab_to_vdom ~default:(fun tab ->
      Vdom.Node.text (T.singleton#humanize_sexp (A.sexp_of_t tab)))
  in
  let tabs = List.map A.all ~f:(fun tab -> tab, tab_to_vdom tab) in
  T.singleton#tabs ~attrs ~per_tab_attr ~on_change ~equal:A.equal ~active tabs
;;

let devbar ((module T) : Theme.t) ?(attrs = []) ?(count = 100) ?intent text =
  T.singleton#devbar ~attrs ~count ~intent text
;;

let constants ((module T) : Theme.t) = T.singleton#constants
let text ?attrs s = Vdom.Node.span ?attrs [ Vdom.Node.text s ]
let textf ?attrs format = Printf.ksprintf (text ?attrs) format

let themed_text ((module T) : Theme.t) ?(attrs = []) ?intent ?style ?size text =
  T.singleton#themed_text ~attrs ~intent ~style ~size text
;;

let themed_textf theme ?attrs ?intent ?style ?size format =
  Printf.ksprintf (themed_text theme ?attrs ?intent ?style ?size) format
;;

module Tooltip_direction = Tooltip.Direction

let tooltip'
      ((module T) : Theme.t)
      ?(container_attr = Vdom.Attr.empty)
      ?(tooltip_attr = Vdom.Attr.empty)
      ?(direction = Tooltip.Direction.Top)
      ~tooltip
      tipped
  =
  T.singleton#tooltip ~container_attr ~tooltip_attr ~direction ~tipped ~tooltip
;;

let tooltip theme ?container_attr ?tooltip_attr ?direction ~tooltip tipped =
  let tipped = Vdom.Node.text tipped in
  let tooltip = Vdom.Node.text tooltip in
  tooltip' theme ?container_attr ?tooltip_attr ?direction ~tooltip tipped
;;

let card'
      ((module T) : Theme.t)
      ?(container_attr = Vdom.Attr.empty)
      ?(title_attr = Vdom.Attr.empty)
      ?(content_attr = Vdom.Attr.empty)
      ?intent
      ?(title = [])
      ?(title_kind = Card_title_kind.Prominent)
      ?(on_click = Effect.Ignore)
      content
  =
  T.singleton#card
    ~container_attr
    ~title_attr
    ~content_attr
    ~intent
    ~on_click
    ~title
    ~title_kind
    ~content
;;

let card
      theme
      ?container_attr
      ?title_attr
      ?content_attr
      ?intent
      ?title
      ?title_kind
      ?on_click
      content
  =
  card'
    theme
    ?container_attr
    ?title_attr
    ?content_attr
    ?intent
    ?title:(Option.map title ~f:(fun title -> [ Vdom.Node.text title ]))
    ?title_kind
    ?on_click
    [ Vdom.Node.text content ]
;;

module App = struct
  let top_attr ((module T) : Theme.t) = T.singleton#app_attr
end

let theme_dyn_var =
  Bonsai.Dynamic_scope.create ~name:"web-ui theme" ~fallback:Expert.default_theme ()
;;

let current_theme = Bonsai.Dynamic_scope.lookup theme_dyn_var

module For_components = struct
  module Codemirror = struct
    let theme ((module T) : Theme.t) = T.singleton#codemirror_theme
  end

  module Forms = struct
    let to_vdom ((module T) : Theme.t) ?on_submit ?(editable = `Yes_always) =
      T.singleton#form_to_vdom ?on_submit ~eval_context:(Form_context.default ~editable)
    ;;

    let to_vdom_plain ((module T) : Theme.t) ?(editable = `Yes_always) =
      Form.to_vdom_plain T.singleton ~eval_context:(Form_context.default ~editable)
    ;;

    let view_error ((module T) : Theme.t) = T.singleton#form_view_error

    let append_item ((module T) : Theme.t) ?(editable = `Yes_always) =
      T.singleton#form_append_item ~eval_context:(Form_context.default ~editable)
    ;;

    let remove_item ((module T) : Theme.t) ?(editable = `Yes_always) =
      T.singleton#form_remove_item ~eval_context:(Form_context.default ~editable)
    ;;
  end
end

module Expert = struct
  open Bonsai.Let_syntax
  include Expert

  let set_theme_for_computation theme inside =
    Bonsai.Dynamic_scope.set theme_dyn_var theme ~inside
  ;;

  let override_theme_for_computation ~f inside =
    let%sub current_theme = current_theme in
    let%sub new_theme =
      let%arr current_theme = current_theme in
      override_theme current_theme ~f
    in
    set_theme_for_computation new_theme inside
  ;;

  let override_constants = Theme.override_constants

  module For_codemirror = For_codemirror
  module Form_context = Form_context
end

module Theme = struct
  open Bonsai.Let_syntax

  type t = Theme.t

  let name = Theme.name
  let current = current_theme
  let set_for_computation theme inside = Expert.set_theme_for_computation theme inside

  let rec with_attr attrs (vdom : Vdom.Node.t) =
    match vdom with
    | None -> Vdom.Node.div ~attrs []
    | Text _ -> Vdom.Node.span ~attrs [ vdom ]
    | Element e ->
      Element
        (Vdom.Node.Element.map_attrs e ~f:(fun xs -> Vdom.Attr.many (attrs @ [ xs ])))
    | Widget _ -> Vdom.Node.div ~attrs [ vdom ]
    | Lazy { key; t } -> Lazy { key; t = Lazy.map t ~f:(with_attr attrs) }
  ;;

  let set_for_app theme app =
    let%sub app_vdom = set_for_computation theme app in
    let%arr app_vdom = app_vdom
    and theme = theme in
    with_attr [ App.top_attr theme ] app_vdom
  ;;

  let set_for_app' theme app =
    let%sub result_and_vdom = set_for_computation theme app in
    let%arr result, app_vdom = result_and_vdom
    and theme = theme in
    result, with_attr [ App.top_attr theme ] app_vdom
  ;;

  let override_constants_for_computation ~f inside =
    let%sub current_theme = current_theme in
    let%sub new_theme =
      let%arr current_theme = current_theme in
      Theme.override_constants current_theme ~f
    in
    Expert.set_theme_for_computation new_theme inside
  ;;
end

module Raw = struct
  module Table = Table.Raw
end
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct