rule_order: canonicalise layer declarations to one normal form

CHANGES.md

@@ -737,6 +737,14 @@ to lose a whole rule over one bad piece. Both are gone.
 
 ### Canonical diff
 
+- The projection canonicalises layer declarations to one form, so two sheets
+  that establish the same layer order in the same places compare equal however
+  they spell it. A single `@layer a, b;`, per-layer `@layer a;` statements and
+  the blocks alone all reach one `@layer <names>;` per conditional-free run,
+  each `a.b` path expanding to `a` then `a.b`; nothing is hoisted across a
+  conditional group that declares a layer, so the order is preserved. This is
+  what made Tailwind's preflight, whose layers are declared in one statement,
+  report against tw's block-by-block sheet (#1275).
 - `--diff=canonical` drops an `@supports` block whose guard is false however a
   browser answers it, reading a parenthesised `<general-enclosed>` term as the
   false CSS Conditional 3 sec. 6.1 makes it: Tailwind's `@supports

fuzz/fuzz.ml

@@ -21,6 +21,7 @@ let () =
       Fuzz_inline.suite;
       Fuzz_stylesheet.suite;
       Fuzz_optimize.suite;
+      Fuzz_rule_order.suite;
       Fuzz_css.suite;
       Fuzz_supports.suite;
       Fuzz_font_face.suite;

fuzz/fuzz_rule_order.ml

@@ -0,0 +1,144 @@
+(** Fuzz tests for the canonical projection's layer normal form.
+
+    The projection is a canonical form: it must be confluent, so two sheets that
+    establish the same layer order and hold the same rules project to one
+    string, and idempotent, so projecting its own output changes nothing. These
+    cases generate a layer order, spell it several ways (one statement,
+    per-layer statements, blocks alone), and check the projection brings them
+    together. *)
+
+open Cascade
+open Alcobar
+
+let byte buf i =
+  if String.length buf = 0 then 0 else Char.code buf.[i mod String.length buf]
+
+let pick xs buf i = List.nth xs (byte buf i mod List.length xs)
+let idents = [| "a"; "b"; "c"; "d" |]
+let ident buf i = pick (Array.to_list idents) buf i
+
+(* A layer name: one ident, a dotted path of two, or a single ident that holds
+   an escaped dot and so is not the same layer as the path. *)
+let name buf i =
+  match byte buf i mod 3 with
+  | 0 -> [ ident buf (i + 1) ]
+  | 1 -> [ ident buf (i + 1); ident buf (i + 2) ]
+  | _ -> [ ident buf (i + 1) ^ "." ^ ident buf (i + 2) ]
+
+let layer_names buf =
+  let n = 1 + (byte buf 0 mod 4) in
+  let rec go i acc =
+    if i >= n then List.rev acc
+    else
+      let name = name buf (i + 1) in
+      let acc =
+        if List.exists (Stylesheet.equal_layer_name name) acc then acc
+        else name :: acc
+      in
+      go (i + 1) acc
+  in
+  go 0 []
+
+(* The CSS spelling of a layer name: [a.b] is the sublayer [b] of [a], and an
+   ident that holds a dot is spelled with it escaped. *)
+let spell name =
+  let escape s = String.concat "\\." (String.split_on_char '.' s) in
+  String.concat "." (List.map escape name)
+
+let has_block buf i = byte buf (i + 40) land 1 = 0
+
+let body buf i =
+  if byte buf (i + 60) land 1 = 0 then "x{top:0}" else "x{color:red}"
+
+(* One [@layer a,b;] statement naming every layer, then a block per layer that
+   has one. *)
+let sheet_one_statement buf names =
+  let statement = "@layer " ^ String.concat "," (List.map spell names) ^ ";" in
+  let blocks =
+    List.mapi
+      (fun i name ->
+        if has_block buf i then "@layer " ^ spell name ^ "{" ^ body buf i ^ "}"
+        else "")
+      names
+  in
+  statement ^ String.concat "" blocks
+
+(* Per-layer statements for the layers that have no block, blocks for the rest,
+   the same order. *)
+let sheet_per_name buf names =
+  String.concat ""
+    (List.mapi
+       (fun i name ->
+         if has_block buf i then "@layer " ^ spell name ^ "{" ^ body buf i ^ "}"
+         else "@layer " ^ spell name ^ ";")
+       names)
+
+let canonical css =
+  match Css.of_string ~strict:false css with
+  | Ok { stylesheet; _ } ->
+      Css.statements stylesheet |> Rule_order.canonicalize
+      |> Pp.to_string ~minify:true Stylesheet.pp_stylesheet
+  | Error e ->
+      failf "layer sheet did not parse (%s): %S" (Error.to_string e) css
+
+let test_layer_respellings_converge buf =
+  let names = layer_names buf in
+  let one = canonical (sheet_one_statement buf names) in
+  let per = canonical (sheet_per_name buf names) in
+  if one <> per then
+    failf "two spellings of one layer order project apart:\n  %S\n  %S" one per
+
+let test_layer_projection_is_idempotent buf =
+  let names = layer_names buf in
+  let once = canonical (sheet_one_statement buf names) in
+  let twice = canonical once in
+  if once <> twice then
+    failf "projecting the projection changed it:\n  %S\n  %S" once twice
+
+(* The order a name list establishes, with each [a.b] path expanded to [a] then
+   [a.b]: reversing [a.b, a] establishes the same order as [a, a.b]. *)
+let established_order names =
+  let rec go seen = function
+    | [] -> List.rev seen
+    | name :: rest ->
+        let rec prefixes acc cur = function
+          | [] -> List.rev acc
+          | x :: tl ->
+              let cur = cur @ [ x ] in
+              prefixes (cur :: acc) cur tl
+        in
+        let seen =
+          List.fold_left
+            (fun seen prefix ->
+              if List.exists (Stylesheet.equal_layer_name prefix) seen then seen
+              else prefix :: seen)
+            seen (prefixes [] [] name)
+        in
+        go seen rest
+  in
+  go [] names
+
+let test_reversed_order_stays_distinct buf =
+  let names = layer_names buf in
+  let reversed = List.rev names in
+  if
+    List.length names > 1
+    && not
+         (List.equal (List.equal String.equal) (established_order names)
+            (established_order reversed))
+  then
+    let forward = canonical (sheet_per_name buf names) in
+    let backward = canonical (sheet_per_name buf reversed) in
+    if forward = backward then
+      failf "two layer orders project together: %S" forward
+
+let suite =
+  ( "rule_order",
+    [
+      test_case "layer respellings converge" [ bytes ]
+        test_layer_respellings_converge;
+      test_case "layer projection is idempotent" [ bytes ]
+        test_layer_projection_is_idempotent;
+      test_case "reversed layer order stays distinct" [ bytes ]
+        test_reversed_order_stays_distinct;
+    ] )

fuzz/fuzz_rule_order.mli

@@ -0,0 +1,4 @@
+(** Fuzz tests for the canonical projection's layer normal form. *)
+
+val suite : string * Alcobar.test_case list
+(** [suite] declares the layer-normal-form fuzz cases. *)

lib/rule_order.ml

@@ -1354,6 +1354,178 @@ let sort_layer_blocks (stmts : statement list) : statement list =
       let sorted = go stmts in
       if !moved then fold_layer_pins sorted else stmts
 
+(* A sheet may name its layers in one [@layer a, b;] statement, in per-layer
+   statements, or in the blocks themselves. Two sheets that establish the same
+   layer order in the same places reach two different canonical forms, because
+   the optimizer folds an empty layer block into a trailing declaration while
+   the pin logic splits a leading multi-name statement, and the comparison then
+   reports the two render-equal sheets as different. This is the normal form
+   that removes the dependence on the spelling.
+
+   A block's statements are read as runs separated by a barrier: a statement
+   that is not itself a layer construct but declares a layer below it, such as
+   an [@media] holding an [@layer] or an [@import] with a layer. A barrier's
+   contribution to the order depends on its condition, so no name crosses one.
+   Within a barrier-free run, every layer name the run introduces, each [a.b]
+   path expanded to its prefixes [a] then [a.b], is written once in
+   first-appearance order as one [@layer <names>;] statement at the run's first
+   name-bearing construct. The run's other layer statements and empty layer
+   blocks go, since the statement carries their only effect. Nothing moves past
+   a barrier and the names keep first-appearance order, so the order the sheet
+   renders with is unchanged, and a nested layer is normalized inside the block
+   that holds it. *)
+
+(* The prefixes a layer path declares, outermost first: [a.b] declares [a] then
+   [a.b], and an ident that holds an escaped dot is one name with no prefixes to
+   split. *)
+let layer_name_prefixes (name : layer_name) : layer_name list =
+  let rec go acc cur = function
+    | [] -> List.rev acc
+    | x :: rest ->
+        let cur = cur @ [ x ] in
+        go (cur :: acc) cur rest
+  in
+  go [] [] name
+
+(* The layer names a run introduces, each path expanded, in first-appearance
+   order and deduplicated. *)
+let run_layer_names (run : statement list) : layer_name list =
+  let seen = ref [] in
+  let add name =
+    List.iter
+      (fun prefix ->
+        if not (List.exists (Stylesheet.equal_layer_name prefix) !seen) then
+          seen := !seen @ [ prefix ])
+      (layer_name_prefixes name)
+  in
+  let names_of stmt =
+    match stmt with
+    | Layer (Some name, _) -> [ name ]
+    | Layer_decl names -> names
+    | Import rule -> (
+        match Stylesheet.import_layer_name rule with
+        | Some (_ :: _ as name) -> [ name ]
+        | Some [] | None -> [])
+    | _ -> []
+  in
+  List.iter (fun stmt -> List.iter add (names_of stmt)) run;
+  !seen
+
+(* Put a run's style-only layer blocks into rank order. A block holding a nested
+   layer keeps its place, since the sublayer it holds contributes in source
+   order; moving it would change which of two writes to the sublayer wins. *)
+let sort_layer_blocks_by_rank (names : layer_name list) (stmts : statement list)
+    : statement list =
+  let rank name =
+    let rec go i = function
+      | [] -> max_int
+      | x :: rest ->
+          if Stylesheet.equal_layer_name x name then i else go (i + 1) rest
+    in
+    go 0 names
+  in
+  let name = function Layer (Some name, _) -> name | _ -> [] in
+  let sortable = function
+    | Layer (Some _, body) -> List.for_all style_only body
+    | _ -> false
+  in
+  let rec go = function
+    | [] -> []
+    | block :: _ as stmts when sortable block ->
+        let rec take acc = function
+          | block :: rest when sortable block -> take (block :: acc) rest
+          | rest -> (List.rev acc, rest)
+        in
+        let blocks, rest = take [] stmts in
+        List.stable_sort
+          (fun a b -> Int.compare (rank (name a)) (rank (name b)))
+          blocks
+        @ go rest
+    | stmt :: rest -> stmt :: go rest
+  in
+  go stmts
+
+(* Rewrite one barrier-free run to its normal form: one [@layer <names>;]
+   statement at the run's first name-bearing construct, the other declarations
+   and empty layer blocks gone, the style-only blocks in rank order. *)
+type layer_verdict = Keep | Drop | Other
+
+let canonical_layer_run (run : statement list) : statement list =
+  match run_layer_names run with
+  | [] -> run
+  | names ->
+      let empty block =
+        List.for_all
+          (function
+            | Rule { declarations = []; nested = []; _ } -> true | _ -> false)
+          block
+      in
+      let verdict = function
+        | Layer (Some _, block) -> if empty block then Drop else Keep
+        | Layer_decl (_ :: _) -> Drop
+        | Import rule -> (
+            match Stylesheet.import_layer_name rule with
+            | Some (_ :: _) -> Keep
+            | Some [] | None -> Other)
+        | _ -> Other
+      in
+      let emitted = ref false in
+      let out = ref [] in
+      let emit () =
+        if not !emitted then (
+          emitted := true;
+          out := Layer_decl names :: !out)
+      in
+      List.iter
+        (fun stmt ->
+          match verdict stmt with
+          | Keep ->
+              emit ();
+              out := stmt :: !out
+          | Drop -> emit ()
+          | Other -> out := stmt :: !out)
+        run;
+      sort_layer_blocks_by_rank names (List.rev !out)
+
+(* A statement that is a layer construct itself, and one whose transitive
+   content declares a layer, the second being a barrier for the run around
+   it. *)
+let is_layer_construct = function
+  | Layer (Some _, _) | Layer_decl (_ :: _) -> true
+  | _ -> false
+
+let rec statement_declares_layer stmt =
+  is_layer_construct stmt
+  || (match stmt with
+    | Import rule -> (
+        match Stylesheet.import_layer_name rule with
+        | Some (_ :: _) -> true
+        | Some [] | None -> false)
+    | _ -> false)
+  || Stylesheet.fold_statements
+       (fun acc child -> acc || statement_declares_layer child)
+       false
+       (Stylesheet.statement_children stmt)
+
+let is_barrier stmt =
+  (not (is_layer_construct stmt)) && statement_declares_layer stmt
+
+let rec canonical_layer_declarations (stmts : statement list) : statement list =
+  let stmts =
+    List.map
+      (Stylesheet.map_statement_children canonical_layer_declarations)
+      stmts
+  in
+  let rec go run acc = function
+    | [] -> List.rev_append (canonical_layer_run (List.rev run)) acc
+    | stmt :: rest when is_barrier stmt ->
+        go []
+          (stmt :: List.rev_append (canonical_layer_run (List.rev run)) acc)
+          rest
+    | stmt :: rest -> go (stmt :: run) acc rest
+  in
+  List.rev (go [] [] stmts)
+
 (* Media Queries 4 sec. 2.3 makes [all] the identity media type, so the Level 3
    [not all and (X)] is the Level 4 [not (X)]; sec. 4.2 gives [min-X]/[max-X]
    and the range form one meaning, and a lower bound met by an upper bound one
@@ -1483,4 +1655,5 @@ let canonicalize ?(lossless = false) ?(enforce_spec = false) ?judge
   in
   (* The runs above leave layer blocks side by side, which is where their order
      can be read. *)
-  sort_layer_blocks (if !changed then result else normalized)
+  canonical_layer_declarations
+    (sort_layer_blocks (if !changed then result else normalized))

test/cli/diff_canonical_residual.t

@@ -22,8 +22,8 @@ the report shows the two canonical forms with exit code 1.
   --- pinned.css
   +++ unpinned.css
   @@ position 7 @@
-  -@layer a;@layer b{x{top:0}}
-  +@layer b{x{top:0}}
+  -@layer a,b;@layer b{x{top:0}}
+  +@layer b;@layer b{x{top:0}}
           ^
 
   [1]