Source file containers.ml

(** Container query utilities for responsive design based on container size. *)

module Css = Cascade.Css

module Handler = struct
  open Style
  open Css

  (** Local container utility type *)
  type t =
    | Layout_container (* .container - layout container with width:100% *)
    | Container (* @container - sets container-type: inline-size *)
    | Container_normal (* @container-normal - sets container-type: normal *)
    | Container_size (* @container-size - sets container-type: size *)
    | Container_named of string (* @container/name *)

  let name = "containers"

  (* Tailwind's utility order opens with the container utilities; the layout
     [.container] keeps its own place by its width property. *)
  let priority = function
    | Layout_container -> 1
    | Container | Container_normal | Container_size | Container_named _ -> -2
  (* Tailwind orders .container by its width property: after the position group
     (inset, z-index) and before margin. *)

  let to_class = function
    | Layout_container -> "container"
    | Container -> "@container"
    | Container_normal -> "@container-normal"
    | Container_size -> "@container-size"
    | Container_named name -> "@container/" ^ name

  (* The unit a breakpoint value carries: what is left once its digits and dots
     are gone, or the head of a function call. *)
  let breakpoint_unit value =
    match String.index_opt value '(' with
    | Some i -> String.sub value 0 i
    | None ->
        let unit = Buffer.create (String.length value) in
        String.iter
          (fun c ->
            if not ((c >= '0' && c <= '9') || c = '.') then
              Buffer.add_char unit c)
          value;
        Buffer.contents unit

  (* The integer a breakpoint value starts with, the way [parseInt] reads it. *)
  let breakpoint_number value : int option =
    let stop = ref 0 in
    let len = String.length value in
    if len > 0 && (value.[0] = '-' || value.[0] = '+') then incr stop;
    let digits = !stop in
    while !stop < len && value.[!stop] >= '0' && value.[!stop] <= '9' do
      incr stop
    done;
    if !stop = digits then None
    else int_of_string_opt (String.sub value 0 !stop)

  (* Tailwind sorts the scale by unit first and then by number, ascending, so an
     [em] breakpoint precedes a [px] one whatever their widths. A value with no
     leading number falls back to comparing the spellings. *)
  let compare_breakpoints a b =
    if String.equal a b then 0
    else
      match String.compare (breakpoint_unit a) (breakpoint_unit b) with
      | 0 -> (
          match (breakpoint_number a, breakpoint_number b) with
          | Some x, Some y -> Int.compare x y
          | _ -> String.compare a b)
      | order -> order

  let layout_container_style theme =
    let open Css in
    (* Use top-level media queries to match Tailwind's minified output.
       Container media queries should come AFTER the base .container rule.
       sort.ml handles this ordering since container has only media rules and
       base props. *)
    let container_selector = Selector.class_ "container" in
    let spelling length = Css.Pp.to_string Css.pp_length length in
    let media_rules =
      Scheme.all_breakpoints theme
      |> List.map snd
      |> List.stable_sort (fun a b ->
          compare_breakpoints (spelling a) (spelling b))
      |> List.map (fun length ->
          media
            ~condition:(media_min_width_length length)
            [ rule ~selector:container_selector [ max_width length ] ])
    in
    style ~rules:(Some media_rules) [ width (Pct 100.) ]

  let container_query = style [ container_type Inline_size ]
  let container_normal_style = style [ container_type Normal ]
  let container_size_style = style [ container_type Size ]

  (* Tailwind v4 emits the [container] shorthand ([container: <name> /
     inline-size]) rather than the longhand pair. *)
  let container_named_style name =
    style [ Css.Declaration.container ~type_:Inline_size name ]

  let to_style theme = function
    | Layout_container -> layout_container_style theme
    | Container -> container_query
    | Container_normal -> container_normal_style
    | Container_size -> container_size_style
    | Container_named name -> container_named_style name

  let suborder = function
    | Container_named _ -> 0
    | Container -> 1
    | Container_normal -> 2
    | Container_size -> 3
    (* The .container utility (rank 15) sorts after grid_item's grid-column /
       grid-row utilities (priority 1, suborder up to ~2000), and after the
       @container query utilities above. *)
    | Layout_container -> 9_000_000

  let of_class _theme = function
    | "container" -> Ok Layout_container
    | "@container" -> Ok Container
    | "@container-normal" -> Ok Container_normal
    | "@container-size" -> Ok Container_size
    | n when String.starts_with ~prefix:"@container/" n ->
        let name = String.sub n 11 (String.length n - 11) in
        Ok (Container_named name)
    | _ -> Error (`Msg "Not a container utility")

  let examples = [ Container ]
end

open Handler
module Utility_factory = Utility.Make (Handler)

let utility = Utility_factory.v

(** Container Query Modifiers *)
let container_sm styles =
  Utility.Modified (Container Container_sm, Utility.Group styles)

let container_md styles =
  Utility.Modified (Container Container_md, Utility.Group styles)

let container_lg styles =
  Utility.Modified (Container Container_lg, Utility.Group styles)

let container_xl styles =
  Utility.Modified (Container Container_xl, Utility.Group styles)

let container_2xl styles =
  Utility.Modified (Container Container_2xl, Utility.Group styles)

let container_query ?name min_width styles =
  let query =
    match name with
    | None -> Style.Container_named ("", min_width)
    | Some n -> Style.Container_named (n, min_width)
  in
  Utility.Group
    (List.map (fun t -> Utility.Modified (Container query, t)) styles)

let container = utility Layout_container
let at_container = utility Container
let at_container_normal = utility Container_normal
let at_container_named name = utility (Container_named name)

(** Helper Functions *)

(* Tailwind v4 container-query thresholds (rem) for the named size scale. *)
let container_size_rem = function
  | Style.Container_3xs -> Some 16.
  | Style.Container_2xs -> Some 18.
  | Style.Container_xs -> Some 20.
  | Style.Container_sm -> Some 24.
  | Style.Container_md -> Some 28.
  | Style.Container_lg -> Some 32.
  | Style.Container_xl -> Some 36.
  | Style.Container_2xl -> Some 42.
  | Style.Container_3xl -> Some 48.
  | Style.Container_4xl -> Some 56.
  | Style.Container_5xl -> Some 64.
  | Style.Container_6xl -> Some 72.
  | Style.Container_7xl -> Some 80.
  | Style.Container_theme _ | Style.Container_named _ | Style.Container_size _
  | Style.Container_len _ | Style.Container_len_cmp _ | Style.Container_scoped _
    ->
      None

(* A [(width <op> len)] container feature query, matching Tailwind v4's range
   syntax: [(width >= 24rem)] for min, [(width < 28rem)] for max. *)
let width_range op len =
  Css.Container.Feature_query
    (Css.Media.Cond
       (Css.Media.Feature
          (Css.Media.Range (Css.Media.Width, op, Css.Media.Length len))))

(* Tailwind v4's max container query is the negated min: [@max-md] is [not
   (width >= 28rem)], which Lightning CSS lowers to [not (min-width:28rem)].
   Emitting the negated form keeps parity with Tailwind's optimized output. *)
let width_cond cmp len =
  match cmp with
  | Style.Min -> width_range Css.Media.Ge len
  | Style.Max -> Css.Container.Not (width_range Css.Media.Ge len)

(* The width a named size queries: what the project's [@theme] binds to
   [--container-<size>], else the scale above. The value is inlined, as Tailwind
   inlines it, so the token is not declared for the query's sake. *)
let container_size_length ?(theme = Scheme.default) q =
  let default = Option.map (fun r : Css.length -> Css.Values.Rem r) in
  match
    Option.bind
      (Scheme.token theme ("container-" ^ Style.container_size_name q))
      Css.parse_length
  with
  | Some _ as len -> len
  | None -> default (container_size_rem q)

(** Convert a container query modifier to a structured Container.t condition *)
let rec container_query_to_condition ?theme q =
  let geq len = width_range Css.Media.Ge len in
  let sized q =
    Option.value ~default:(Css.Values.Rem 0.) (container_size_length ?theme q)
  in
  match q with
  | Style.Container_3xs | Style.Container_2xs | Style.Container_xs
  | Style.Container_sm | Style.Container_md | Style.Container_lg
  | Style.Container_xl | Style.Container_2xl | Style.Container_3xl
  | Style.Container_4xl | Style.Container_5xl | Style.Container_6xl
  | Style.Container_7xl | Style.Container_theme _ ->
      geq (sized q)
  | Style.Container_named ("", width) ->
      geq (Css.Values.Px (float_of_int width))
  | Style.Container_named (name, width) ->
      Css.Container.Named (name, geq (Css.Values.Px (float_of_int width)))
  | Style.Container_size (cmp, inner) -> width_cond cmp (sized inner)
  | Style.Container_len (_, len) -> geq len
  | Style.Container_len_cmp (cmp, _, len) -> width_cond cmp len
  | Style.Container_scoped (name, inner) ->
      Css.Container.Named (name, container_query_to_condition ?theme inner)

(* The selector's class prefix and the class name [Utility.to_class] emits have
   to be the same string, so both come from [Style.container_size_name]. *)
let container_query_to_class_prefix q = "@" ^ Style.container_size_name q