Source file tab.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
(** tab-size utilities *)

module Css = Cascade.Css

module Handler = struct
  open Style

  type t = Tab of int | Tab_arbitrary of string * Css.tab_size
  type Utility.base += Self of t

  let name = "tab"
  let priority _ = 2
  let suborder = function Tab n -> n | Tab_arbitrary _ -> 1000

  let to_class = function
    | Tab n -> "tab-" ^ string_of_int n
    | Tab_arbitrary (raw, _) -> "tab-" ^ raw

  let to_style _theme = function
    | Tab n -> style [ Css.tab_size n ]
    | Tab_arbitrary (_, v) -> style [ Css.tab_size_value v ]

  (* [tab-[3]] is a bare number, [tab-[12px]] a length. *)
  let parse_arbitrary raw : Css.tab_size option =
    if
      String.length raw > 2
      && raw.[0] = '['
      && raw.[String.length raw - 1] = ']'
    then
      let inner = String.sub raw 1 (String.length raw - 2) in
      match int_of_string_opt inner with
      | Some n -> Some (Int n : Css.tab_size)
      | None -> (
          match Css.parse_length inner with
          | Some l -> Some (Length l : Css.tab_size)
          | None -> None)
    else None

  let of_class _theme class_name =
    match Parse.split_class class_name with
    | [ "tab"; n ] -> (
        match int_of_string_opt n with
        | Some i -> Ok (Tab i)
        | None -> (
            match parse_arbitrary n with
            | Some v -> Ok (Tab_arbitrary (n, v))
            | None -> Error (`Msg "Not a tab utility")))
    | _ -> Error (`Msg "Not a tab utility")
end

open Handler

let () = Utility.register (module Handler)
let utility x = Utility.base (Self x)
let tab n = utility (Tab n)