Tailwind classes in OCaml
1open Htmlit
2
3type input_type =
4 | Text
5 | Email
6 | Password
7 | Number
8 | Tel
9 | Url
10 | Search
11 | Date
12 | Time
13 | Datetime_local
14
15type validation_state =
16 | Valid
17 | Invalid
18 | Warning
19
20type field_type =
21 | Input of input_type
22 | Textarea
23 | Select of (string * string) list (* value, label pairs *)
24 | Checkbox
25 | Radio of string (* value *)
26 | Switch
27
28type t = {
29 field_type: field_type;
30 label: string option;
31 placeholder: string option;
32 value: string option;
33 name: string option;
34 id: string option;
35 rows: int option; (* for textarea *)
36 required: bool;
37 disabled: bool;
38 readonly: bool;
39 checked: bool; (* for checkbox/radio/switch *)
40 validation: validation_state option;
41 helper_text: string option;
42 error_text: string option;
43 classes: Tailwind.t option;
44 attributes: (string * string) list;
45}
46
47let classes_attr tailwind_classes =
48 At.class' (Tailwind.to_string tailwind_classes)
49
50let base_input_classes = Tailwind.Css.tw [
51 Tailwind.Display.flex;
52 Tailwind.Layout.(to_class (height (Tailwind.Size.rem 2.5)));
53 Tailwind.Layout.w_full;
54 Tailwind.Effects.rounded_md;
55 Tailwind.Effects.border;
56 Tailwind.Color.border (Tailwind.Color.make `Gray ~variant:`V300 ());
57 Tailwind.Color.bg Tailwind.Color.white;
58 Tailwind.Spacing.(to_class (px (Tailwind.Size.rem 0.75)));
59 Tailwind.Spacing.(to_class (py (Tailwind.Size.rem 0.5)));
60 Tailwind.Typography.(to_class (font_size `Sm));
61]
62
63let validation_classes = function
64 | Some Valid -> Tailwind.Css.tw [
65 Tailwind.Color.border (Tailwind.Color.make `Green ~variant:`V500 ());
66 Tailwind.Variants.focus (Tailwind.Color.border (Tailwind.Color.make `Green ~variant:`V600 ()));
67 ]
68 | Some Invalid -> Tailwind.Css.tw [
69 Tailwind.Color.border (Tailwind.Color.make `Red ~variant:`V500 ());
70 Tailwind.Variants.focus (Tailwind.Color.border (Tailwind.Color.make `Red ~variant:`V600 ()));
71 ]
72 | Some Warning -> Tailwind.Css.tw [
73 Tailwind.Color.border (Tailwind.Color.make `Yellow ~variant:`V500 ());
74 Tailwind.Variants.focus (Tailwind.Color.border (Tailwind.Color.make `Yellow ~variant:`V600 ()));
75 ]
76 | None -> Tailwind.Css.empty
77
78let input ?input_type ?label ?placeholder ?value ?name ?id ?required ?disabled ?readonly ?validation ?helper_text ?error_text ?classes ?attributes () = {
79 field_type = Input (match input_type with Some t -> t | None -> Text);
80 label;
81 placeholder;
82 value;
83 name;
84 id;
85 rows = None;
86 required = (match required with Some r -> r | None -> false);
87 disabled = (match disabled with Some d -> d | None -> false);
88 readonly = (match readonly with Some r -> r | None -> false);
89 checked = false;
90 validation;
91 helper_text;
92 error_text;
93 classes;
94 attributes = (match attributes with Some a -> a | None -> []);
95}
96
97let textarea ?label ?placeholder ?value ?name ?id ?rows ?required ?disabled ?readonly ?validation ?helper_text ?error_text ?classes ?attributes () = {
98 field_type = Textarea;
99 label;
100 placeholder;
101 value;
102 name;
103 id;
104 rows;
105 required = (match required with Some r -> r | None -> false);
106 disabled = (match disabled with Some d -> d | None -> false);
107 readonly = (match readonly with Some r -> r | None -> false);
108 checked = false;
109 validation;
110 helper_text;
111 error_text;
112 classes;
113 attributes = (match attributes with Some a -> a | None -> []);
114}
115
116let select ?label ?name ?id ?required ?disabled ?validation ?helper_text ?error_text ?classes ?attributes ~options () = {
117 field_type = Select options;
118 label;
119 placeholder = None;
120 value = None;
121 name;
122 id;
123 rows = None;
124 required = (match required with Some r -> r | None -> false);
125 disabled = (match disabled with Some d -> d | None -> false);
126 readonly = false;
127 checked = false;
128 validation;
129 helper_text;
130 error_text;
131 classes;
132 attributes = (match attributes with Some a -> a | None -> []);
133}
134
135let checkbox ?label ?name ?id ?checked ?disabled ?classes ?attributes () = {
136 field_type = Checkbox;
137 label;
138 placeholder = None;
139 value = None;
140 name;
141 id;
142 rows = None;
143 required = false;
144 disabled = (match disabled with Some d -> d | None -> false);
145 readonly = false;
146 checked = (match checked with Some c -> c | None -> false);
147 validation = None;
148 helper_text = None;
149 error_text = None;
150 classes;
151 attributes = (match attributes with Some a -> a | None -> []);
152}
153
154let radio ?label ?name ?id ?value ?checked ?disabled ?classes ?attributes () = {
155 field_type = Radio (match value with Some v -> v | None -> "");
156 label;
157 placeholder = None;
158 value;
159 name;
160 id;
161 rows = None;
162 required = false;
163 disabled = (match disabled with Some d -> d | None -> false);
164 readonly = false;
165 checked = (match checked with Some c -> c | None -> false);
166 validation = None;
167 helper_text = None;
168 error_text = None;
169 classes;
170 attributes = (match attributes with Some a -> a | None -> []);
171}
172
173let switch ?label ?name ?id ?checked ?disabled ?classes ?attributes () = {
174 field_type = Switch;
175 label;
176 placeholder = None;
177 value = None;
178 name;
179 id;
180 rows = None;
181 required = false;
182 disabled = (match disabled with Some d -> d | None -> false);
183 readonly = false;
184 checked = (match checked with Some c -> c | None -> false);
185 validation = None;
186 helper_text = None;
187 error_text = None;
188 classes;
189 attributes = (match attributes with Some a -> a | None -> []);
190}
191
192let input_type_to_string = function
193 | Text -> "text"
194 | Email -> "email"
195 | Password -> "password"
196 | Number -> "number"
197 | Tel -> "tel"
198 | Url -> "url"
199 | Search -> "search"
200 | Date -> "date"
201 | Time -> "time"
202 | Datetime_local -> "datetime-local"
203
204let to_html field =
205 let field_classes = Tailwind.Css.tw [
206 base_input_classes;
207 validation_classes field.validation;
208 (match field.classes with Some c -> c | None -> Tailwind.Css.empty);
209 ] in
210
211 let base_attrs = [classes_attr field_classes] in
212 let optional_attrs = List.filter_map (fun x -> x) [
213 Option.map At.placeholder field.placeholder;
214 Option.map At.value field.value;
215 Option.map At.name field.name;
216 Option.map At.id field.id;
217 (if field.required then Some At.required else None);
218 (if field.disabled then Some At.disabled else None);
219 (if field.readonly then Some (At.v "readonly" "readonly") else None);
220 (if field.checked then Some At.checked else None);
221 ] in
222 let custom_attrs = List.map (fun (k, v) -> At.v k v) field.attributes in
223 let all_attrs = base_attrs @ optional_attrs @ custom_attrs in
224
225 let input_element = match field.field_type with
226 | Input input_type ->
227 El.input ~at:(At.type' (input_type_to_string input_type) :: all_attrs) ()
228 | Textarea ->
229 let textarea_attrs = match field.rows with
230 | Some r -> At.rows r :: all_attrs
231 | None -> all_attrs
232 in
233 El.textarea ~at:textarea_attrs []
234 | Select options ->
235 let option_elements = List.map (fun (value, label) ->
236 El.option ~at:[At.value value] [El.txt label]
237 ) options in
238 El.select ~at:all_attrs option_elements
239 | Checkbox ->
240 El.input ~at:(At.type' "checkbox" :: all_attrs) ()
241 | Radio value ->
242 El.input ~at:(At.type' "radio" :: At.value value :: all_attrs) ()
243 | Switch ->
244 (* Switch is implemented as a styled checkbox *)
245 El.input ~at:(At.type' "checkbox" :: all_attrs) ()
246 in
247
248 let label_element = match field.label with
249 | Some label_text ->
250 El.label [
251 El.txt label_text;
252 input_element;
253 ]
254 | None -> input_element
255 in
256
257 (* Add helper and error text if provided *)
258 let help_elements = List.filter_map (fun x -> x) [
259 Option.map (fun text ->
260 El.p ~at:[classes_attr (Tailwind.Css.tw [
261 Tailwind.Typography.(to_class (font_size `Sm));
262 Tailwind.Color.text (Tailwind.Color.make `Gray ~variant:`V600 ());
263 Tailwind.Spacing.(to_class (mt (Tailwind.Size.rem 0.25)));
264 ])] [El.txt text]
265 ) field.helper_text;
266 Option.map (fun text ->
267 El.p ~at:[classes_attr (Tailwind.Css.tw [
268 Tailwind.Typography.(to_class (font_size `Sm));
269 Tailwind.Color.text (Tailwind.Color.make `Red ~variant:`V600 ());
270 Tailwind.Spacing.(to_class (mt (Tailwind.Size.rem 0.25)));
271 ])] [El.txt text]
272 ) field.error_text;
273 ] in
274
275 (* Wrap everything in a container *)
276 match help_elements with
277 | [] -> label_element
278 | _ -> El.div ([label_element] @ help_elements)
279
280let group ?classes ~fields () =
281 let group_classes = Tailwind.Css.tw [
282 Tailwind.Display.grid;
283 Tailwind.Layout.w_full;
284 Tailwind.Spacing.(to_class (gap `All (Tailwind.Size.rem 1.0)));
285 (match classes with Some c -> c | None -> Tailwind.Css.empty);
286 ] in
287
288 let field_elements = List.map to_html fields in
289 El.div ~at:[classes_attr group_classes] field_elements
290
291let form ?action ?method_ ?classes ?attributes ~fields ?submit () =
292 let form_classes = Tailwind.Css.tw [
293 Tailwind.Display.grid;
294 Tailwind.Layout.w_full;
295 Tailwind.Spacing.(to_class (gap `All (Tailwind.Size.rem 1.5)));
296 (match classes with Some c -> c | None -> Tailwind.Css.empty);
297 ] in
298
299 let base_attrs = [classes_attr form_classes] in
300 let optional_attrs = List.filter_map (fun x -> x) [
301 Option.map At.action action;
302 (match method_ with
303 | Some `Get -> Some (At.method' "get")
304 | Some `Post -> Some (At.method' "post")
305 | None -> None);
306 ] in
307 let custom_attrs = match attributes with
308 | Some attrs -> List.map (fun (k, v) -> At.v k v) attrs
309 | None -> []
310 in
311 let all_attrs = base_attrs @ optional_attrs @ custom_attrs in
312
313 let field_elements = List.map to_html fields in
314 let submit_element = match submit with
315 | Some btn -> [Button.to_html btn]
316 | None -> []
317 in
318
319 El.form ~at:all_attrs (field_elements @ submit_element)