Source file arbitrary.ml

(** Arbitrary property utilities: [property:value] with optional /opacity. *)

module Css = Cascade.Css

let err_not_utility = Error (`Msg "Not an arbitrary property utility")

(** Map a CSS property name to its declaration constructor (color properties
    only). *)
let color_property_of_name = function
  | "color" -> Some Css.color
  | "background-color" -> Some Css.background_color
  | "border-color" -> Some Css.border_color
  | "outline-color" -> Some Css.outline_color
  | "text-decoration-color" -> Some Css.text_decoration_color
  | "accent-color" -> Some Css.accent_color
  | "caret-color" -> Some Css.caret_color
  | "fill" -> Some (fun c -> Css.fill (Css.Color c : Css.svg_paint))
  | "stroke" -> Some (fun c -> Css.stroke (Css.Color c : Css.svg_paint))
  | _ -> None

module Handler = struct
  open Style

  type alpha_fn = {
    spelling : string;
        (** the [--alpha(...)] text the class was written with *)
    alpha : Color.opacity_modifier;  (** the alpha that function applies *)
  }
  (** A value written as Tailwind's [--alpha(<color>/<percentage>)]. *)

  type t =
    | Color_opacity of {
        property : string;
        value : string;  (** the colour, with any [--alpha()] wrapper undone *)
        alpha_fn : alpha_fn option;
        opacity : Color.opacity_modifier;
            (** the [/] modifier written after the closing bracket *)
      }
    | Parsed_decl of { property : string; value : string }
  (* Plain [property:value] (no /opacity), parsed by cascade into a typed,
     var-tracking declaration. *)

  let name = "arbitrary"

  (* Tailwind sorts an arbitrary property by the property it declares, not by
     its name, so [[order:3]] lands with the [order-*] utilities and
     [[mask-type:luminance]] with the masks. Every one of them sorted at the far
     end of the layer instead. A property no family claims shares Tailwind's
     late arbitrary-property band, after alpha text shadows and before backface
     visibility. *)
  let unclaimed = 38

  (* The class carries the property as it was written, which is where [\_]
     spells an underscore the value grammar would otherwise read as a space. The
     name itself has no space to spell, so it keeps every bare [_] it has. *)
  let declared_property property = Parse.unescape_underscores property

  let slot t =
    let property, value =
      match t with
      | Color_opacity { property; value; _ } -> (property, value)
      | Parsed_decl { property; value } -> (property, value)
    in
    match
      Css.parse_declaration ~layer:"utilities"
        (declared_property property)
        (Parse.decode_arbitrary_value value)
    with
    | None -> None
    | Some decl -> Utility.order_of_property (Css.Declaration.property_key decl)

  let priority t =
    match slot t with Some (priority, _) -> priority | None -> unclaimed

  (* Render a known colour-property declaration ([color], [background-color],
     ...) with a parsed colour value and an /opacity modifier: the mix, and
     before it what a browser without [color-mix()] reads when the mix needs
     Tailwind's polyfill, which is when it reads a custom property or
     [currentcolor]. A named token resolves to the theme's percentage, in an
     sRGB mix, there. *)
  let color_opacity_render theme prop color opacity =
    match opacity with
    | Color.No_opacity -> style [ prop color ]
    | opacity -> (
        let mixed = Color.mix_alpha opacity color in
        match Color.pre_color_mix_fallback theme mixed with
        | None -> style [ prop mixed ]
        | Some in_the_open ->
            style
              ~rules:(Some [ Color.color_mix_supports [ prop mixed ] ])
              [ prop in_the_open ])

  (* A var-valued colour with /opacity: oklab color-mix under @supports, with an
     srgb fallback. The fallback resolves the var against the theme when known
     (Tailwind inlines the resolved colour), else keeps the raw var (matching
     Tailwind for non-theme vars). [emit] places the colour on the target
     property ([prop] for a known property, [Css.var] for a custom one). *)
  let color_var_opacity_style theme (emit : Css.color -> Css.declaration) value
      opacity =
    let bare = Parse.extract_var_name value in
    match Color.Handler.theme_color_of_name bare with
    (* A reference to a palette token renders from the palette, which is what
       puts the token in [@layer theme] and gives the fallback a colour rather
       than the bare reference. *)
    | Some (c, shade) ->
        Color.Handler.colors_with_opacity_style ~theme ~properties:[ emit ] c
          shade opacity
    | None ->
        let var_ref : Css.color Css.var = Var.bracket bare in
        let oklab_decl = emit (Color.mix_alpha opacity (Css.Var var_ref)) in
        (* The srgb fallback inlines the resolved theme colour when known
           (matching Tailwind), else keeps the raw var. Emitting the referenced
           [--token] into @layer theme needs the registering theme-var mechanism
           (see [Color.color_var]); arbitrary references via [Var.bracket] don't
           trigger it, so theme-var-referencing values still differ in the theme
           layer (the same gap as [backgrounds.ml]'s bg-[color:var(--token)]). A
           modifier reading a custom property has no percentage to fold in, so
           the fallback keeps the var() bare. *)
        let fallback =
          match Scheme.theme_value (Some theme) bare with
          | Some v when Option.is_none (Color.opacity_var_bare_of opacity) -> (
              match Css.parse_color (String.trim v) with
              | Some c -> emit (Color.mix_alpha ~in_space:Srgb opacity c)
              | None -> emit (Css.Var var_ref : Css.color))
          | Some _ | None -> emit (Css.Var var_ref : Css.color)
        in
        let supports = Color.color_mix_supports [ oklab_decl ] in
        style ~rules:(Some [ supports ]) [ fallback ]

  (* Place a colour on the declaration's target property: a known colour
     property uses its typed constructor; a custom property ([--name]) uses the
     typed [Css.var] form (kept in the utilities layer), never a token
     stream. *)
  let color_emitter property : (Css.color -> Css.declaration) option =
    let property = declared_property property in
    match color_property_of_name property with
    | Some prop -> Some prop
    | None ->
        Option.map
          (fun name c -> fst (Css.var ~layer:"utilities" name Css.Color c))
          (Parse.bare_name property)

  (* Arbitrary values use [_] for spaces (Tailwind); a literal underscore is
     escaped as [\_]. *)
  let to_style theme t =
    match t with
    | Parsed_decl { property; value } -> (
        (* [~layer:"utilities"] only affects a custom property; it keeps the
           declaration in the utilities layer (the build's theme/utilities
           filter drops layerless custom properties). *)
        let declaration =
          Css.parse_declaration ~layer:"utilities" (declared_property property)
        in
        let decoded = Parse.decode_arbitrary_value value in
        match declaration decoded with
        | None -> style []
        | Some decl -> (
            (* A value holding a [color-mix()] that reads a custom property or
               [currentcolor] takes Tailwind's polyfill pair: what a browser
               without [color-mix()] reads in the open, the value as written
               behind the guard. *)
            match
              Option.bind
                (Parse.color_mix_fallback ~resolve:(Color.theme_token theme)
                   decoded)
                declaration
            with
            | None -> style [ decl ]
            | Some in_the_open ->
                style
                  ~rules:(Some [ Color.color_mix_supports [ decl ] ])
                  [ in_the_open ]))
    | Color_opacity { property; value; alpha_fn; opacity } -> (
        match color_emitter property with
        (* of_class only accepts renderable colour declarations; defensive. *)
        | None -> style []
        | Some emit -> (
            (* The [/] modifier applies to the colour the value denotes, which
               is already a mix when the value was written with [--alpha()], so
               the two nest. Mixing with [transparent] only scales the alpha,
               which reads the same in either interpolation space. *)
            let inner, outer =
              match alpha_fn with
              | Some { alpha; _ } -> (alpha, opacity)
              | None -> (opacity, Color.No_opacity)
            in
            let emit c =
              match outer with
              | Color.No_opacity -> emit c
              | o -> emit (Color.mix_alpha ~in_space:Oklab o c)
            in
            (* A var reference renders from the theme when it names a palette
               token, so it is tried before the CSS colour reader (which reads
               [var()] as an opaque colour). *)
            if Parse.is_var value then
              color_var_opacity_style theme emit value inner
            else
              match Css.parse_color (Parse.decode_arbitrary_value value) with
              | Some color -> color_opacity_render theme emit color inner
              | None -> style []))

  let suborder t = match slot t with Some (_, sub) -> sub | None -> 10

  let to_class = function
    | Color_opacity { property; value; alpha_fn; opacity } ->
        let written =
          match alpha_fn with Some { spelling; _ } -> spelling | None -> value
        in
        "[" ^ property ^ ":" ^ written ^ "]" ^ Color.opacity_suffix opacity
    | Parsed_decl { property; value } -> "[" ^ property ^ ":" ^ value ^ "]"

  let of_class theme class_name =
    let len = String.length class_name in
    (* The bracket is closed by the tokeniser's reading, so a []] the value
       quotes or escapes stays inside it: [[content:'a]b']] is one property and
       one value. *)
    match Parse.bracket_close class_name with
    | None -> err_not_utility
    | Some close_pos -> (
        let inner = String.sub class_name 1 (close_pos - 1) in
        (* Find the colon that separates property from value *)
        let rec find_colon i =
          if i >= String.length inner then None
          else if inner.[i] = ':' then Some i
          else find_colon (i + 1)
        in
        match find_colon 0 with
        | None -> err_not_utility
        | Some colon_pos -> (
            let property = String.sub inner 0 colon_pos in
            let raw_value =
              String.sub inner (colon_pos + 1)
                (String.length inner - colon_pos - 1)
            in
            (* [--alpha(C/P)] is the [/opacity] form spelled as a function, so
               it resolves to the same fallback and [@supports] pair. *)
            let value, fn_alpha =
              match Parse.alpha_call raw_value with
              | Some (c, p) -> (
                  (* [--alpha()] writes the alpha as a percentage; the [/]
                     modifier writes the bare number, or the var() it reads. *)
                  let alpha =
                    if Parse.is_var p then Some (Color.Opacity_var p)
                    else if String.ends_with ~suffix:"%" p then
                      Color.opacity_of_string ~theme
                        (String.sub p 0 (String.length p - 1))
                    else Color.opacity_of_string ~theme p
                  in
                  match alpha with
                  | Some alpha -> (c, Some { spelling = raw_value; alpha })
                  | None -> (raw_value, None))
              | None -> (raw_value, None)
            in
            (* What follows the closing bracket is part of the class name, so it
               has to be a [/opacity] modifier in full: a suffix that does not
               parse names a class Tailwind does not recognise. *)
            let suffix =
              String.sub class_name (close_pos + 1) (len - close_pos - 1)
            in
            let modifier =
              if suffix = "" then Some Color.No_opacity
              else if suffix.[0] = '/' then
                Color.opacity_of_string ~theme
                  (String.sub suffix 1 (String.length suffix - 1))
              else None
            in
            match modifier with
            | None -> err_not_utility
            | Some opacity -> (
                if fn_alpha <> None || opacity <> Color.No_opacity then
                  (* The /opacity form wraps the value in color-mix, so it needs
                     a colour target (known colour property or custom property)
                     and a colour value. Non-colour cases are rejected (Tailwind
                     blindly color-mixes them, which is meaningless). *)
                  let is_colour_value =
                    Parse.is_var value
                    || Css.parse_color (Parse.decode_arbitrary_value value)
                       <> None
                  in
                  if color_emitter property <> None && is_colour_value then
                    Ok
                      (Color_opacity
                         { property; value; alpha_fn = fn_alpha; opacity })
                  else err_not_utility
                else if
                  Parse.holds_unresolved_call
                    (Parse.decode_arbitrary_value value)
                then
                  (* an [--alpha()] the reader above declined, or a [theme()],
                     is a lookup that failed: Tailwind names no utility. The
                     decoded text is what the lexer reads as a call: before it,
                     [1px_--alpha(] is one dimension token. *)
                  err_not_utility
                else
                  (* Plain [property:value]: any property whose value cascade
                     can parse becomes a typed declaration. *)
                  match
                    Css.parse_declaration
                      (declared_property property)
                      (Parse.decode_arbitrary_value value)
                  with
                  | Some _ -> Ok (Parsed_decl { property; value })
                  | None -> err_not_utility)))

  let examples = []
end

module Utility_factory = Utility.Make (Handler)