Source file t.ml

(*********************************************************************************)
(*                OCaml-CSS                                                      *)
(*                                                                               *)
(*    Copyright (C) 2023-2024 INRIA All rights reserved.                         *)
(*    Author: Maxence Guesdon, INRIA Saclay                                      *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU General Public License as                    *)
(*    published by the Free Software Foundation, version 3 of the License.       *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the               *)
(*    GNU General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public                  *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    As a special exception, you have permission to link this program           *)
(*    with the OCaml compiler and distribute executables, as long as you         *)
(*    follow the requirements of the GNU GPL in regard to all of the             *)
(*    software in the executable aside from the OCaml compiler.                  *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

(** Types and base definitions. *)

(** {2 Utils} *)

(** Maps of strings. *)
module Smap = Map.Make(String)

(** String sets. *)
module Sset = Set.Make(String)

(** Maps over integers. *)
module Imap = Map.Make(Int)

(** [mk_pp f] creates a [formatter -> x -> unit] function from
  the given [x -> string] function. *)
let mk_pp f = fun ppf x -> Format.pp_print_string ppf (f x)

(** [string_of_list sep to_string l] is [String.concat sep (List.map to_string l)].*)
let string_of_list sep to_string l = String.concat sep (List.map to_string l)

(** [mk_of_string to_string l] returns a function mapping strings to values,
  according to the reverse function [to_string].
  Optional argument [case_sensitive] (default is [true]) indicates where
  case is taken into account when mapping from string to values.
  The returned function returns [None] if the given string could not
  be mapped to a value, else [Some value].
*)
let mk_of_string ?(case_sensitive=true) to_string l =
  let f = if case_sensitive then fun x -> x else String.lowercase_ascii in
  let l = List.map (fun x -> (f (to_string x), x)) l in
  fun str ->
    let str = if not case_sensitive then f str else str in
    List.assoc_opt str l

(** {2 Positions and locations} *)

type pos = Lexing.position
type loc = pos * pos
type 'a with_loc = 'a * loc
type 'a with_loc_option = 'a * loc option

let dummy_loc = Lexing.dummy_pos, Lexing.dummy_pos

let string_of_loc (loc_start, loc_end) =
  Rdf.Loc.(string_of_loc { loc_start ; loc_end })
let string_of_loc_option = function
  | None -> ""
  | Some loc -> string_of_loc loc

let pp_loc ppf (loc_start, loc_end) = Rdf.Loc.(pp ppf { loc_start ; loc_end })
let pp_loc_option ppf = function
| None -> ()
| Some loc -> pp_loc ppf loc

(** [pos_of_string_at str at] returns the {!type-pos} corresponding
   to offset [at] in the given string.
  Optional arguments:
  {ul
   {- [fname] specifies a filename to use in the returned position.}
   {- [from], as a pair [(offset, p)], specifies to start at
      [offset], using [p] as initial {!type-pos} structure. The [fname]
      in returned position still is the optional [fname] argument.}
  }
*)
let pos_of_string_at =
  let rec iter str len at (l, bol, c) i =
    if i >= len || i = at then (l,bol,c)
    else
      match String.get str i with
      | '\n' -> iter str len at (l+1,i,c+1) (i+1)
      | _ -> iter str len at (l,bol,c+1) (i+1)
  in
  fun ?(fname="") ?from str at ->
    let len = String.length str in
    let (start,i) = match from with
      | None -> (1,0,0), 0
      | Some (n, p) -> (p.Lexing.pos_lnum, p.pos_bol, p.pos_cnum), n
    in
    let (pos_lnum, pos_bol, pos_cnum) = iter str len at start i in
    Lexing.{ pos_fname = fname ; pos_lnum ; pos_bol ; pos_cnum }

let loc_of_string_at str i =
  let pos = pos_of_string_at str i in
  (pos, pos)

(** {2 Error handling} *)


type block = [ `Par | `Bracket | `Brace ]
let block_of_char = function
| '(' | ')' -> `Par
| '[' | ']' -> `Bracket
| '{' | '}' -> `Brace
| _ -> assert false

let is_open_block_char = function '(' | '[' | '{' -> true | _ -> false
let is_close_block_char = function ')' | ']' | '}' -> true | _ -> false

(** Parsing errors. *)
type parse_error =
| Unterminated_string
| Unterminated_comment
| Unterminated_char_escape
| Invalid_iri of string * Iri.error
| Invalid_data of string * string
| Invalid_namespace of string
| Unmatched_block_closing of block
| Other of string

type error =
| Parse_error of pos option * parse_error
| Undefined_namespace of string * loc

exception Error of error

let string_of_parse_error = function
| Unterminated_string -> "Unterminated string"
| Unterminated_comment -> "Unterminated comment"
| Unterminated_char_escape -> "Unterminated char escape"
| Invalid_iri (s,e) -> Printf.sprintf "Invalid iri %S: %s" s (Iri.string_of_error e)
| Invalid_data (s,msg) -> Printf.sprintf "Invalid data %S: %s" s msg
| Invalid_namespace s -> Printf.sprintf "Invalid namespace %S" s
| Unmatched_block_closing b ->
    (
     let c = match b with `Par -> ')' | `Bracket -> ']' | `Brace -> '}' in
     Printf.sprintf "Unmatched block-closing character %c" c
    )
| Other s -> s

let string_of_error ?(to_loc=string_of_loc) = function
| Parse_error (None, e) -> string_of_parse_error e
| Parse_error (Some pos, e) ->
    Printf.sprintf "%s%s" (to_loc (pos, pos)) (string_of_parse_error e)
| Undefined_namespace (ns, loc) ->
    Printf.sprintf "%sundefined namespace %S" (to_loc loc) ns

let pp_error = mk_pp string_of_error

let () = Printexc.register_printer
  (function Error e -> Some (string_of_error ?to_loc:None e) | _ -> None)

let error e = raise (Error e)
let parse_error ?pos e = error (Parse_error (pos, e))

(** {2 Parsing contexts} *)

(** A context is used in parsers to retrieve location information.
  [get_pos] returns the current position. [last_pos] returns the
  most advanced position seen. [string_of_loc] returns the string
  corresponding to the given location. A context also stores information
  about open blocks (with '<', '\[' or '\{' characters).
*)
type ctx = {
    get_pos : pos Angstrom.t ;
    last_pos : pos Angstrom.t ;
    string_of_loc : loc -> string ;
    blocks : block list ;
  }

let ctx_open_block ctx b = { ctx with blocks = b :: ctx.blocks }

let ctx_close_block ctx b =
  match ctx.blocks with
  | h :: q when h = b -> { ctx with blocks = q }
  | _ ->
      ignore(Angstrom.(parse_string
        ~consume:Prefix
          (ctx.get_pos >>= fun pos -> parse_error ~pos (Unmatched_block_closing b))
          ""));
      ctx

let ctx_can_close_block ctx b =
  match ctx.blocks with [] -> false | h :: _ -> h = b

let ctx_toplevel ctx = List.is_empty ctx.blocks

(** [ctx get_pos] builds a new context with the given [get_pos]
  functions. *)
let ctx get_pos =
  let open Angstrom in
  let last_pos_ = ref None in
  let get_pos =
    pos >>| fun n ->
    let p = get_pos n in
    let () =
      match !last_pos_ with
      | Some (n0,_) when n0 < n -> last_pos_ := Some (n, p)
      | None -> last_pos_ := Some (n,p)
      | _ -> ()
    in
    p
  in
  let last_pos  =
    get_pos >>| fun _ ->
      match !last_pos_ with
      | None -> assert false
      | Some (n,p) -> p
  in
  {
    get_pos = get_pos ;
    string_of_loc = string_of_loc ;
    last_pos ;
    blocks = [] ;
  }

(** [string_ctx str] creates a context from the given string [str].
  Computing of {!type-pos} structure is cached.
  [fname] can be specified to set this field in positions.
*)
let string_ctx ?fname str =
  let get_pos =
    let map = ref Imap.empty in
    fun n ->
      match Imap.find_opt n !map with
      | Some pos -> pos
      | None ->
          match Imap.find_last_opt (fun p -> p <= n) !map with
          | Some (p,pos) when n = p -> pos
          | from ->
              let p = pos_of_string_at ?fname ?from str n in
              map := Imap.add n p !map;
              p
  in
  ctx get_pos

(** {2 Global keywords} *)

type global_kw = [ `Inherit | `Initial | `Revert | `Revert_layer | `Unset ]
let global_kws = [ `Inherit ; `Initial ; `Revert ; `Revert_layer ; `Unset ]

type var = [ `Var of string * string option ]
let string_of_var : var -> string = function
  | `Var (id, None) -> Printf.sprintf "var(%s)" id
  | `Var (id, Some s) -> Printf.sprintf "var(%s, %s)" id s
let pp_var = mk_pp string_of_var

type 'a or_var = [ var | `V of 'a ]
let string_of_or_var str_of = function
| (#var as v) -> string_of_var v
| `V v -> str_of v
let pp_or_var pp ppf = function
| (#var as v) -> pp_var ppf v
| `V v -> pp ppf v

(** A ['a p_value] is either a global keyword,
  a variable ([`Var (name, optional string value)]) or a value ([`V 'a]).
  We do not know at variable definition time in which property this
  variable will be used. The parser associated to a property will
  parse the optional default variable value when the variable is expanded.
*)
type 'a p_value = [ global_kw | 'a or_var ]

let string_of_p_value : ('a -> string) -> 'a p_value -> string =
  fun to_s -> function
    | (#global_kw as x) -> Kw.string_of_kw x
    | (#var as v) -> string_of_var v
    | `V x -> to_s x
let pp_p_value : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a p_value -> unit =
  fun pp fmt -> function
| (#global_kw as x) -> Format.pp_print_string fmt (Kw.string_of_kw x)
| (#var as v) -> pp_var fmt v
| `V x -> pp fmt x

(** Parsed strings, with a [quoted] flag indicating whether string is quoted. *)
type str = { s:string; quoted:bool }

let string_of_str { s ; quoted } =
  if quoted then
    Printf.sprintf "%S" s (* FIXME: use own way to escape utF8 strings *)
  else
    s

let pp_str = mk_pp string_of_str

(** {2 CSS Value types} *)

type side = [`Bottom | `Left | `Right | `Top ]
let sides = [`Bottom ; `Left ; `Right ; `Top ]
let string_of_side : side -> string = function
| `Bottom -> "bottom"
| `Left -> "left"
| `Right -> "right"
| `Top -> "top"

type lcr = [ `Left | `Center | `Right ]

type number = float
let string_of_number f = Format.asprintf "%g" f
let pp_number = mk_pp string_of_number

type ratio = number * number
let string_of_ratio (n1,n2) = Printf.sprintf "%s/%s" (string_of_number n1) (string_of_number n2)
let pp_ratio = mk_pp string_of_ratio

type rel_length_unit = [
  | `em (**	Font size of the element.*)
  | `ex (** x-height of the element's font. *)
  | `cap	(** Cap height (the nominal height of capital letters) of the element's font. *)
  | `ch (** 	Average character advance of a narrow glyph in the element's font, as represented by the "0" (ZERO, U+0030) glyph. *)
  | `ic (** Average character advance of a full width glyph in the element's font, as represented by the "水" (CJK water ideograph, U+6C34) glyph.*)
  | `rem (** Font size of the root element. *)
  | `lh (** Line height of the element. *)
  | `rlh (** Line height of the root element.*)
  | `vw (** 1% of viewport's width. *)
  | `vh (** 1% of viewport's height. *)
  | `vi (** 1% of viewport's size in the root element's inline axis. *)
  | `vb (** 1% of viewport's size in the root element's block axis. *)
  | `vmin (** 1% of viewport's smaller dimension. *)
  | `vmax (** 1% of viewport's larger dimension. *)
  | `cqw (** 1% of a query container's width *)
  | `cqh (** 1% of a query container's height *)
  | `cqi (** 1% of a query container's inline size *)
  | `cqb (** 1% of a query container's block size *)
  | `cqmin (** The smaller value of cqi or cqb *)
  | `cqmax (** The larger value of cqi or cqb *)
]
let rel_length_units = [
    `em ; `ex ; `cap ; `ch ; `ic ; `rem ;
    `lh ; `rlh ; `vw ; `vh ;`vi ; `vb ;
    `vmin ; `vmax ;
    `cqw ; `cqh ; `cqi ; `cqb ; `cqmin ; `cqmax ;
  ]

let string_of_rel_length_unit : rel_length_unit -> string = function
| `em -> "em"
| `ex -> "ex"
| `cap -> "cap"
| `ch -> "ch"
| `ic -> "ic"
| `rem -> "rem"
| `lh -> "lh"
| `rlh -> "rlh"
| `vw -> "vw"
| `vh -> "vh"
| `vi -> "vi"
| `vb -> "vb"
| `vmin -> "vmin"
| `vmax -> "vmax"
| `cqw -> "cqw"
| `cqh -> "cqh"
| `cqi -> "cqi"
| `cqb -> "cqb"
| `cqmin -> "cqmin"
| `cqmax -> "cqmax"

type abs_length_unit = [
  | `cm (** Centimeters 	1cm = 96px/2.54 *)
  | `mm (** Millimeters 	1mm = 1/10th of 1cm *)
  | `q (* Quarter-millimeters 	1Q = 1/40th of 1cm *)
  | `In (** Inches 	1in = 2.54cm = 96px *)
  | `pc (** Picas 	1pc = 1/6th of 1in *)
  | `pt (** Points 	1pt = 1/72th of 1in *)
  | `px (** Pixels 	1px = 1/96th of 1in *)
]

let abs_length_units = [ `cm ; `mm ; `q ; `In ; `pc ; `pt ; `px]

let string_of_abs_length_unit : abs_length_unit -> string = function
| `cm -> "cm"
| `mm -> "mm"
| `q -> "q"
| `In -> "in"
| `pc -> "pc"
| `pt -> "pt"
| `px -> "px"

type length_unit = [rel_length_unit | abs_length_unit]

let string_of_length_unit : length_unit -> string = function
| #rel_length_unit as x -> string_of_rel_length_unit x
| #abs_length_unit as x -> string_of_abs_length_unit x

let pp_length_unit = mk_pp string_of_length_unit

type angle_unit = [
  | `deg (** Degrees 	There are 360 degrees in a full circle. *)
  | `grad (** Gradians 	There are 400 gradians in a full circle. *)
  | `rad (** Radians 	There are 2__pi__ radians in a full circle. *)
  | `turn (** Turns 	There is 1 turn in a full circle. *)
]
let angle_units = [ `deg ; `grad ; `rad ; `turn ]

let string_of_angle_unit : angle_unit -> string = function
| `deg -> "deg"
| `grad -> "grad"
| `rad -> "rad"
| `turn -> "turn"
let pp_angle_unit = mk_pp string_of_angle_unit

type angle = number * angle_unit
let string_of_angle (n,u) =
  Printf.sprintf "%s%s" (string_of_number n) (string_of_angle_unit u)
let pp_angle = mk_pp string_of_angle

type time_unit = [ `s | `ms ]
let time_units = [ `s ; `ms ]
let string_of_time_unit : time_unit -> string = function
| `s -> "s"
| `ms -> "ms"
let pp_time_unit = mk_pp string_of_time_unit

type freq_unit = [ `hz | `khz ]
let freq_units = [ `hz ; `khz ]
let string_of_freq_unit : freq_unit -> string = function
| `hz -> "hz"
| `khz -> "khz"
let pp_freq_unit = mk_pp string_of_freq_unit

type flex_unit = [ `fr ]
let flex_units = [ `fr ]
let string_of_flex_unit : flex_unit -> string = function
| `fr -> "fr"
let pp_flex_unit = mk_pp string_of_flex_unit

type resolution_unit = [
  | `dpi (** Dots per inch. *)
  | `dpcm (** Dots per centimeter. *)
  | `dppx
  | `x (** Dots per px unit. *)
]
let resolution_units = [ `dpi ; `dpcm ; `dppx ; `x ]
let string_of_resolution_unit : resolution_unit -> string = function
| `dpi -> "dpi"
| `dpcm -> "dpcm"
| `dppx -> "dppx"
| `x -> "x"
let pp_resolution_unit = mk_pp string_of_resolution_unit

type dim_unit = [
  | length_unit
  | angle_unit
  | time_unit
  | freq_unit
  | flex_unit
  | resolution_unit
  ]

let string_of_dim_unit : dim_unit -> string = function
| #length_unit as x -> string_of_length_unit x
| #angle_unit as x -> string_of_angle_unit x
| #time_unit as x -> string_of_time_unit x
| #freq_unit as x -> string_of_freq_unit x
| #flex_unit as x -> string_of_flex_unit x
| #resolution_unit as x -> string_of_resolution_unit x

let pp_dim_unit ppf u = Format.pp_print_string ppf (string_of_dim_unit u)

type dimension = number * dim_unit

let string_of_dimension n u =
  Printf.sprintf "%s%s" (string_of_number n) (string_of_dim_unit u)

type system_color = [
| `AccentColorText
| `ActiveText
| `ButtonBorder
| `ButtonFace
| `ButtonText
| `Canvas
| `CanvasText
| `Field
| `FieldText
| `GrayText
| `Highlight
| `HighlightText
| `LinkText
| `Mark
| `MarkText
| `SelectedItem
| `SelectedItemText
| `VisitedText
]
let system_colors = [
    `AccentColorText ; `ActiveText ; `ButtonBorder ; `ButtonFace ; `ButtonText ;
    `Canvas ; `CanvasText ; `Field ; `FieldText ; `GrayText ;
    `Highlight ; `HighlightText ; `LinkText ; `Mark ; `MarkText ;
    `SelectedItem ; `SelectedItemText ; `VisitedText ;
  ]
let string_of_system_color : system_color -> string = function
| `AccentColorText -> "AccentColorText"
| `ActiveText -> "ActiveText"
| `ButtonBorder -> "ButtonBorder"
| `ButtonFace -> "ButtonFace"
| `ButtonText -> "ButtonText"
| `Canvas -> "Canvas"
| `CanvasText -> "CanvasText"
| `Field -> "Field"
| `FieldText -> "FieldText"
| `GrayText -> "GrayText"
| `Highlight -> "Highlight"
| `HighlightText -> "HighlightText"
| `LinkText -> "LinkText"
| `Mark -> "Mark"
| `MarkText -> "MarkText"
| `SelectedItem -> "SelectedItem"
| `SelectedItemText -> "SelectedItemText"
| `VisitedText -> "VisitedText"
let pp_system_color = mk_pp string_of_system_color

let system_color_of_string =
  mk_of_string ~case_sensitive:false string_of_system_color system_colors

type color_kw = [ `Current_color | `Transparent ]
let color_kws : color_kw list = [ `Current_color ; `Transparent ]

type color = [
| `Rgba of float * float * float * float (* all between 0. and 1. *)
| `Named_color of string
| `System_color of system_color
| color_kw ]

let string_of_color : color -> string = function
| #color_kw as x -> Kw.string_of_kw x
| `Rgba (r,g,b,a) ->
    let fc n = max 0. (min 255. (n *. 255.)) in
    Printf.sprintf "rgb(%g %g %g%s)"
      (fc r) (fc g) (fc b)
        (if a < 1. then Printf.sprintf " / %g" a else "")
| `Named_color s -> s
| `System_color sc -> string_of_system_color sc

let pp_color = mk_pp string_of_color

type trblc = [`Top | `Right | `Bottom | `Left | `Center ]
let trblc_kws : trblc list = [`Top ; `Right ; `Bottom ; `Left ; `Center ]
let string_of_trblc : [<trblc] -> string = Kw.string_of_kw
type x_position_kw = [`Left | `Center | `Right]
let x_position_kws = [`Left ; `Center ; `Right]
let string_of_x_position_kw (k:x_position_kw) = string_of_trblc (k:>trblc)

type y_position_kw = [`Top | `Center | `Bottom]
let y_position_kws = [`Top ; `Center ; `Bottom]
let string_of_y_position_kw (k:y_position_kw) = string_of_trblc (k:>trblc)

type length = number * length_unit
let string_of_length ((n,u) : length) =
  string_of_dimension n (u :> dim_unit)
let pp_length ppf x = Format.pp_print_string ppf (string_of_length x)

type percentage = [`Percent of number]
let string_of_percentage : percentage -> string = function
| `Percent n -> Printf.sprintf "%s%%" (string_of_number n)
type length_percentage = [`Length of number * length_unit | percentage]

let string_of_length_percentage : length_percentage -> string = function
| #percentage as x -> string_of_percentage x
| `Length x -> string_of_length x
let pp_length_percentage = mk_pp string_of_length_percentage

type 'a axis_pos =
| Offset of length_percentage
| Kw of 'a
| KO of 'a * length_percentage

let string_of_axis_pos = function
| Offset lp -> string_of_length_percentage lp
| Kw k -> string_of_trblc k
| KO (k,o) ->
    Printf.sprintf "%s %s"
      (string_of_trblc k) (string_of_length_percentage o)

type axis_position =
| Single_kw of trblc
| XY of x_position_kw axis_pos * y_position_kw axis_pos

type x_position = x_position_kw axis_pos
type y_position = y_position_kw axis_pos

let string_of_x_position : x_position -> string = string_of_axis_pos
let string_of_y_position : y_position -> string = string_of_axis_pos

let string_of_axis_position = function
| Single_kw k -> string_of_trblc k
| XY (x,y) -> Printf.sprintf "%s %s"
    (string_of_axis_pos x) (string_of_axis_pos y)

let pp_axis_position ppf (p:axis_position) =
  Format.pp_print_string ppf (string_of_axis_position p)

let string_of_p_number = string_of_p_value string_of_number

type size_kw = [ `Auto | `Max_content | `Min_content ]
let size_kws : size_kw list = [ `Auto ; `Max_content ; `Min_content ]
type size = [ length_percentage |  `Fit_content of length_percentage | size_kw ]
let string_of_size : size -> string = function
| #length_percentage as x -> string_of_length_percentage x
| #size_kw as x -> Kw.string_of_kw x
| `Fit_content lp -> Printf.sprintf "fit-content(%s)" (string_of_length_percentage lp)
let pp_size = mk_pp string_of_size

type max_size_kw = [ `None | `Max_content | `Min_content ]
let max_size_kws : max_size_kw list = [ `None ; `Max_content ; `Min_content ]
type max_size = [ length_percentage |  `Fit_content of length_percentage | max_size_kw ]
let string_of_max_size : max_size -> string = function
| #length_percentage as x -> string_of_length_percentage x
| #max_size_kw as x -> Kw.string_of_kw x
| `Fit_content lp -> Printf.sprintf "fit-content(%s)" (string_of_length_percentage lp)
let pp_max_size = mk_pp string_of_max_size

type line_style = [
  | `None | `Hidden | `Dotted | `Dashed | `Solid
  | `Double | `Groove | `Ridge | `Inset | `Outset
]
let line_styles : line_style list =  [ `None ; `Hidden ; `Dotted ; `Dashed ; `Solid ;
    `Double ; `Groove ; `Ridge ; `Inset ; `Outset ]
let string_of_line_style : line_style -> string = Kw.string_of_kw
let pp_line_style = mk_pp string_of_line_style

type gradient = [
| `Linear
| `Repeating_linear
| `Radial
| `Repeating_radial
]
let string_of_gradient : gradient -> string = function
| `Linear -> "linear-gradient"
| `Repeating_linear -> "repeating-linear-gradient"
| `Radial -> "radial-gradient"
| `Repeating_radial -> "repeating-radial-gradient"
let pp_gradient = mk_pp string_of_gradient

type url_data = {
    mime: string ;
    charset: string option ;
    encoding: string option ;
    data: string ;
}
let string_of_url_data d =
  Printf.sprintf "%s%s%s,%s" d.mime
    (match d.charset with None -> "" | Some c -> Printf.sprintf ";%s" c)
    (match d.encoding with None -> "" | Some e -> Printf.sprintf ";%s" e)
    d.data

let pp_url_data = mk_pp string_of_url_data

type src = [
  | `Iri of Iri.t
  | var
  ]
let string_of_src : src -> string = function
| (#var as v) -> string_of_var v
| `Iri iri -> Printf.sprintf "\"%s\"" (Iri.to_uri iri)
let pp_src = mk_pp string_of_src

type url = [
  | `Iri of Iri.t
  | `Data of url_data
  | `Src of src
  ]

let string_of_url : url -> string = function
| `Iri iri -> Printf.sprintf "url(\"%s\")" (Iri.to_uri iri)
| `Data d -> Printf.sprintf "url(\"data:%s\")" (string_of_url_data d)
| `Src src -> Printf.sprintf "src(%s)" (string_of_src src)

let pp_url = mk_pp string_of_url
let equal_url u1 u2 =
  match u1, u2 with
  | `Iri i1, `Iri i2
  | `Src(`Iri i1), `Src (`Iri i2) -> Iri.equal i1 i2
  | _ -> u1 = u2

type image = [
| `Url of url
| `Gradient of gradient * string
| `Function of string * string (* name, args *)
]

let string_of_image : image -> string = function
| `Url iri -> string_of_url iri
| `Gradient (g, s) -> Printf.sprintf "%s(%s)" (string_of_gradient g) s
| `Function (f,args) -> Printf.sprintf "%s(%s)" f args
let pp_image = mk_pp string_of_image

type value =
| String of str
| Integer of int
| Number of number
| Dimension of dimension
| Percent of number
| Color of color
| Position of axis_position

let string_of_value : value -> string = function
| String s -> string_of_str s
| Integer n -> string_of_int n
| Number f -> string_of_number f
| Dimension (n,dim) -> string_of_dimension n dim
| Percent n -> Printf.sprintf "%s%%" (string_of_number n)
| Color c -> string_of_color c
| Position p -> string_of_axis_position p
let pp_value = mk_pp string_of_value

type accent_color_kw = [ `Auto ]
let accent_color_kws : accent_color_kw list = [ `Auto ]
type accent_color = [ color | accent_color_kw ]
let string_of_accent_color : accent_color -> string = function
| #color as x -> string_of_color x
| #accent_color_kw as x -> Kw.string_of_kw x
let pp_accent_color = mk_pp string_of_accent_color

type baseline_position_kw = [ `Baseline ]
let baseline_position_kws : baseline_position_kw list = [ `Baseline ]
type baseline_position = [ baseline_position_kw | `First_baseline | `Last_baseline ]
let string_of_baseline_position : baseline_position -> string = function
| `First_baseline-> "first baseline"
| `Last_baseline -> "last baseline"
| #baseline_position_kw as x -> Kw.string_of_kw x
let pp_baseline_position = mk_pp string_of_baseline_position

type content_position_kw =
  [  `Center | `End | `Flex_end | `Flex_start | `Start ]
let content_position_kws =
  [  `Center ; `End ; `Flex_end ; `Flex_start ; `Start ]
type content_position = content_position_kw
let string_of_content_position : content_position -> string = Kw.string_of_kw
let pp_content_position = mk_pp string_of_content_position

type content_position_lr_kw = [ content_position_kw | `Left | `Right ]
let content_position_lr_kws = `Left :: `Right :: content_position_kws
type content_position_lr = content_position_lr_kw
let string_of_content_position_lr : content_position_lr -> string = Kw.string_of_kw
let pp_content_position_lr = mk_pp string_of_content_position_lr

type self_position_kw = [`Self_start | `Self_end | content_position_kw ]
let self_position_kws = `Self_start :: `Self_end :: content_position_kws
type self_position = self_position_kw
let string_of_self_position : self_position -> string = function
| #content_position as x -> string_of_content_position x
| #self_position_kw as x -> Kw.string_of_kw x
let pp_self_position = mk_pp string_of_self_position

type self_position_lr_kw = [ self_position_kw | `Left | `Right ]
let self_position_lr_kws = `Left :: `Right :: self_position_kws
type self_position_lr = self_position_lr_kw
let string_of_self_position_lr : self_position_lr -> string = Kw.string_of_kw
let pp self_position_lr = mk_pp string_of_self_position_lr

type content_distribution_kw =
  [ `Space_around | `Space_between | `Space_evenly | `Stretch ]
let content_distribution_kws =
  [ `Space_around ; `Space_between ; `Space_evenly ; `Stretch ]
type content_distribution = content_distribution_kw
let string_of_content_distribution : content_distribution -> string = Kw.string_of_kw
let pp_content_distribution = mk_pp string_of_content_distribution

type align_content_kw = [`Normal]
let align_content_kws : align_content_kw list = [`Normal]
type align_content = [ align_content_kw
  | baseline_position | content_distribution
  | content_position
  | `Safe_pos of content_position
  | `Unsafe_pos of content_position
  ]
let string_of_align_content : align_content -> string = function
| `Safe_pos p -> Printf.sprintf "safe %s" (string_of_content_position p)
| `Unsafe_pos p -> Printf.sprintf "unsafe %s" (string_of_content_position p)
| #baseline_position as x -> string_of_baseline_position x
| #content_distribution as x -> string_of_content_distribution x
| #content_position as x -> string_of_content_position x
| #align_content_kw as x -> Kw.string_of_kw x
let pp_align_content = mk_pp string_of_align_content

type align_items_kw = [ `Normal | `Stretch ]
let align_items_kws : align_items_kw list = [ `Normal ; `Stretch ]
type align_items =
  [ baseline_position | self_position
  | `Safe_self_pos of self_position
  | `Unsafe_self_pos of self_position
  | align_items_kw ]
let string_of_align_items : align_items -> string = function
| `Safe_self_pos p -> Printf.sprintf "safe %s" (string_of_self_position p)
| `Unsafe_self_pos p -> Printf.sprintf "unsafe %s" (string_of_self_position p)
| #self_position as x -> string_of_self_position x
| #baseline_position as x -> string_of_baseline_position x
| #align_items_kw as x -> Kw.string_of_kw x
let pp_align_items = mk_pp string_of_align_items

type align_self_kw = [ `Auto ]
let align_self_kws : align_self_kw list = [ `Auto ]
type align_self = [ align_self_kw | align_items ]
let string_of_align_self : align_self -> string = function
| `Auto as x -> Kw.string_of_kw x
| #align_items as x -> string_of_align_items x
let pp_align_self = mk_pp string_of_align_self

type aspect_ratio_kw = [ `Auto ]
let aspect_ratio_kws : aspect_ratio_kw list = [ `Auto ]
type aspect_ratio = [
| `Ratio of number * number option
| aspect_ratio_kw
]
let string_of_aspect_ratio : aspect_ratio -> string = function
| `Auto as x -> Kw.string_of_kw x
| `Ratio (n, None) -> string_of_number n
| `Ratio (n1, Some n2) ->
      Printf.sprintf "%s / %s" (string_of_number n1) (string_of_number n2)
let pp_aspect_ratio = mk_pp string_of_aspect_ratio

let string_of_background_ to_string = string_of_list ", " to_string

type background_attachment_kw = [ `Fixed | `Local | `Scroll ]
let background_attachment_kws : background_attachment_kw list =
  [`Fixed ; `Local ; `Scroll ]
type background_attachment_ = background_attachment_kw
type background_attachment = background_attachment_ list
let string_of_background_attachment : background_attachment -> string =
  string_of_background_ Kw.string_of_kw
let pp_background_attachment = mk_pp string_of_background_attachment

type background_clip_kw = [ `Border_box | `Content_box | `Padding_box | `Text ]
let background_clip_kws : background_clip_kw list =
  [ `Border_box ; `Content_box ; `Padding_box ; `Text ]
type background_clip_ = background_clip_kw
type background_clip = background_clip_ list
let string_of_background_clip : background_clip -> string =
  string_of_background_ Kw.string_of_kw
let pp_background_clip = mk_pp string_of_background_clip

type background_image_kw = [ `None ]
let background_image_kws : background_image_kw list = [ `None ]
type background_image_ = [ `Image of image | background_image_kw ]
let string_of_background_image_ : background_image_ -> string = function
| `Image i -> string_of_image i
| #background_image_kw as x -> Kw.string_of_kw x
type background_image = background_image_ list
let string_of_background_image : background_image -> string =
  string_of_background_ string_of_background_image_
let pp_background_image = mk_pp string_of_background_image

type background_origin_kw = [ `Border_box | `Content_box | `Padding_box ]
let background_origin_kws : background_origin_kw list =
  [ `Border_box ; `Content_box ; `Padding_box ]
type background_origin_ = background_origin_kw
type background_origin = background_origin_ list
let string_of_background_origin : background_origin -> string =
  string_of_background_ Kw.string_of_kw
let pp_background_origin = mk_pp string_of_background_origin

type background_position_x = x_position list
let string_of_background_position_x : background_position_x -> string =
  string_of_background_ string_of_x_position
let pp_background_position_x = mk_pp string_of_background_position_x

type background_position_y = y_position list
let string_of_background_position_y : background_position_y -> string =
  string_of_background_ string_of_y_position
let pp_background_position_y = mk_pp string_of_background_position_y

type repeat = [ `No_repeat | `Repeat | `Round | `Space ]
let repeat_kws : repeat list = [ `No_repeat ; `Repeat ; `Round ; `Space ]
let string_of_repeat : repeat -> string = Kw.string_of_kw
let pp_repeat = mk_pp string_of_repeat

type background_repeat_kw = [ `Repeat_x | `Repeat_y ]
let background_repeat_kws : background_repeat_kw list = [ `Repeat_x ; `Repeat_y ]
type background_repeat_ = (repeat * repeat)
type background_repeat = background_repeat_ list
let string_of_background_repeat : background_repeat -> string =
  let f (x,y) = Printf.sprintf "%s %s" (string_of_repeat x) (string_of_repeat y) in
  string_of_background_ f
let pp_background_repeat = mk_pp string_of_background_repeat

type background_size_kw = [ `Auto | `Contain | `Cover ]
let background_size_kws : background_size_kw list = [ `Auto ; `Contain ; `Cover ]
type background_size_ = [ background_size_kw | length_percentage ]
let string_of_background_size_ : background_size_ -> string = function
| #length_percentage as x -> string_of_length_percentage x
| #background_size_kw as x -> Kw.string_of_kw x
type background_size = (background_size_ * background_size_) list
let string_of_background_size : background_size -> string =
  let f (x,y) = Printf.sprintf "%s %s"
    (string_of_background_size_ x)
      (string_of_background_size_ y)
  in
  string_of_background_ f
let pp_background_size = mk_pp string_of_background_size

type background_color = color
let string_of_background_color = string_of_color
let pp_background_color = pp_color

type border_collapse_kw = [ `Collapse | `Separate ]
let border_collapse_kws = [ `Collapse ; `Separate ]
type border_collapse = border_collapse_kw
let string_of_border_collapse : border_collapse -> string = Kw.string_of_kw
let pp_border_collapse = mk_pp string_of_border_collapse

type border_spacing = length or_var * length or_var
let string_of_border_spacing : border_spacing -> string =
  fun (s1, s2) -> Printf.sprintf "%s %s"
    (string_of_or_var string_of_length s1)
      (string_of_or_var string_of_length s2)
let pp_border_spacing = mk_pp string_of_border_spacing

type width = size
let string_of_width = string_of_size
let pp_width = pp_size

type border_width_kw = [`Thin | `Medium | `Thick]
let border_width_kws : border_width_kw list = [`Thin ; `Medium ; `Thick]
type border_width = [width | border_width_kw]
let string_of_border_width : border_width -> string = function
| #border_width_kw as x -> Kw.string_of_kw x
| #width as x -> string_of_width x
let pp_border_width = mk_pp string_of_border_width

type display_outside = [ `Block | `Inline | `Run_in ]
let display_outside_kws : display_outside list = [ `Block ; `Inline ; `Run_in ]
type display_flow = [`Flow | `Flow_root ]
let display_flow_kws : display_flow list = [`Flow ; `Flow_root ]
type display_inside = [ display_flow | `Table | `Flex | `Grid | `Ruby ]
let display_inside_kws : display_inside list =
  `Table :: `Flex :: `Grid :: `Ruby :: (display_flow_kws:>display_inside list)
type display_listitem = display_outside * display_flow
type display_listitem_kw = [ `List_item ]
let display_listitem_kws : display_listitem_kw list = [ `List_item ]
type display_internal = [
  | `Table_row_group | `Table_header_group | `Table_footer_group
  | `Table_row | `Table_cell | `Table_column_group | `Table_column
  | `Table_caption
  | `Ruby_base | `Ruby_base_container | `Ruby_text | `Ruby_text_container ]
let display_internal_kws : display_internal list =  [
    `Table_row_group ; `Table_header_group ; `Table_footer_group ;
    `Table_row ; `Table_cell ; `Table_column_group ; `Table_column ;
    `Table_caption ;
    `Ruby_base ; `Ruby_base_container ; `Ruby_text ; `Ruby_text_container ]
type display_box = [ `Contents | `None ]
let display_box_kws : display_box list = [ `Contents ; `None ]
type display_legacy =
  [ `Inline_block | `Inline_table
  | `Inline_flex | `Inline_grid ]
let display_legacy_kws =
  [ `Inline_block ; `Inline_table ; `Inline_flex ; `Inline_grid ]

type display_out_in = display_outside * display_inside * [`List_item] option
type display = [
| `Out_in of display_out_in
| display_internal
| display_box
]
let string_of_display : display -> string = function
| `Out_in (o,i,li) -> Printf.sprintf "%s %s%s"
      (Kw.string_of_kw o) (Kw.string_of_kw i)
        (match li with None -> "" | Some x -> " "^(Kw.string_of_kw x))
| #display_internal
| #display_box as x -> Kw.string_of_kw x
let pp_display = mk_pp string_of_display

type flex_basis_kw = [`Content]
let flex_basis_kws : flex_basis_kw list = [`Content]
type flex_basis = [flex_basis_kw | width]
let string_of_flex_basis : flex_basis -> string = function
| #width as x -> string_of_width x
| #flex_basis_kw as x -> Kw.string_of_kw x
let pp_flex_basis = mk_pp string_of_flex_basis

type flex_direction_kw = [ `Column | `Column_reverse | `Row | `Row_reverse ]
let flex_direction_kws : flex_direction_kw list = [ `Column ; `Column_reverse ; `Row ; `Row_reverse ]
type flex_direction = flex_direction_kw
let string_of_flex_direction : flex_direction -> string = function
| #flex_direction as x -> Kw.string_of_kw x
let pp_flex_direction = mk_pp string_of_flex_direction

type flex_wrap_kw = [ `Nowrap | `Wrap | `Wrap_reverse ]
let flex_wrap_kws : flex_wrap_kw list = [ `Nowrap ; `Wrap ; `Wrap_reverse ]
type flex_wrap = flex_wrap_kw
let string_of_flex_wrap : flex_wrap -> string = function
| #flex_wrap as x -> Kw.string_of_kw x
let pp_flex_wrap = mk_pp string_of_flex_wrap

type font_family_generic_kw = [
  | `Cursive | `Emoji | `Fantasy |`Fangsong | `Math
  | `Monospace | `Sans_serif | `Serif | `System_ui
  | `Ui_monospace | `Ui_rounded | `Ui_sans_serif | `Ui_serif ]
let font_family_generic_kws : font_family_generic_kw list = [
    `Cursive ; `Emoji ; `Fantasy ;`Fangsong ; `Math ;
    `Monospace ; `Sans_serif ; `Serif ; `System_ui ;
    `Ui_monospace ; `Ui_rounded ; `Ui_sans_serif ; `Ui_serif ]
type font_family_ = [ `Generic of font_family_generic_kw | `Family of string ]
let string_of_font_family_ : font_family_ -> string = function
| `Generic g -> Kw.string_of_kw g
| `Family s -> string_of_str { s ; quoted = true }
type font_family = font_family_ list
let string_of_font_family : font_family -> string = string_of_list ", " string_of_font_family_
let pp_font_family = mk_pp string_of_font_family

type font_kerning = [ `Normal | `Auto | `None ]
let font_kerning_kws : font_kerning list = [ `Normal ; `Auto ; `None ]
let string_of_font_kerning : font_kerning -> string = Kw.string_of_kw
let pp_font_kerning = mk_pp string_of_font_kerning

type font_size_kw = [
  | `Large | `Larger | `Math | `Medium | `Small | `Smaller
  | `Xxx_large | `Xx_large | `Xx_small | `X_large | `X_small ]
let font_size_kws : font_size_kw list = [
    `Large ; `Larger ; `Math ; `Medium ; `Small ; `Smaller ;
    `Xxx_large ; `Xx_large ; `Xx_small ; `X_large ; `X_small ]
type font_size = [ font_size_kw | length_percentage ]
let string_of_font_size : font_size -> string = function
| #length_percentage as x -> string_of_length_percentage x
| #font_size_kw as x -> Kw.string_of_kw x
let pp_font_size = mk_pp string_of_font_size

type font_stretch_kw = [ `Normal
  | `Ultra_condensed | `Extra_condensed | `Semi_condensed | `Condensed
  | `Ultra_expanded | `Extra_expanded | `Semi_expanded | `Expanded ]
let font_stretch_kws : font_stretch_kw list = [ `Normal ;
    `Ultra_condensed ; `Extra_condensed ; `Semi_condensed ; `Condensed ;
    `Ultra_expanded ; `Extra_expanded ; `Semi_expanded ; `Expanded ]
type font_stretch = [ font_stretch_kw | percentage ]
let string_of_font_stretch : font_stretch -> string = function
| #font_stretch_kw as x -> Kw.string_of_kw x
| #percentage as x -> string_of_percentage x
let pp_font_stretch = mk_pp string_of_font_stretch

type font_style_kw = [ `Normal | `Italic ]
let font_style_kws : font_style_kw list = [ `Normal ; `Italic ]
type font_style = [ font_style_kw | `Oblique of angle option ]
let string_of_font_style : font_style -> string = function
| `Oblique angle -> Printf.sprintf "oblique%s"
      (match angle with None -> "" | Some a -> string_of_angle a)
| #font_style_kw as x -> Kw.string_of_kw x
let pp_font_style = mk_pp string_of_font_style

type font_variant_alt = [
| `Historical_forms
| `Stylistic of string
| `Styleset of string list
| `Character_variant of string list
| `Swash of string
| `Ornaments of string
| `Annotation of string
]
let string_of_font_variant_alt = function
| `Historical_forms -> "historical-forms"
| `Stylistic i -> Printf.sprintf "stylistic(%s)" i
| `Styleset l -> Printf.sprintf "styleset(%s)" (String.concat ", " l)
| `Character_variant l -> Printf.sprintf "character-variant(%s)" (String.concat ", " l)
| `Swash  i -> Printf.sprintf "swash(%s)" i
| `Ornaments i -> Printf.sprintf "ornaments(%s)" i
| `Annotation i -> Printf.sprintf "annotation(%s)" i

type font_variant_alternates = [ `Normal | `List of font_variant_alt list ]
let string_of_font_variant_alternates : font_variant_alternates -> string = function
| `Normal -> "normal"
| `List l -> String.concat " " (List.map string_of_font_variant_alt l)
let pp_font_variant_alternates = mk_pp string_of_font_variant_alternates

type font_variant_caps = [ `Normal
  | `Small_caps | `All_small_caps | `Petite_caps | `All_petite_caps
  | `Unicase | `Titling_caps ]
let font_variant_caps_kws : font_variant_caps list = [ `Normal ;
  `Small_caps ; `All_small_caps ; `Petite_caps ; `All_petite_caps ;
  `Unicase ; `Titling_caps ]
let string_of_font_variant_caps : font_variant_caps -> string = Kw.string_of_kw
let pp_font_variant_caps = mk_pp string_of_font_variant_caps

type font_variant_east_asian_kw = [ `Jis78 | `Jis83 | `Jis90 | `Jis04
 | `Ruby | `Proportional_width | `Simplified | `Traditional | `Full_width ]
let font_variant_east_asian_kws : font_variant_east_asian_kw list = [ `Jis78 ; `Jis83 ; `Jis90 ; `Jis04 ;
    `Ruby ; `Proportional_width ; `Simplified ; `Traditional ; `Full_width ]
type font_variant_east_asian = [ `Normal | `List of font_variant_east_asian_kw list]
let string_of_font_variant_east_asian : font_variant_east_asian -> string = function
| `Normal -> "normal"
| `List l -> String.concat " " (List.map Kw.string_of_kw l)
let pp_font_variant_east_asian = mk_pp string_of_font_variant_east_asian

type font_variant_emoji = [ `Normal | `Text | `Emoji | `Unicode ]
let font_variant_emoji_kws : font_variant_emoji list = [ `Normal ; `Text ; `Emoji ; `Unicode ]
let string_of_font_variant_emoji : font_variant_emoji -> string = Kw.string_of_kw
let pp_font_variant_emoji = mk_pp string_of_font_variant_emoji

type font_variant_ligatures_kw = [
  | `Common_ligatures | `No_common_ligatures
  | `Contextual | `No_contextual
  | `Discretionary_ligatures | `No_discretionary_ligatures
  | `Historical_ligatures | `No_historical_ligatures ]
let font_variant_ligatures_kws =
  [ `Common_ligatures ; `No_common_ligatures  ;
    `Contextual ; `No_contextual ;
    `Discretionary_ligatures ; `No_discretionary_ligatures ;
    `Historical_ligatures ; `No_historical_ligatures ]
type font_variant_ligatures = [ `Normal | `None | `List of font_variant_ligatures_kw list]
let string_of_font_variant_ligatures : font_variant_ligatures -> string = function
| `List l -> String.concat " " (List.map Kw.string_of_kw l)
| (`None | `Normal) as x -> Kw.string_of_kw x
let pp_font_variant_ligatures = mk_pp string_of_font_variant_ligatures

type font_variant_numeric_kw = [
    `Ordinal | `Slashed_zero | `Lining_nums | `Oldstyle_nums
  | `Proportional_nums | `Tabular_nums | `Diagonal_frations | `Stacked_fractions ]
let font_variant_numeric_kws = [
    `Ordinal ; `Slashed_zero ; `Lining_nums ; `Oldstyle_nums ;
    `Proportional_nums ;`Tabular_nums ; `Diagonal_frations ; `Stacked_fractions ]
type font_variant_numeric = [ `Normal | `List of font_variant_numeric_kw list]
let string_of_font_variant_numeric : font_variant_numeric -> string = function
| `List l -> String.concat " " (List.map Kw.string_of_kw l)
| `Normal as x -> Kw.string_of_kw x
let pp_font_variant_numeric = mk_pp string_of_font_variant_numeric

type font_variant_position = [ `Normal | `Sub | `Super ]
let font_variant_position_kws : font_variant_position list = [ `Normal ; `Sub ; `Super ]
let string_of_font_variant_position : font_variant_position -> string = Kw.string_of_kw
let pp_font_variant_position = mk_pp string_of_font_variant_position

type font_weight_kw = [ `Normal | `Bold | `Bolder | `Lighter ]
let font_weight_kws = [ `Normal ; `Bold ; `Bolder ; `Lighter ]
type font_weight = [ font_weight_kw | `Weight of int]
let string_of_font_weight : font_weight -> string = function
| `Weight n -> string_of_int n
| #font_weight_kw as x -> Kw.string_of_kw x
let pp_font_weight = mk_pp string_of_font_weight

type line_height_kw = [ `Normal ]
let line_height_kws : line_height_kw list = [ `Normal ]
type line_height = [ line_height_kw | `Number of number | length_percentage ]
let string_of_line_height : line_height -> string = function
| `Number n -> string_of_number n
| #length_percentage as x -> string_of_length_percentage x
| #line_height_kw as x -> Kw.string_of_kw x
let pp_line_height = mk_pp string_of_line_height

type system_font = {
    family : font_family_ list;
    size : font_size ;
    stretch : font_stretch ;
    style : font_style ;
    variant_alternates : font_variant_alternates;
    variant_caps : font_variant_caps ;
    variant_east_asian : font_variant_east_asian ;
    variant_emoji : font_variant_emoji ;
    variant_ligatures : font_variant_ligatures ;
    variant_numeric : font_variant_numeric ;
    variant_position : font_variant_position ;
    weight : font_weight ;
    line_height : line_height ;
  }

let system_font ?(stretch=`Normal) ?(style=`Normal)
    ?(variant_alternates=`Normal) ?(variant_caps=`Normal)
    ?(variant_east_asian=`Normal) ?(variant_emoji=`Normal)
    ?(variant_ligatures=`Normal) ?(variant_numeric=`Normal)
    ?(variant_position =`Normal) ?(weight=`Normal)
    ?(line_height=`Normal) size family =
    {
      family ; size ; stretch ; style ;
      variant_alternates ; variant_caps ;
      variant_east_asian ; variant_emoji ;
      variant_ligatures ; variant_numeric ;
      variant_position ; weight ;
      line_height
    }

type system_font_name =
  [ `Caption | `Icon | `Menu | `Message_box
  | `Small_caption | `Status_bar ]
let system_font_names : system_font_name list =
  [ `Caption ; `Icon ; `Menu ; `Message_box ; `Small_caption ; `Status_bar ]

module Sys_font_map = Map.Make
  (struct type t = system_font_name let compare = Stdlib.compare end)
let system_fonts_r = ref (Sys_font_map.empty: system_font Sys_font_map.t)

let set_system_font kw f =
  system_fonts_r := Sys_font_map.add kw f !system_fonts_r
let get_system_font kw = Sys_font_map.find_opt kw !system_fonts_r

let font_variant_css2 = [ `Normal ; `Small_caps ]
let font_stretch_css3 = font_stretch_kws

type justify_content_kw = [`Normal]
let justify_content_kws : justify_content_kw list = [`Normal]
type justify_content = [ justify_content_kw
  | content_distribution
  | content_position_lr
  | `Safe_pos_lr of content_position_lr
  | `Unsafe_pos_lr of content_position_lr
  ]
let string_of_justify_content : justify_content -> string = function
| `Safe_pos_lr p -> Printf.sprintf "safe %s" (string_of_content_position_lr p)
| `Unsafe_pos_lr p -> Printf.sprintf "unsafe %s" (string_of_content_position_lr p)
| #content_distribution as x -> string_of_content_distribution x
| #content_position_lr as x -> string_of_content_position_lr x
| #justify_content_kw as x -> Kw.string_of_kw x
let pp_justify_content = mk_pp string_of_justify_content

type height = size
let string_of_height = string_of_size
let pp_height = pp_size

type justify_items_kw = [ `Normal | `Stretch | `Legacy ]
let justify_items_kws : justify_items_kw list = [ `Normal ; `Stretch ; `Legacy ]
type justify_items =
  [ baseline_position | self_position_lr
  | `Safe_self_pos_lr of self_position_lr
  | `Unsafe_self_pos_lr of self_position_lr
  | `Legacy_lcr of [`Left | `Center | `Right]
  | justify_items_kw ]
let string_of_justify_items : justify_items -> string = function
| `Safe_self_pos_lr p -> Printf.sprintf "safe %s" (string_of_self_position_lr p)
| `Unsafe_self_pos_lr p -> Printf.sprintf "unsafe %s" (string_of_self_position_lr p)
| `Legacy_lcr x -> Printf.sprintf "legacy %s" (Kw.string_of_kw x)
| #self_position_lr as x -> string_of_self_position_lr x
| #baseline_position as x -> string_of_baseline_position x
| #justify_items_kw as x -> Kw.string_of_kw x
let pp_justify_items = mk_pp string_of_justify_items

type justify_self_kw = [ `Normal | `Stretch | `Auto ]
let justify_self_kws : justify_self_kw list = [ `Normal ; `Stretch ; `Auto ]
type justify_self =
  [ baseline_position | self_position_lr
  | `Safe_self_pos_lr of self_position_lr
  | `Unsafe_self_pos_lr of self_position_lr
  | `Legacy_lcr of [`Left | `Center | `Right]
  | justify_self_kw ]
let string_of_justify_self : justify_self -> string = function
| `Safe_self_pos_lr p -> Printf.sprintf "safe %s" (string_of_self_position_lr p)
| `Unsafe_self_pos_lr p -> Printf.sprintf "unsafe %s" (string_of_self_position_lr p)
| `Legacy_lcr x -> Printf.sprintf "legacy %s" (Kw.string_of_kw x)
| #self_position_lr as x -> string_of_self_position_lr x
| #baseline_position as x -> string_of_baseline_position x
| #justify_self_kw as x -> Kw.string_of_kw x
let pp_justify_self = mk_pp string_of_justify_self

type list_style_image_kw = [ `None ]
let list_style_image_kws : list_style_image_kw list = [ `None ]
type list_style_image = [ `Image of image | list_style_image_kw ]
let string_of_list_style_image : list_style_image -> string = function
| `Image i -> string_of_image i
| #list_style_image_kw as x -> Kw.string_of_kw x
let pp_list_style_image = mk_pp string_of_list_style_image

type list_style_position_kw = [ `Inside | `Outside ]
let list_style_position_kws : list_style_position_kw list = [ `Inside ; `Outside ]
type list_style_position = list_style_position_kw
let string_of_list_style_position : list_style_position -> string = Kw.string_of_kw
let pp_list_style_position = mk_pp string_of_list_style_position

type list_style_type_kw = [ `None ]
let list_style_type_kws : list_style_type_kw list = [ `None ]
type list_style_type = [ list_style_type_kw
| `Ident_ of string
| `String_ of string
| `Symbols_ of string ]
let string_of_list_style_type : list_style_type -> string = function
| #list_style_type_kw as x -> Kw.string_of_kw x
| `Ident_ s -> s
| `String_ s -> string_of_str { s ; quoted = true }
| `Symbols_ s -> Printf.sprintf "symbols(%s)" s
let pp_list_style_type = mk_pp string_of_list_style_type

type margin_kw = [`Auto]
let margin_kws : margin_kw list = [`Auto]
type margin = [margin_kw | length_percentage ]
let string_of_margin : margin -> string = function
| #margin_kw as x -> Kw.string_of_kw x
| #length_percentage as x -> string_of_length_percentage x
let pp_margin = mk_pp string_of_margin

type opacity = [`Factor of number | percentage ]
let string_of_opacity : opacity -> string = function
| `Factor n -> string_of_float n
| #percentage as x -> string_of_percentage x
let pp_opacity = mk_pp string_of_opacity

type padding = length_percentage
let string_of_padding : padding -> string = string_of_length_percentage
let pp_padding = mk_pp string_of_padding

type position_kw = [ `Static | `Relative | `Absolute | `Sticky | `Fixed ]
let  position_kws : position_kw list = [ `Static ; `Relative ; `Absolute ; `Sticky ; `Fixed ]
type position = position_kw
let string_of_position : position -> string = Kw.string_of_kw
let pp_position = mk_pp string_of_position

type text_align_kw = [`Start | `End | `Left | `Right
  | `Center | `Justify | `Justify_all | `Match_parent ]
let text_align_kws : text_align_kw list = [`Start ; `End ; `Left ; `Right ;
    `Center ; `Justify ; `Justify_all ; `Match_parent ]
type text_align = text_align_kw
let string_of_text_align : text_align -> string = Kw.string_of_kw
let pp_text_align = mk_pp string_of_text_align

type text_align_last_kw = [`Auto | `Start | `End | `Left | `Right
  | `Center | `Justify | `Match_parent ]
let text_align_last_kws : text_align_last_kw list = [`Auto ; `Start ; `End ; `Left ; `Right ;
    `Center ; `Justify ; `Match_parent ]
type text_align_last = text_align_last_kw
let string_of_text_align_last : text_align_last -> string = Kw.string_of_kw
let pp_text_align_last = mk_pp string_of_text_align_last

type vertical_align_kw = [ `Baseline | `Sub | `Super | `Top
  | `Text_top | `Middle | `Bottom | `Text_bottom ]
let vertical_align_kws : vertical_align_kw list = [ `Baseline ; `Sub ; `Super ; `Top ;
  `Text_top  ;`Middle ; `Bottom ; `Text_bottom ]
type vertical_align = [ vertical_align_kw | length_percentage ]
let string_of_vertical_align : vertical_align -> string = function
| #vertical_align_kw as x -> Kw.string_of_kw x
| #length_percentage as x -> string_of_length_percentage x
let pp_vertical_align = mk_pp string_of_vertical_align

type visibility_kw = [ `Visible | `Hidden | `Collapse ]
let visibility_kws : visibility_kw list = [ `Visible ; `Hidden ; `Collapse ]
type visibility = visibility_kw
let string_of_visibility : visibility -> string = Kw.string_of_kw
let pp_visibilty = mk_pp string_of_visibility

type white_space_kw = [ `Normal | `Nowrap | `Pre | `Pre_wrap | `Pre_line | `Break_spaces ]
let white_space_kws : white_space_kw list = [ `Normal ; `Nowrap ; `Pre ; `Pre_wrap ; `Pre_line ; `Break_spaces ]
type white_space = white_space_kw
let string_of_white_space : white_space -> string = Kw.string_of_kw
let pp_white_space = mk_pp string_of_white_space

type word_spacing_kw = [ `Normal ]
let word_spacing_kws : word_spacing_kw list = [ `Normal ]
type word_spacing = [ word_spacing_kw | `Length of number * length_unit ]
let string_of_word_spacing : word_spacing -> string = function
| `Length x -> string_of_length x
| #word_spacing_kw as x -> Kw.string_of_kw x
let pp_word_spacing = mk_pp string_of_word_spacing