penpot/frontend/test/frontend_tests/code_gen_style_test.cljs
Belén Albeza 6a83babc76 ✨ Generate list HTML and CSS for bullet paragraphs
In the Inspect code, neighbouring paragraphs with list-style-type
"disc" become one <ul> with an <li> each, keeping the paragraph's class
and dir. Other paragraphs stay <p>. Only code mode groups them; text
rendering still uses <p>.

The CSS sets list-style-type on the items and resets the list's margin
and padding, so the browser hangs the bullet before the text as the
canvas does. Paragraph rules set font-size: 0, so each item also gets a
::marker rule with its first span's font size and text color. A
::marker can't paint a gradient, so a gradient fill gives its first
stop.

Refs #12630

AI-assisted-by: claude-opus-5-5
2026-10-29 16:17:12 +01:00

307 lines
14 KiB
Clojure

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.code-gen-style-test
"Regression tests for the inspect code-generation (HTML/CSS export).
Each test guards against a concrete bug found in the CSS/HTML generation
of layout children and text shapes."
(:require
["react-dom/server" :as rds]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.uuid :as uuid]
[app.main.ui.shapes.text.html-text :as html-text]
[app.util.code-gen.markup-html :as html]
[app.util.code-gen.style-css :as css]
[cljs.test :refer [deftest is testing] :include-macros true]
[cuerdas.core :as str]
[rumext.v2 :as mf]))
;; --- Builders ------------------------------------------------------------
(defn- pts
"Rectangular point ring matching a x/y/w/h box."
[x y w h]
[(gpt/point x y)
(gpt/point (+ x w) y)
(gpt/point (+ x w) (+ y h))
(gpt/point x (+ y h))])
(defn- frame
[id & {:as extra}]
(merge {:id id :name "Board" :type :frame
:parent-id uuid/zero :frame-id uuid/zero
:selrect (grc/make-rect 0 0 200 200)
:points (pts 0 0 200 200)}
extra))
(defn- grid-frame
"A grid board with a single auto cell that holds `child-id`."
[id child-id & {:as extra}]
(let [cell-id (uuid/next)]
(merge (frame id)
{:name "Grid"
:layout :grid
:layout-grid-rows [{:type :flex :value 1}]
:layout-grid-columns [{:type :flex :value 1}]
:layout-grid-cells {cell-id {:id cell-id :row 1 :column 1
:row-span 1 :column-span 1
:position :auto
:align-self :auto :justify-self :auto
:shapes [child-id]}}}
extra)))
(defn- child
[id parent-id & {:as extra}]
(merge {:id id :name "Child" :type :rect :parent-id parent-id
:selrect (grc/make-rect 0 0 50 50)
:points (pts 0 0 50 50)
:transform (gmt/matrix)}
extra))
(defn- objects [& shapes]
(into {} (map (juxt :id identity)) shapes))
(def ^:private sample-margin
{:m1 10 :m2 20 :m3 30 :m4 40})
;; --- Margins on layout children -----------------------------------------
(deftest grid-child-margins-use-logical-longhand
(testing "margins of grid children map to logical longhand properties"
(let [pid (uuid/next)
cid (uuid/next)
c (child cid pid
:layout-item-margin sample-margin
:layout-item-margin-type :multiple)
objs (objects (grid-frame pid cid) c)]
(is (= "10px" (css/get-css-value objs c :margin-block-start)))
(is (= "20px" (css/get-css-value objs c :margin-inline-end)))
(is (= "30px" (css/get-css-value objs c :margin-block-end)))
(is (= "40px" (css/get-css-value objs c :margin-inline-start))))))
(deftest grid-child-css-has-no-redundant-margin-shorthand
(testing "the generated rule emits logical longhand margins, not a shorthand"
(let [pid (uuid/next)
cid (uuid/next)
c (child cid pid
:layout-item-margin sample-margin
:layout-item-margin-type :multiple)
out (css/get-shape-css-selector (objects (grid-frame pid cid) c) c)]
(is (str/includes? out "margin-block-start: 10px;"))
(is (not (re-find #"margin:" out))
"must not emit the `margin` shorthand alongside the longhand props"))))
(deftest wrapped-layout-child-margin-only-on-wrapper
(testing "a rotated (wrapped) child keeps margins on the wrapper, not the inner element"
(let [pid (uuid/next)
cid (uuid/next)
c (child cid pid
:layout-item-margin {:m1 10 :m2 0 :m3 0 :m4 0}
:layout-item-margin-type :multiple
:transform (gmt/rotate-matrix 30))
out (css/get-shape-css-selector (objects (grid-frame pid cid) c) c)
;; the inner element is the only rule carrying the transform matrix
inner (->> (str/split out "}")
(filter #(str/includes? % "transform:"))
(first))]
(is (str/includes? out "-wrapper {"))
(is (str/includes? out "margin-block-start: 10px;")
"margin is emitted (on the wrapper)")
(is (some? inner))
(is (not (str/includes? inner "margin"))
"the inner transformed element must not double the margin"))))
(deftest absolute-positioned-child-has-no-margin
(testing "absolutely positioned layout children drop their margin"
(let [pid (uuid/next)
cid (uuid/next)
c (child cid pid
:layout-item-margin sample-margin
:layout-item-margin-type :multiple
:layout-item-absolute true)
objs (objects (grid-frame pid cid) c)]
(is (nil? (css/get-css-value objs c :margin)))
(is (nil? (css/get-css-value objs c :margin-block-start))))))
;; --- Grid fill sizing ----------------------------------------------------
(deftest grid-fill-child-stretches-instead-of-fixed-size
(testing "fill-sized grid children rely on stretch instead of width/height: 100%"
(let [pid (uuid/next)
cid (uuid/next)
c (child cid pid
:layout-item-h-sizing :fill
:layout-item-v-sizing :fill)
objs (objects (grid-frame pid cid) c)]
(is (nil? (css/get-css-value objs c :width))
"no explicit width: 100% that would overflow the cell with a margin")
(is (nil? (css/get-css-value objs c :height)))
(is (= "stretch" (css/get-css-value objs c :justify-self)))
(is (= "stretch" (css/get-css-value objs c :align-self))))))
;; --- Absolute positioning vs parent border -------------------------------
(deftest absolute-position-discounts-parent-border
(testing "absolute coords are measured from the padding box, so the parent border is discounted"
(let [pid (uuid/next)
cid (uuid/next)
parent (frame pid :strokes [{:stroke-width 80
:stroke-style :solid
:stroke-color "#000000"
:stroke-alignment :inner}])
c (child cid pid
:selrect (grc/make-rect 100 100 50 50)
:points (pts 100 100 50 50))
objs (objects parent c)]
;; left/top = 100 (shape) - 0 (parent) - 80 (border) = 20
(is (= "20px" (css/get-css-value objs c :left)))
(is (= "20px" (css/get-css-value objs c :top))))))
(deftest absolute-position-without-border-is-unchanged
(testing "without a parent border the absolute coords are the raw offset"
(let [pid (uuid/next)
cid (uuid/next)
c (child cid pid
:selrect (grc/make-rect 100 100 50 50)
:points (pts 100 100 50 50))
objs (objects (frame pid) c)]
(is (= "100px" (css/get-css-value objs c :left)))
(is (= "100px" (css/get-css-value objs c :top))))))
;; --- Text node markup ----------------------------------------------------
(def ^:private text-content
{:type "root"
:children [{:type "paragraph-set"
:children [{:type "paragraph"
:children [{:text "Hello"
:fills [{:fill-color "#000000" :fill-opacity 1}]}]}]}]})
(deftest text-markup-emits-node-id-classes
(testing "generated text markup carries the $id classes the CSS rules target"
(let [tid (uuid/next)
text {:id tid :name "Text" :type :text
:parent-id uuid/zero :frame-id uuid/zero
:selrect (grc/make-rect 0 0 100 20)
:points (pts 0 0 100 20)
:grow-type :fixed
:content text-content}
markup (html/generate-markup (objects text) [text])]
(is (string? markup))
(is (str/includes? markup "root-0")
"the text nodes must expose their $id as a class for the CSS to apply")
(is (str/includes? markup "root-0-paragraph-set-0-paragraph-0")))))
;; --- Text lists ----------------------------------------------------------
(defn- list-paragraph
[text list-style-type]
(cond-> {:type "paragraph"
:children [{:text text
:font-size "20"
:fills [{:fill-color "#ff0000" :fill-opacity 1}]}]}
(some? list-style-type)
(assoc :list-style-type list-style-type)))
(defn- text-shape-with
[paragraphs]
{:id (uuid/next) :name "Text" :type :text
:parent-id uuid/zero :frame-id uuid/zero
:selrect (grc/make-rect 0 0 100 20)
:points (pts 0 0 100 20)
:grow-type :fixed
:content {:type "root"
:children [{:type "paragraph-set" :children paragraphs}]}})
(defn- block-tags
"The p/ul/li tags of `markup`, in order."
[markup]
(->> (re-seq #"<(/?)(p|ul|li)[ >]" markup)
(map (fn [[_ close tag]] (str close tag)))))
(deftest text-markup-groups-list-paragraphs-into-lists
(let [text (text-shape-with [(list-paragraph "a" nil)
(list-paragraph "b" "disc")
(list-paragraph "c" "disc")
(list-paragraph "d" "none")
(list-paragraph "e" "disc")])
markup (html/generate-markup (objects text) [text])]
(is (= ["p" "/p" "ul" "li" "/li" "li" "/li" "/ul" "p" "/p" "ul" "li" "/li" "/ul"]
(block-tags markup)))
(testing "list items keep the paragraph class and direction"
(is (str/includes? markup "<li dir=\"auto\" class=\"root-0-paragraph-set-0-paragraph-1\">")))))
(deftest text-markup-without-lists-has-no-list-tags
(let [text (text-shape-with [(list-paragraph "a" nil) (list-paragraph "b" "none")])
markup (html/generate-markup (objects text) [text])]
(is (= ["p" "/p" "p" "/p"] (block-tags markup)))))
(deftest text-css-styles-list-items
(let [text (text-shape-with [(list-paragraph "a" nil)
(list-paragraph "b" "disc")])
css (css/generate-text-css text)]
(testing "the list item rule sets the list style"
(is (re-find #"(?s)\.root-0-paragraph-set-0-paragraph-1 \{[^}]*list-style-type: disc;" css))
(is (not (re-find #"(?s)\.root-0-paragraph-set-0-paragraph-0 \{[^}]*list-style-type" css))))
(testing "the marker gets the first span's size and color"
(is (re-find #"(?s)\.root-0-paragraph-set-0-paragraph-1::marker \{[^}]*font-size: 20px;[^}]*color: rgba\(255, 0, 0, 1\);" css)))
(testing "the list drops the browser's spacing"
(is (= 1 (count (re-seq #" ul \{" css))))
(is (re-find #"(?s) ul \{\s*margin: 0;\s*padding: 0;\s*\}" css)))))
(deftest text-css-without-lists-has-no-list-rules
(let [css (css/generate-text-css (text-shape-with [(list-paragraph "a" nil)]))]
(is (not (str/includes? css "list-style")))
(is (not (str/includes? css " ul {")))
(is (not (str/includes? css "::marker")))))
(deftest rendered-text-keeps-paragraphs-for-lists
(testing "outside code mode list paragraphs still render as <p>"
(let [text (text-shape-with [(list-paragraph "b" "disc")])
markup (rds/renderToStaticMarkup
(mf/element html-text/text-shape* #js {:shape text :grow-type :fixed}))]
(is (= ["p" "/p"] (block-tags markup))))))
(defn- marker-rule
"The ::marker rule generated for a single list item made of `span`."
[span]
(let [css (css/generate-text-css
(text-shape-with [{:type "paragraph"
:list-style-type "disc"
:children [span]}]))]
(re-find #"(?s)::marker \{[^}]*\}" css)))
(deftest text-css-colors-the-marker-like-its-text
(testing "a half-opaque fill keeps its opacity"
(is (str/includes? (marker-rule {:text "a" :font-size "20"
:fills [{:fill-color "#ff0000" :fill-opacity 0.5}]})
"color: rgba(255, 0, 0, 0.5);")))
(testing "a gradient fill uses its first stop"
(is (str/includes? (marker-rule {:text "a" :font-size "20"
:fills [{:fill-color-gradient
{:type :linear
:start-x 0 :start-y 0 :end-x 1 :end-y 1 :width 1
:stops [{:color "#00ff00" :opacity 0.8 :offset 0}
{:color "#0000ff" :opacity 1 :offset 1}]}}]})
"color: rgba(0, 255, 0, 0.8);")))
(testing "a legacy span keeps its color on the node"
(is (str/includes? (marker-rule {:text "a" :font-size "20"
:fill-color "#0000ff" :fill-opacity 1})
"color: rgba(0, 0, 255, 1);")))
(testing "a span without a font size falls back to the default"
(is (str/includes? (marker-rule {:text "a"
:fills [{:fill-color "#ff0000" :fill-opacity 1}]})
"font-size: 14px;"))))
(deftest text-markup-keeps-the-direction-of-list-items
(let [text (text-shape-with [(assoc (list-paragraph "a" "disc") :text-direction "rtl")])
markup (html/generate-markup (objects text) [text])]
(is (str/includes? markup "<li dir=\"rtl\""))))