mirror of
https://github.com/penpot/penpot.git
synced 2026-03-30 08:10:30 +02:00
Merge remote-tracking branch 'origin/main' into staging
This commit is contained in:
Andrey Antukh
33
.opencode/agents/engineer.md
Normal file
33
.opencode/agents/engineer.md
Normal file
@@ -0,0 +1,33 @@
|
||||
---
|
||||
name: engineer
|
||||
description: Senior Full-Stack Software Engineer
|
||||
mode: primary
|
||||
---
|
||||
|
||||
Role: You are a high-autonomy Senior Full-Stack Software Engineer working on
|
||||
Penpot, an open-source design tool. You have full permission to navigate the
|
||||
codebase, modify files, and execute commands to fulfill your tasks. Your goal is
|
||||
to solve complex technical tasks with high precision while maintaining a strong
|
||||
focus on maintainability and performance.
|
||||
|
||||
Tech stack: Clojure (backend), ClojureScript (frontend/exporter), Rust/WASM
|
||||
(render-wasm), TypeScript (plugins/mcp), SCSS.
|
||||
|
||||
Requirements:
|
||||
|
||||
* Read the root `AGENTS.md` to understand the repository and application
|
||||
architecture. Then read the `AGENTS.md` **only** for each affected module.
|
||||
Not all modules have one — verify before reading.
|
||||
* Before writing code, analyze the task in depth and describe your plan. If the
|
||||
task is complex, break it down into atomic steps.
|
||||
* When searching code, prefer `ripgrep` (`rg`) over `grep` — it respects
|
||||
`.gitignore` by default.
|
||||
* Do **not** touch unrelated modules unless the task explicitly requires it.
|
||||
* Only reference functions, namespaces, or APIs that actually exist in the
|
||||
codebase. Verify their existence before citing them. If unsure, search first.
|
||||
* Be concise and autonomous — avoid unnecessary explanations.
|
||||
* After making changes, run the applicable lint and format checks for the
|
||||
affected module before considering the work done (see module `AGENTS.md` for
|
||||
exact commands).
|
||||
* Make small and logical commits following the commit guideline described in
|
||||
`CONTRIBUTING.md`. Commit only when explicitly asked.
|
||||
33
.opencode/agents/testing.md
Normal file
33
.opencode/agents/testing.md
Normal file
@@ -0,0 +1,33 @@
|
||||
---
|
||||
name: testing
|
||||
description: Senior Software Engineer specialized on testing
|
||||
mode: primary
|
||||
---
|
||||
|
||||
Role: You are a Senior Software Engineer specialized in testing Clojure and
|
||||
ClojureScript codebases. You work on Penpot, an open-source design tool.
|
||||
|
||||
Tech stack: Clojure (backend/JVM), ClojureScript (frontend/Node.js), shared
|
||||
Cljc (common module), Rust (render-wasm).
|
||||
|
||||
Requirements:
|
||||
|
||||
* Read the root `AGENTS.md` to understand the repository and application
|
||||
architecture. Then read the `AGENTS.md` **only** for each affected module. Not all
|
||||
modules have one — verify before reading.
|
||||
* Before writing code, describe your plan. If the task is complex, break it down into
|
||||
atomic steps.
|
||||
* Tests should be exhaustive and include edge cases relevant to Penpot's domain:
|
||||
nil/missing fields, empty collections, invalid UUIDs, boundary geometries, Malli schema
|
||||
violations, concurrent state mutations, and timeouts.
|
||||
* Tests must be deterministic — do not use `setTimeout`, real network calls, or rely on
|
||||
execution order. Use synchronous mocks for asynchronous workflows.
|
||||
* Use `with-redefs` or equivalent mocking utilities to isolate the logic under test. Avoid
|
||||
testing through the UI (DOM); e2e tests cover that.
|
||||
* Only reference functions, namespaces, or test utilities that actually exist in the
|
||||
codebase. Verify their existence before citing them.
|
||||
* After adding or modifying tests, run the applicable lint and format checks for the
|
||||
affected module before considering the work done (see module `AGENTS.md` for exact
|
||||
commands).
|
||||
* Make small and logical commits following the commit guideline described in
|
||||
`CONTRIBUTING.md`. Commit only when explicitly asked.
|
||||
@@ -102,11 +102,12 @@ Commit messages must follow this format:
|
||||
|
||||
### Rules
|
||||
|
||||
- Use the **imperative mood** in the subject (e.g. "Fix", not "Fixed").
|
||||
- Capitalize the first letter of the subject.
|
||||
- Do not end the subject with a period.
|
||||
- Keep the subject to **65 characters** or fewer.
|
||||
- Separate the subject from the body with a **blank line**.
|
||||
- Use the **imperative mood** in the subject (e.g. "Fix", not "Fixed")
|
||||
- Capitalize the first letter of the subject
|
||||
- Add clear and concise description on the body
|
||||
- Do not end the subject with a period
|
||||
- Keep the subject to **70 characters** or fewer
|
||||
- Separate the subject from the body with a **blank line**
|
||||
|
||||
### Examples
|
||||
|
||||
|
||||
@@ -7,6 +7,8 @@
|
||||
(ns common-tests.colors-test
|
||||
(:require
|
||||
#?(:cljs [goog.color :as gcolors])
|
||||
[app.common.colors :as c]
|
||||
[app.common.math :as mth]
|
||||
[app.common.types.color :as colors]
|
||||
[clojure.test :as t]))
|
||||
|
||||
@@ -92,3 +94,348 @@
|
||||
(t/is (false? (colors/color-string? "")))
|
||||
(t/is (false? (colors/color-string? "kkkkkk"))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; app.common.colors tests
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; --- Predicates and parsing
|
||||
|
||||
(t/deftest ac-valid-hex-color
|
||||
(t/is (true? (c/valid-hex-color? "#000000")))
|
||||
(t/is (true? (c/valid-hex-color? "#FFFFFF")))
|
||||
(t/is (true? (c/valid-hex-color? "#fabada")))
|
||||
(t/is (true? (c/valid-hex-color? "#aaa")))
|
||||
(t/is (false? (c/valid-hex-color? nil)))
|
||||
(t/is (false? (c/valid-hex-color? "")))
|
||||
(t/is (false? (c/valid-hex-color? "#")))
|
||||
(t/is (false? (c/valid-hex-color? "#qqqqqq")))
|
||||
(t/is (false? (c/valid-hex-color? "#aaaa")))
|
||||
(t/is (false? (c/valid-hex-color? "fabada"))))
|
||||
|
||||
(t/deftest ac-parse-rgb
|
||||
(t/is (= [255 30 30] (c/parse-rgb "rgb(255, 30, 30)")))
|
||||
(t/is (= [255 30 30] (c/parse-rgb "(255, 30, 30)")))
|
||||
(t/is (= [0 0 0] (c/parse-rgb "(0,0,0)")))
|
||||
(t/is (= [255 255 255] (c/parse-rgb "rgb(255,255,255)")))
|
||||
;; Values out of 0-255 range return nil
|
||||
(t/is (nil? (c/parse-rgb "rgb(256, 0, 0)")))
|
||||
(t/is (nil? (c/parse-rgb "rgb(0, -1, 0)")))
|
||||
(t/is (nil? (c/parse-rgb "not-a-color")))
|
||||
(t/is (nil? (c/parse-rgb "#fabada"))))
|
||||
|
||||
(t/deftest ac-valid-rgb-color
|
||||
(t/is (true? (c/valid-rgb-color? "rgb(255, 30, 30)")))
|
||||
(t/is (true? (c/valid-rgb-color? "(255,30,30)")))
|
||||
(t/is (false? (c/valid-rgb-color? nil)))
|
||||
(t/is (false? (c/valid-rgb-color? "")))
|
||||
(t/is (false? (c/valid-rgb-color? "#fabada")))
|
||||
(t/is (false? (c/valid-rgb-color? "rgb(300,0,0)"))))
|
||||
|
||||
;; --- Core conversions
|
||||
|
||||
(t/deftest ac-rgb-to-str
|
||||
(t/is (= "rgb(1,2,3)" (c/rgb->str [1 2 3])))
|
||||
(t/is (= "rgba(1,2,3,0.5)" (c/rgb->str [1 2 3 0.5])))
|
||||
(t/is (= "rgb(0,0,0)" (c/rgb->str [0 0 0])))
|
||||
(t/is (= "rgb(255,255,255)" (c/rgb->str [255 255 255]))))
|
||||
|
||||
(t/deftest ac-hex-to-rgb
|
||||
(t/is (= [0 0 0] (c/hex->rgb "#000000")))
|
||||
(t/is (= [255 255 255] (c/hex->rgb "#ffffff")))
|
||||
(t/is (= [1 2 3] (c/hex->rgb "#010203")))
|
||||
(t/is (= [250 186 218] (c/hex->rgb "#fabada")))
|
||||
;; Invalid hex falls back to [0 0 0]
|
||||
(t/is (= [0 0 0] (c/hex->rgb "#kkk"))))
|
||||
|
||||
(t/deftest ac-rgb-to-hex
|
||||
(t/is (= "#000000" (c/rgb->hex [0 0 0])))
|
||||
(t/is (= "#ffffff" (c/rgb->hex [255 255 255])))
|
||||
(t/is (= "#010203" (c/rgb->hex [1 2 3])))
|
||||
(t/is (= "#fabada" (c/rgb->hex [250 186 218]))))
|
||||
|
||||
(t/deftest ac-hex-to-rgb-roundtrip
|
||||
(t/is (= [250 186 218] (c/hex->rgb (c/rgb->hex [250 186 218]))))
|
||||
(t/is (= [10 20 30] (c/hex->rgb (c/rgb->hex [10 20 30])))))
|
||||
|
||||
(t/deftest ac-rgb-to-hsv
|
||||
;; Achromatic black
|
||||
(let [[h s v] (c/rgb->hsv [0 0 0])]
|
||||
(t/is (= 0 h))
|
||||
(t/is (= 0 s))
|
||||
(t/is (= 0 v)))
|
||||
;; Red: h=0, s=1, v=255
|
||||
(let [[h s v] (c/rgb->hsv [255 0 0])]
|
||||
(t/is (mth/close? h 0.0))
|
||||
(t/is (mth/close? s 1.0))
|
||||
(t/is (= 255 v)))
|
||||
;; Blue: h=240, s=1, v=255
|
||||
(let [[h s v] (c/rgb->hsv [0 0 255])]
|
||||
(t/is (mth/close? h 240.0))
|
||||
(t/is (mth/close? s 1.0))
|
||||
(t/is (= 255 v)))
|
||||
;; Achromatic gray: h=0, s=0, v=128
|
||||
(let [[h s v] (c/rgb->hsv [128 128 128])]
|
||||
(t/is (= 0 h))
|
||||
(t/is (= 0 s))
|
||||
(t/is (= 128 v))))
|
||||
|
||||
(t/deftest ac-hsv-to-rgb
|
||||
(t/is (= [0 0 0] (c/hsv->rgb [0 0 0])))
|
||||
(t/is (= [255 255 255] (c/hsv->rgb [0 0 255])))
|
||||
(t/is (= [1 2 3] (c/hsv->rgb [210 0.6666666666666666 3])))
|
||||
;; Achromatic (s=0)
|
||||
(let [[r g b] (c/hsv->rgb [0 0 128])]
|
||||
(t/is (= r g b 128))))
|
||||
|
||||
(t/deftest ac-rgb-to-hsv-roundtrip
|
||||
(let [orig [100 150 200]
|
||||
[h s v] (c/rgb->hsv orig)
|
||||
result (c/hsv->rgb [h s v])]
|
||||
;; Roundtrip may have rounding of ±1
|
||||
(t/is (every? true? (map #(< (mth/abs (- %1 %2)) 2) orig result)))))
|
||||
|
||||
(t/deftest ac-rgb-to-hsl
|
||||
;; Black: h=0, s=0.0, l=0.0 (s is 0.0 not 0 on JVM, and ##NaN for white)
|
||||
(let [[h s l] (c/rgb->hsl [0 0 0])]
|
||||
(t/is (= 0 h))
|
||||
(t/is (mth/close? l 0.0)))
|
||||
;; White: h=0, s=##NaN (achromatic), l=1.0
|
||||
(let [[_ _ l] (c/rgb->hsl [255 255 255])]
|
||||
(t/is (mth/close? l 1.0)))
|
||||
;; Red [255 0 0] → hue=0, saturation=1, lightness=0.5
|
||||
(let [[h s l] (c/rgb->hsl [255 0 0])]
|
||||
(t/is (mth/close? h 0.0))
|
||||
(t/is (mth/close? s 1.0))
|
||||
(t/is (mth/close? l 0.5))))
|
||||
|
||||
(t/deftest ac-hsl-to-rgb
|
||||
(t/is (= [0 0 0] (c/hsl->rgb [0 0 0])))
|
||||
(t/is (= [255 255 255] (c/hsl->rgb [0 0 1])))
|
||||
(t/is (= [1 2 3] (c/hsl->rgb [210.0 0.5 0.00784313725490196])))
|
||||
;; Achromatic (s=0): all channels equal lightness*255
|
||||
(let [[r g b] (c/hsl->rgb [0 0 0.5])]
|
||||
(t/is (= r g b))))
|
||||
|
||||
(t/deftest ac-rgb-hsl-roundtrip
|
||||
(let [orig [100 150 200]
|
||||
hsl (c/rgb->hsl orig)
|
||||
result (c/hsl->rgb hsl)]
|
||||
(t/is (every? true? (map #(< (mth/abs (- %1 %2)) 2) orig result)))))
|
||||
|
||||
(t/deftest ac-hex-to-hsv
|
||||
;; Black: h=0, s=0, v=0 (integers on JVM)
|
||||
(let [[h s v] (c/hex->hsv "#000000")]
|
||||
(t/is (= 0 h))
|
||||
(t/is (= 0 s))
|
||||
(t/is (= 0 v)))
|
||||
;; Red: h=0, s=1, v=255
|
||||
(let [[h s v] (c/hex->hsv "#ff0000")]
|
||||
(t/is (mth/close? h 0.0))
|
||||
(t/is (mth/close? s 1.0))
|
||||
(t/is (= 255 v))))
|
||||
|
||||
(t/deftest ac-hex-to-rgba
|
||||
(t/is (= [0 0 0 1.0] (c/hex->rgba "#000000" 1.0)))
|
||||
(t/is (= [255 255 255 0.5] (c/hex->rgba "#ffffff" 0.5)))
|
||||
(t/is (= [1 2 3 0.8] (c/hex->rgba "#010203" 0.8))))
|
||||
|
||||
(t/deftest ac-hex-to-hsl
|
||||
;; Black: h=0, s=0.0, l=0.0
|
||||
(let [[h s l] (c/hex->hsl "#000000")]
|
||||
(t/is (= 0 h))
|
||||
(t/is (mth/close? s 0.0))
|
||||
(t/is (mth/close? l 0.0)))
|
||||
;; Invalid hex falls back to [0 0 0]
|
||||
(let [[h _ _] (c/hex->hsl "invalid")]
|
||||
(t/is (= 0 h))))
|
||||
|
||||
(t/deftest ac-hex-to-hsla
|
||||
;; Black + full opacity: h=0, s=0.0, l=0.0, a=1.0
|
||||
(let [[h s l a] (c/hex->hsla "#000000" 1.0)]
|
||||
(t/is (= 0 h))
|
||||
(t/is (mth/close? s 0.0))
|
||||
(t/is (mth/close? l 0.0))
|
||||
(t/is (= a 1.0)))
|
||||
;; White + half opacity: l=1.0, a=0.5
|
||||
(let [[_ _ l a] (c/hex->hsla "#ffffff" 0.5)]
|
||||
(t/is (mth/close? l 1.0))
|
||||
(t/is (= a 0.5))))
|
||||
|
||||
(t/deftest ac-hsl-to-hex
|
||||
(t/is (= "#000000" (c/hsl->hex [0 0 0])))
|
||||
(t/is (= "#ffffff" (c/hsl->hex [0 0 1])))
|
||||
(t/is (= "#ff0000" (c/hsl->hex [0 1 0.5]))))
|
||||
|
||||
(t/deftest ac-hsl-to-hsv
|
||||
;; Black: stays [0 0 0]
|
||||
(let [[h s v] (c/hsl->hsv [0 0 0])]
|
||||
(t/is (= 0 h))
|
||||
(t/is (= 0 s))
|
||||
(t/is (= 0 v)))
|
||||
;; Red: hsl [0 1 0.5] → hsv h≈0, s≈1, v≈255
|
||||
(let [[h s v] (c/hsl->hsv [0 1 0.5])]
|
||||
(t/is (mth/close? h 0.0))
|
||||
(t/is (mth/close? s 1.0))
|
||||
(t/is (mth/close? v 255.0))))
|
||||
|
||||
(t/deftest ac-hsv-to-hex
|
||||
(t/is (= "#000000" (c/hsv->hex [0 0 0])))
|
||||
(t/is (= "#ffffff" (c/hsv->hex [0 0 255]))))
|
||||
|
||||
(t/deftest ac-hsv-to-hsl
|
||||
;; Black
|
||||
(let [[h s l] (c/hsv->hsl [0 0 0])]
|
||||
(t/is (= 0 h))
|
||||
(t/is (mth/close? s 0.0))
|
||||
(t/is (mth/close? l 0.0)))
|
||||
;; White: h=0, s=##NaN (achromatic), l=1.0
|
||||
(let [[_ _ l] (c/hsv->hsl [0 0 255])]
|
||||
(t/is (mth/close? l 1.0))))
|
||||
|
||||
(t/deftest ac-hex-to-lum
|
||||
;; Black has luminance 0
|
||||
(t/is (= 0.0 (c/hex->lum "#000000")))
|
||||
;; White has max luminance
|
||||
(let [lum (c/hex->lum "#ffffff")]
|
||||
(t/is (> lum 0)))
|
||||
;; Luminance is non-negative
|
||||
(t/is (>= (c/hex->lum "#fabada") 0)))
|
||||
|
||||
;; --- Formatters
|
||||
|
||||
(t/deftest ac-format-hsla
|
||||
(t/is (= "210 50% 0.78% / 1" (c/format-hsla [210.0 0.5 0.00784313725490196 1])))
|
||||
(t/is (= "220 5% 30% / 0.8" (c/format-hsla [220.0 0.05 0.3 0.8])))
|
||||
(t/is (= "0 0% 0% / 0" (c/format-hsla [0 0 0 0]))))
|
||||
|
||||
(t/deftest ac-format-rgba
|
||||
(t/is (= "210, 199, 12, 0.08" (c/format-rgba [210 199 12 0.08])))
|
||||
(t/is (= "0, 0, 0, 1" (c/format-rgba [0 0 0 1])))
|
||||
(t/is (= "255, 255, 255, 0.5" (c/format-rgba [255 255 255 0.5]))))
|
||||
|
||||
;; --- String utilities
|
||||
|
||||
(t/deftest ac-expand-hex
|
||||
;; Single char: repeated 6 times
|
||||
(t/is (= "aaaaaa" (c/expand-hex "a")))
|
||||
;; Two chars: repeated as 3 pairs
|
||||
(t/is (= "aaaaaa" (c/expand-hex "aa")))
|
||||
;; Three chars: each char doubled
|
||||
(t/is (= "aabbcc" (c/expand-hex "abc")))
|
||||
;; Other lengths: returned as-is
|
||||
(t/is (= "aaaa" (c/expand-hex "aaaa")))
|
||||
(t/is (= "aaaaaa" (c/expand-hex "aaaaaa"))))
|
||||
|
||||
(t/deftest ac-prepend-hash
|
||||
(t/is (= "#fabada" (c/prepend-hash "fabada")))
|
||||
;; Already has hash: unchanged
|
||||
(t/is (= "#fabada" (c/prepend-hash "#fabada"))))
|
||||
|
||||
(t/deftest ac-remove-hash
|
||||
(t/is (= "fabada" (c/remove-hash "#fabada")))
|
||||
;; No hash: unchanged
|
||||
(t/is (= "fabada" (c/remove-hash "fabada"))))
|
||||
|
||||
;; --- High-level predicates / parsing
|
||||
|
||||
(t/deftest ac-color-string
|
||||
(t/is (true? (c/color-string? "#aaa")))
|
||||
(t/is (true? (c/color-string? "#fabada")))
|
||||
(t/is (true? (c/color-string? "rgb(10,10,10)")))
|
||||
(t/is (true? (c/color-string? "(10,10,10)")))
|
||||
(t/is (true? (c/color-string? "magenta")))
|
||||
(t/is (false? (c/color-string? nil)))
|
||||
(t/is (false? (c/color-string? "")))
|
||||
(t/is (false? (c/color-string? "notacolor"))))
|
||||
|
||||
(t/deftest ac-parse
|
||||
;; Valid hex → normalized lowercase
|
||||
(t/is (= "#fabada" (c/parse "#fabada")))
|
||||
(t/is (= "#fabada" (c/parse "#FABADA")))
|
||||
;; Short hex → expanded+normalized
|
||||
(t/is (= "#aaaaaa" (c/parse "#aaa")))
|
||||
;; Hex without hash: normalize-hex is called, returns lowercase without adding #
|
||||
(t/is (= "fabada" (c/parse "fabada")))
|
||||
;; Named color
|
||||
(t/is (= "#ff0000" (c/parse "red")))
|
||||
(t/is (= "#ff00ff" (c/parse "magenta")))
|
||||
;; rgb() notation
|
||||
(t/is (= "#ff1e1e" (c/parse "rgb(255, 30, 30)")))
|
||||
;; Invalid → nil
|
||||
(t/is (nil? (c/parse "notacolor")))
|
||||
(t/is (nil? (c/parse nil))))
|
||||
|
||||
;; --- next-rgb
|
||||
|
||||
(t/deftest ac-next-rgb
|
||||
;; Increment blue channel
|
||||
(t/is (= [0 0 1] (c/next-rgb [0 0 0])))
|
||||
(t/is (= [0 0 255] (c/next-rgb [0 0 254])))
|
||||
;; Blue overflow: increment green, reset blue
|
||||
(t/is (= [0 1 0] (c/next-rgb [0 0 255])))
|
||||
;; Green overflow: increment red, reset green
|
||||
(t/is (= [1 0 0] (c/next-rgb [0 255 255])))
|
||||
;; White overflows: throws
|
||||
(t/is (thrown? #?(:clj Exception :cljs :default)
|
||||
(c/next-rgb [255 255 255]))))
|
||||
|
||||
;; --- reduce-range
|
||||
|
||||
(t/deftest ac-reduce-range
|
||||
(t/is (= 0.5 (c/reduce-range 0.5 2)))
|
||||
(t/is (= 0.0 (c/reduce-range 0.1 2)))
|
||||
(t/is (= 0.25 (c/reduce-range 0.3 4)))
|
||||
(t/is (= 0.0 (c/reduce-range 0.0 10))))
|
||||
|
||||
;; --- Gradient helpers
|
||||
|
||||
(t/deftest ac-interpolate-color
|
||||
(let [c1 {:color "#000000" :opacity 0.0 :offset 0.0}
|
||||
c2 {:color "#ffffff" :opacity 1.0 :offset 1.0}]
|
||||
;; At c1's offset → c1 with updated offset
|
||||
(let [result (c/interpolate-color c1 c2 0.0)]
|
||||
(t/is (= "#000000" (:color result)))
|
||||
(t/is (= 0.0 (:opacity result))))
|
||||
;; At c2's offset → c2 with updated offset
|
||||
(let [result (c/interpolate-color c1 c2 1.0)]
|
||||
(t/is (= "#ffffff" (:color result)))
|
||||
(t/is (= 1.0 (:opacity result))))
|
||||
;; At midpoint → gray
|
||||
(let [result (c/interpolate-color c1 c2 0.5)]
|
||||
(t/is (= "#7f7f7f" (:color result)))
|
||||
(t/is (mth/close? (:opacity result) 0.5)))))
|
||||
|
||||
(t/deftest ac-uniform-spread
|
||||
(let [c1 {:color "#000000" :opacity 0.0 :offset 0.0}
|
||||
c2 {:color "#ffffff" :opacity 1.0 :offset 1.0}
|
||||
stops (c/uniform-spread c1 c2 3)]
|
||||
(t/is (= 3 (count stops)))
|
||||
(t/is (= 0.0 (:offset (first stops))))
|
||||
(t/is (mth/close? 0.5 (:offset (second stops))))
|
||||
(t/is (= 1.0 (:offset (last stops))))))
|
||||
|
||||
(t/deftest ac-uniform-spread?
|
||||
(let [c1 {:color "#000000" :opacity 0.0 :offset 0.0}
|
||||
c2 {:color "#ffffff" :opacity 1.0 :offset 1.0}
|
||||
stops (c/uniform-spread c1 c2 3)]
|
||||
;; A uniformly spread result should pass the predicate
|
||||
(t/is (true? (c/uniform-spread? stops))))
|
||||
;; Manual non-uniform stops should not pass
|
||||
(let [stops [{:color "#000000" :opacity 0.0 :offset 0.0}
|
||||
{:color "#888888" :opacity 0.5 :offset 0.3}
|
||||
{:color "#ffffff" :opacity 1.0 :offset 1.0}]]
|
||||
(t/is (false? (c/uniform-spread? stops)))))
|
||||
|
||||
(t/deftest ac-interpolate-gradient
|
||||
(let [stops [{:color "#000000" :opacity 0.0 :offset 0.0}
|
||||
{:color "#ffffff" :opacity 1.0 :offset 1.0}]]
|
||||
;; At start
|
||||
(let [result (c/interpolate-gradient stops 0.0)]
|
||||
(t/is (= "#000000" (:color result))))
|
||||
;; At end
|
||||
(let [result (c/interpolate-gradient stops 1.0)]
|
||||
(t/is (= "#ffffff" (:color result))))
|
||||
;; In the middle
|
||||
(let [result (c/interpolate-gradient stops 0.5)]
|
||||
(t/is (= "#7f7f7f" (:color result))))))
|
||||
|
||||
|
||||
@@ -9,6 +9,144 @@
|
||||
[app.common.data :as d]
|
||||
[clojure.test :as t]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Basic Predicates
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest boolean-or-nil-predicate
|
||||
(t/is (d/boolean-or-nil? nil))
|
||||
(t/is (d/boolean-or-nil? true))
|
||||
(t/is (d/boolean-or-nil? false))
|
||||
(t/is (not (d/boolean-or-nil? 0)))
|
||||
(t/is (not (d/boolean-or-nil? "")))
|
||||
(t/is (not (d/boolean-or-nil? :kw))))
|
||||
|
||||
(t/deftest in-range-predicate
|
||||
(t/is (d/in-range? 5 0))
|
||||
(t/is (d/in-range? 5 4))
|
||||
(t/is (not (d/in-range? 5 5)))
|
||||
(t/is (not (d/in-range? 5 -1)))
|
||||
(t/is (not (d/in-range? 0 0))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Ordered Data Structures
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest ordered-set-creation
|
||||
(let [s (d/ordered-set)]
|
||||
(t/is (d/ordered-set? s))
|
||||
(t/is (empty? s)))
|
||||
(let [s (d/ordered-set :a)]
|
||||
(t/is (d/ordered-set? s))
|
||||
(t/is (contains? s :a)))
|
||||
(let [s (d/ordered-set :a :b :c)]
|
||||
(t/is (d/ordered-set? s))
|
||||
(t/is (= (seq s) [:a :b :c]))))
|
||||
|
||||
(t/deftest ordered-set-preserves-order
|
||||
(let [s (d/ordered-set :c :a :b)]
|
||||
(t/is (= (seq s) [:c :a :b])))
|
||||
;; Duplicates are ignored; order of first insertion is kept
|
||||
(let [s (-> (d/ordered-set) (conj :a) (conj :b) (conj :a))]
|
||||
(t/is (= (seq s) [:a :b]))))
|
||||
|
||||
(t/deftest ordered-map-creation
|
||||
(let [m (d/ordered-map)]
|
||||
(t/is (d/ordered-map? m))
|
||||
(t/is (empty? m)))
|
||||
(let [m (d/ordered-map :a 1)]
|
||||
(t/is (d/ordered-map? m))
|
||||
(t/is (= (get m :a) 1)))
|
||||
(let [m (d/ordered-map :a 1 :b 2)]
|
||||
(t/is (d/ordered-map? m))
|
||||
(t/is (= (keys m) [:a :b]))))
|
||||
|
||||
(t/deftest ordered-map-preserves-insertion-order
|
||||
(let [m (-> (d/ordered-map)
|
||||
(assoc :c 3)
|
||||
(assoc :a 1)
|
||||
(assoc :b 2))]
|
||||
(t/is (= (keys m) [:c :a :b]))))
|
||||
|
||||
(t/deftest oassoc-test
|
||||
;; oassoc on nil creates a new ordered-map
|
||||
(let [m (d/oassoc nil :a 1 :b 2)]
|
||||
(t/is (d/ordered-map? m))
|
||||
(t/is (= (get m :a) 1))
|
||||
(t/is (= (get m :b) 2)))
|
||||
;; oassoc on existing ordered-map updates it
|
||||
(let [m (d/oassoc (d/ordered-map :x 10) :y 20)]
|
||||
(t/is (= (get m :x) 10))
|
||||
(t/is (= (get m :y) 20))))
|
||||
|
||||
(t/deftest oassoc-in-test
|
||||
(let [m (d/oassoc-in nil [:a :b] 42)]
|
||||
(t/is (d/ordered-map? m))
|
||||
(t/is (= (get-in m [:a :b]) 42)))
|
||||
(let [m (-> (d/ordered-map)
|
||||
(d/oassoc-in [:x :y] 1)
|
||||
(d/oassoc-in [:x :z] 2))]
|
||||
(t/is (= (get-in m [:x :y]) 1))
|
||||
(t/is (= (get-in m [:x :z]) 2))))
|
||||
|
||||
(t/deftest oupdate-in-test
|
||||
(let [m (-> (d/ordered-map)
|
||||
(d/oassoc-in [:a :b] 10)
|
||||
(d/oupdate-in [:a :b] + 5))]
|
||||
(t/is (= (get-in m [:a :b]) 15))))
|
||||
|
||||
(t/deftest oassoc-before-test
|
||||
(let [m (-> (d/ordered-map)
|
||||
(assoc :a 1)
|
||||
(assoc :b 2)
|
||||
(assoc :c 3))
|
||||
m2 (d/oassoc-before m :b :x 99)]
|
||||
;; :x should be inserted just before :b
|
||||
(t/is (= (keys m2) [:a :x :b :c]))
|
||||
(t/is (= (get m2 :x) 99)))
|
||||
;; When before-k does not exist, assoc at the end
|
||||
(let [m (-> (d/ordered-map) (assoc :a 1))
|
||||
m2 (d/oassoc-before m :z :x 99)]
|
||||
(t/is (= (get m2 :x) 99))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Ordered Set / Map Index Helpers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest adds-at-index-test
|
||||
(let [s (d/ordered-set :a :b :c)
|
||||
s2 (d/adds-at-index s 1 :x)]
|
||||
(t/is (= (seq s2) [:a :x :b :c])))
|
||||
(let [s (d/ordered-set :a :b :c)
|
||||
s2 (d/adds-at-index s 0 :x)]
|
||||
(t/is (= (seq s2) [:x :a :b :c])))
|
||||
(let [s (d/ordered-set :a :b :c)
|
||||
s2 (d/adds-at-index s 3 :x)]
|
||||
(t/is (= (seq s2) [:a :b :c :x]))))
|
||||
|
||||
(t/deftest inserts-at-index-test
|
||||
(let [s (d/ordered-set :a :b :c)
|
||||
s2 (d/inserts-at-index s 1 [:x :y])]
|
||||
(t/is (= (seq s2) [:a :x :y :b :c])))
|
||||
(let [s (d/ordered-set :a :b :c)
|
||||
s2 (d/inserts-at-index s 0 [:x])]
|
||||
(t/is (= (seq s2) [:x :a :b :c]))))
|
||||
|
||||
(t/deftest addm-at-index-test
|
||||
(let [m (-> (d/ordered-map) (assoc :a 1) (assoc :b 2) (assoc :c 3))
|
||||
m2 (d/addm-at-index m 1 :x 99)]
|
||||
(t/is (= (keys m2) [:a :x :b :c]))
|
||||
(t/is (= (get m2 :x) 99))))
|
||||
|
||||
(t/deftest insertm-at-index-test
|
||||
(let [m (-> (d/ordered-map) (assoc :a 1) (assoc :b 2) (assoc :c 3))
|
||||
m2 (d/insertm-at-index m 1 (d/ordered-map :x 10 :y 20))]
|
||||
(t/is (= (keys m2) [:a :x :y :b :c]))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Concat / remove helpers (pre-existing tests preserved)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest concat-vec
|
||||
(t/is (= [] (d/concat-vec)))
|
||||
(t/is (= [1] (d/concat-vec [1])))
|
||||
@@ -137,3 +275,657 @@
|
||||
(t/is (= (d/nth-index-of "abc*def*ghi" "*" 1) 3))
|
||||
(t/is (= (d/nth-index-of "abc*def*ghi" "*" 2) 7))
|
||||
(t/is (= (d/nth-index-of "abc*def*ghi" "*" 3) nil)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Lazy / sequence helpers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest concat-all-test
|
||||
(t/is (= [1 2 3 4 5 6]
|
||||
(d/concat-all [[1 2] [3 4] [5 6]])))
|
||||
(t/is (= [] (d/concat-all [])))
|
||||
(t/is (= [1 2 3]
|
||||
(d/concat-all [[1] [2] [3]])))
|
||||
;; It's lazy — works with infinite-ish inner seqs truncated by outer limit
|
||||
(t/is (= [0 1 2]
|
||||
(take 3 (d/concat-all (map list (range)))))))
|
||||
|
||||
(t/deftest mapcat-test
|
||||
(t/is (= [0 1 1 2 2 3]
|
||||
(d/mapcat (fn [x] [x (inc x)]) [0 1 2])))
|
||||
;; fully lazy — can operate on infinite sequences
|
||||
(t/is (= [0 0 1 1 2 2]
|
||||
(take 6 (d/mapcat (fn [x] [x x]) (range))))))
|
||||
|
||||
(t/deftest zip-test
|
||||
(t/is (= [[1 :a] [2 :b] [3 :c]]
|
||||
(d/zip [1 2 3] [:a :b :c])))
|
||||
(t/is (= [] (d/zip [] []))))
|
||||
|
||||
(t/deftest zip-all-test
|
||||
;; same length
|
||||
(t/is (= [[1 :a] [2 :b]]
|
||||
(d/zip-all [1 2] [:a :b])))
|
||||
;; col1 longer — col2 padded with nils
|
||||
(t/is (= [[1 :a] [2 nil] [3 nil]]
|
||||
(d/zip-all [1 2 3] [:a])))
|
||||
;; col2 longer — col1 padded with nils
|
||||
(t/is (= [[1 :a] [nil :b] [nil :c]]
|
||||
(d/zip-all [1] [:a :b :c]))))
|
||||
|
||||
(t/deftest enumerate-test
|
||||
(t/is (= [[0 :a] [1 :b] [2 :c]]
|
||||
(d/enumerate [:a :b :c])))
|
||||
(t/is (= [[5 :a] [6 :b]]
|
||||
(d/enumerate [:a :b] 5)))
|
||||
(t/is (= [] (d/enumerate []))))
|
||||
|
||||
(t/deftest interleave-all-test
|
||||
(t/is (= [] (d/interleave-all)))
|
||||
(t/is (= [1 2 3] (d/interleave-all [1 2 3])))
|
||||
(t/is (= [1 :a 2 :b 3 :c]
|
||||
(d/interleave-all [1 2 3] [:a :b :c])))
|
||||
;; unequal lengths — longer seq is not truncated
|
||||
(t/is (= [1 :a 2 :b 3]
|
||||
(d/interleave-all [1 2 3] [:a :b])))
|
||||
(t/is (= [1 :a 2 :b :c]
|
||||
(d/interleave-all [1 2] [:a :b :c]))))
|
||||
|
||||
(t/deftest add-at-index-test
|
||||
(t/is (= [:a :x :b :c] (d/add-at-index [:a :b :c] 1 :x)))
|
||||
(t/is (= [:x :a :b :c] (d/add-at-index [:a :b :c] 0 :x)))
|
||||
(t/is (= [:a :b :c :x] (d/add-at-index [:a :b :c] 3 :x))))
|
||||
|
||||
(t/deftest take-until-test
|
||||
;; stops (inclusive) when predicate is true
|
||||
(t/is (= [1 2 3] (d/take-until #(= % 3) [1 2 3 4 5])))
|
||||
;; if predicate never true, returns whole collection
|
||||
(t/is (= [1 2 3] (d/take-until #(= % 9) [1 2 3])))
|
||||
;; first element matches
|
||||
(t/is (= [1] (d/take-until #(= % 1) [1 2 3]))))
|
||||
|
||||
(t/deftest safe-subvec-test
|
||||
;; normal range
|
||||
(t/is (= [2 3] (d/safe-subvec [1 2 3 4] 1 3)))
|
||||
;; single arg — from index to end
|
||||
(t/is (= [2 3 4] (d/safe-subvec [1 2 3 4] 1)))
|
||||
;; out-of-range returns nil
|
||||
(t/is (nil? (d/safe-subvec [1 2 3] 5)))
|
||||
(t/is (nil? (d/safe-subvec [1 2 3] 0 5)))
|
||||
;; nil v returns nil
|
||||
(t/is (nil? (d/safe-subvec nil 0 1))))
|
||||
|
||||
(t/deftest domap-test
|
||||
(let [side-effects (atom [])
|
||||
result (d/domap #(swap! side-effects conj %) [1 2 3])]
|
||||
(t/is (= [1 2 3] result))
|
||||
(t/is (= [1 2 3] @side-effects)))
|
||||
;; transducer arity
|
||||
(let [side-effects (atom [])]
|
||||
(into [] (d/domap #(swap! side-effects conj %)) [4 5])
|
||||
(t/is (= [4 5] @side-effects))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Collection lookup helpers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest group-by-test
|
||||
(t/is (= {:odd [1 3] :even [2 4]}
|
||||
(d/group-by #(if (odd? %) :odd :even) [1 2 3 4])))
|
||||
;; two-arity with value function
|
||||
(t/is (= {:odd [10 30] :even [20 40]}
|
||||
(d/group-by #(if (odd? %) :odd :even) #(* % 10) [1 2 3 4])))
|
||||
;; three-arity with initial value
|
||||
(t/is (= {:a #{1} :b #{2}}
|
||||
(d/group-by :k :v #{} [{:k :a :v 1} {:k :b :v 2}]))))
|
||||
|
||||
(t/deftest seek-test
|
||||
(t/is (= 3 (d/seek odd? [2 4 3 5])))
|
||||
(t/is (nil? (d/seek odd? [2 4 6])))
|
||||
(t/is (= :default (d/seek odd? [2 4 6] :default)))
|
||||
(t/is (= 1 (d/seek some? [nil nil 1 2]))))
|
||||
|
||||
(t/deftest index-by-test
|
||||
(t/is (= {1 {:id 1 :name "a"} 2 {:id 2 :name "b"}}
|
||||
(d/index-by :id [{:id 1 :name "a"} {:id 2 :name "b"}])))
|
||||
;; two-arity with value fn
|
||||
(t/is (= {1 "a" 2 "b"}
|
||||
(d/index-by :id :name [{:id 1 :name "a"} {:id 2 :name "b"}]))))
|
||||
|
||||
(t/deftest index-of-pred-test
|
||||
(t/is (= 0 (d/index-of-pred [1 2 3] odd?)))
|
||||
(t/is (= 1 (d/index-of-pred [2 3 4] odd?)))
|
||||
(t/is (nil? (d/index-of-pred [2 4 6] odd?)))
|
||||
(t/is (nil? (d/index-of-pred [] odd?))))
|
||||
|
||||
(t/deftest index-of-test
|
||||
(t/is (= 0 (d/index-of [:a :b :c] :a)))
|
||||
(t/is (= 2 (d/index-of [:a :b :c] :c)))
|
||||
(t/is (nil? (d/index-of [:a :b :c] :z))))
|
||||
|
||||
(t/deftest replace-by-id-test
|
||||
(let [items [{:id 1 :v "a"} {:id 2 :v "b"} {:id 3 :v "c"}]
|
||||
new-v {:id 2 :v "x"}]
|
||||
(t/is (= [{:id 1 :v "a"} {:id 2 :v "x"} {:id 3 :v "c"}]
|
||||
(d/replace-by-id items new-v)))
|
||||
;; transducer arity
|
||||
(t/is (= [{:id 1 :v "a"} {:id 2 :v "x"} {:id 3 :v "c"}]
|
||||
(sequence (d/replace-by-id new-v) items)))))
|
||||
|
||||
(t/deftest getf-test
|
||||
(let [m {:a 1 :b 2}
|
||||
get-from-m (d/getf m)]
|
||||
(t/is (= 1 (get-from-m :a)))
|
||||
(t/is (= 2 (get-from-m :b)))
|
||||
(t/is (nil? (get-from-m :z)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Map manipulation helpers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest vec-without-nils-test
|
||||
(t/is (= [1 2 3] (d/vec-without-nils [1 nil 2 nil 3])))
|
||||
(t/is (= [] (d/vec-without-nils [nil nil])))
|
||||
(t/is (= [1] (d/vec-without-nils [1]))))
|
||||
|
||||
(t/deftest without-nils-test
|
||||
(t/is (= {:a 1 :d 2} (d/without-nils {:a 1 :b nil :c nil :d 2 :e nil}))
|
||||
"removes all nil values")
|
||||
;; transducer arity — works on map entries
|
||||
(t/is (= {:a 1} (into {} (d/without-nils) {:a 1 :b nil}))))
|
||||
|
||||
(t/deftest without-qualified-test
|
||||
(t/is (= {:a 1} (d/without-qualified {:a 1 :ns/b 2 :ns/c 3})))
|
||||
;; transducer arity — works on map entries
|
||||
(t/is (= {:a 1} (into {} (d/without-qualified) {:a 1 :ns/b 2}))))
|
||||
|
||||
(t/deftest without-keys-test
|
||||
(t/is (= {:c 3} (d/without-keys {:a 1 :b 2 :c 3} [:a :b])))
|
||||
(t/is (= {:a 1 :b 2 :c 3} (d/without-keys {:a 1 :b 2 :c 3} []))))
|
||||
|
||||
(t/deftest deep-merge-test
|
||||
(t/is (= {:a 1 :b {:c 3 :d 4}}
|
||||
(d/deep-merge {:a 1 :b {:c 2 :d 4}} {:b {:c 3}})))
|
||||
;; non-map values get replaced
|
||||
(t/is (= {:a 2}
|
||||
(d/deep-merge {:a 1} {:a 2})))
|
||||
;; three-way merge
|
||||
(t/is (= {:a 1 :b 2 :c 3}
|
||||
(d/deep-merge {:a 1} {:b 2} {:c 3}))))
|
||||
|
||||
(t/deftest dissoc-in-test
|
||||
(t/is (= {:a {:b 1}} (d/dissoc-in {:a {:b 1 :c 2}} [:a :c])))
|
||||
;; removes parent when child map becomes empty
|
||||
(t/is (= {} (d/dissoc-in {:a {:b 1}} [:a :b])))
|
||||
;; no-op when path does not exist
|
||||
(t/is (= {:a 1} (d/dissoc-in {:a 1} [:b :c]))))
|
||||
|
||||
(t/deftest patch-object-test
|
||||
;; normal update
|
||||
(t/is (= {:a 2 :b 2} (d/patch-object {:a 1 :b 2} {:a 2})))
|
||||
;; nil value removes key
|
||||
(t/is (= {:b 2} (d/patch-object {:a 1 :b 2} {:a nil})))
|
||||
;; nested map is merged recursively
|
||||
(t/is (= {:a {:x 10 :y 2}} (d/patch-object {:a {:x 1 :y 2}} {:a {:x 10}})))
|
||||
;; nested nil removes nested key
|
||||
(t/is (= {:a {:y 2}} (d/patch-object {:a {:x 1 :y 2}} {:a {:x nil}})))
|
||||
;; transducer arity (1-arg returns a fn)
|
||||
(let [f (d/patch-object {:a 99})]
|
||||
(t/is (= {:a 99 :b 2} (f {:a 1 :b 2})))))
|
||||
|
||||
(t/deftest without-obj-test
|
||||
(t/is (= [1 3] (d/without-obj [1 2 3] 2)))
|
||||
(t/is (= [1 2 3] (d/without-obj [1 2 3] 9)))
|
||||
(t/is (= [] (d/without-obj [1] 1))))
|
||||
|
||||
(t/deftest update-vals-test
|
||||
(t/is (= {:a 2 :b 4} (d/update-vals {:a 1 :b 2} #(* % 2))))
|
||||
(t/is (= {} (d/update-vals {} identity))))
|
||||
|
||||
(t/deftest update-in-when-test
|
||||
;; key exists — applies function
|
||||
(t/is (= {:a {:b 2}} (d/update-in-when {:a {:b 1}} [:a :b] inc)))
|
||||
;; key absent — returns unchanged
|
||||
(t/is (= {:a 1} (d/update-in-when {:a 1} [:b :c] inc))))
|
||||
|
||||
(t/deftest update-when-test
|
||||
;; key exists — applies function
|
||||
(t/is (= {:a 2} (d/update-when {:a 1} :a inc)))
|
||||
;; key absent — returns unchanged
|
||||
(t/is (= {:a 1} (d/update-when {:a 1} :b inc))))
|
||||
|
||||
(t/deftest assoc-in-when-test
|
||||
;; key exists — updates value
|
||||
(t/is (= {:a {:b 99}} (d/assoc-in-when {:a {:b 1}} [:a :b] 99)))
|
||||
;; key absent — returns unchanged
|
||||
(t/is (= {:a 1} (d/assoc-in-when {:a 1} [:b :c] 99))))
|
||||
|
||||
(t/deftest assoc-when-test
|
||||
;; key exists — updates value
|
||||
(t/is (= {:a 99} (d/assoc-when {:a 1} :a 99)))
|
||||
;; key absent — returns unchanged
|
||||
(t/is (= {:a 1} (d/assoc-when {:a 1} :b 99))))
|
||||
|
||||
(t/deftest merge-test
|
||||
(t/is (= {:a 1 :b 2 :c 3}
|
||||
(d/merge {:a 1} {:b 2} {:c 3})))
|
||||
(t/is (= {:a 2}
|
||||
(d/merge {:a 1} {:a 2})))
|
||||
(t/is (= {} (d/merge))))
|
||||
|
||||
(t/deftest txt-merge-test
|
||||
;; sets value when not nil
|
||||
(t/is (= {:a 2 :b 2} (d/txt-merge {:a 1 :b 2} {:a 2})))
|
||||
;; removes key when value is nil
|
||||
(t/is (= {:b 2} (d/txt-merge {:a 1 :b 2} {:a nil})))
|
||||
;; adds new key
|
||||
(t/is (= {:a 1 :b 2 :c 3} (d/txt-merge {:a 1 :b 2} {:c 3}))))
|
||||
|
||||
(t/deftest mapm-test
|
||||
;; two-arity: transform map in place
|
||||
(t/is (= {:a 2 :b 4} (d/mapm (fn [k v] (* v 2)) {:a 1 :b 2})))
|
||||
;; one-arity: transducer
|
||||
(t/is (= {:a 10 :b 20}
|
||||
(into {} (d/mapm (fn [k v] (* v 10))) {:a 1 :b 2}))))
|
||||
|
||||
(t/deftest removev-test
|
||||
(t/is (= [2 4] (d/removev odd? [1 2 3 4])))
|
||||
(t/is (= [nil nil] (d/removev some? [nil nil])))
|
||||
(t/is (= [1 2 3] (d/removev nil? [1 nil 2 nil 3]))))
|
||||
|
||||
(t/deftest filterm-test
|
||||
(t/is (= {:a 1 :c 3} (d/filterm (fn [[_ v]] (odd? v)) {:a 1 :b 2 :c 3 :d 4}))
|
||||
"keeps entries where value is odd")
|
||||
(t/is (= {} (d/filterm (fn [[_ v]] (> v 10)) {:a 1 :b 2}))))
|
||||
|
||||
(t/deftest removem-test
|
||||
(t/is (= {:b 2 :d 4} (d/removem (fn [[_ v]] (odd? v)) {:a 1 :b 2 :c 3 :d 4})))
|
||||
(t/is (= {:a 1 :b 2} (d/removem (fn [[_ v]] (> v 10)) {:a 1 :b 2}))))
|
||||
|
||||
(t/deftest map-perm-test
|
||||
;; default: all pairs
|
||||
(t/is (= [[1 2] [1 3] [1 4] [2 3] [2 4] [3 4]]
|
||||
(d/map-perm vector [1 2 3 4])))
|
||||
;; with predicate
|
||||
(t/is (= [[1 3]]
|
||||
(d/map-perm vector (fn [a b] (and (odd? a) (odd? b))) [1 2 3])))
|
||||
;; empty collection
|
||||
(t/is (= [] (d/map-perm vector []))))
|
||||
|
||||
(t/deftest distinct-xf-test
|
||||
(t/is (= [1 2 3]
|
||||
(into [] (d/distinct-xf identity) [1 2 1 3 2])))
|
||||
;; keeps the first occurrence for each key
|
||||
(t/is (= [{:id 1 :v "a"} {:id 2 :v "x"}]
|
||||
(into [] (d/distinct-xf :id) [{:id 1 :v "a"} {:id 2 :v "x"} {:id 2 :v "b"}]))))
|
||||
|
||||
(t/deftest deep-mapm-test
|
||||
;; Note: mfn is called twice on leaf entries (once initially, once again
|
||||
;; after checking if the value is a map/vector), so a doubling fn applied
|
||||
;; to value 1 gives 1*2*2=4.
|
||||
(t/is (= {:a 4 :b {:c 8}}
|
||||
(d/deep-mapm (fn [[k v]] [k (if (number? v) (* v 2) v)])
|
||||
{:a 1 :b {:c 2}})))
|
||||
;; Keyword renaming: keys are also transformed — and applied twice.
|
||||
;; Use an idempotent key transformation (uppercase once = uppercase twice).
|
||||
(let [result (d/deep-mapm (fn [[k v]] [(keyword (str (name k) "!")) v])
|
||||
{:a 1})]
|
||||
(t/is (contains? result (keyword "a!!")))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Numeric helpers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest nan-test
|
||||
;; Note: nan? behaves differently per platform:
|
||||
;; - CLJS: uses js/isNaN, returns true for ##NaN
|
||||
;; - CLJ: uses (not= v v); Clojure's = uses .equals on doubles,
|
||||
;; so (= ##NaN ##NaN) is true and nan? returns false for ##NaN.
|
||||
;; Either way, nan? returns false for regular numbers and nil.
|
||||
(t/is (not (d/nan? 0)))
|
||||
(t/is (not (d/nan? 1)))
|
||||
(t/is (not (d/nan? nil)))
|
||||
;; Platform-specific: JS nan? correctly detects NaN
|
||||
#?(:cljs (t/is (d/nan? ##NaN))))
|
||||
|
||||
(t/deftest safe-plus-test
|
||||
(t/is (= 5 (d/safe+ 3 2)))
|
||||
;; when first arg is not finite, return it unchanged
|
||||
(t/is (= ##Inf (d/safe+ ##Inf 10))))
|
||||
|
||||
(t/deftest max-test
|
||||
(t/is (= 3 (d/max 3)))
|
||||
(t/is (= 5 (d/max 3 5)))
|
||||
(t/is (= 9 (d/max 1 9 4)))
|
||||
(t/is (= 10 (d/max 1 2 3 4 5 6 7 8 9 10))))
|
||||
|
||||
(t/deftest min-test
|
||||
(t/is (= 3 (d/min 3)))
|
||||
(t/is (= 3 (d/min 3 5)))
|
||||
(t/is (= 1 (d/min 1 9 4)))
|
||||
(t/is (= 1 (d/min 10 9 8 7 6 5 4 3 2 1))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Parsing helpers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest parse-integer-test
|
||||
(t/is (= 42 (d/parse-integer "42")))
|
||||
(t/is (= -1 (d/parse-integer "-1")))
|
||||
(t/is (nil? (d/parse-integer "abc")))
|
||||
(t/is (= 0 (d/parse-integer "abc" 0)))
|
||||
(t/is (nil? (d/parse-integer nil))))
|
||||
|
||||
(t/deftest parse-double-test
|
||||
(t/is (= 3.14 (d/parse-double "3.14")))
|
||||
(t/is (= -1.0 (d/parse-double "-1.0")))
|
||||
(t/is (nil? (d/parse-double "abc")))
|
||||
(t/is (= 0.0 (d/parse-double "abc" 0.0)))
|
||||
(t/is (nil? (d/parse-double nil))))
|
||||
|
||||
(t/deftest parse-uuid-test
|
||||
(let [uuid-str "550e8400-e29b-41d4-a716-446655440000"]
|
||||
(t/is (some? (d/parse-uuid uuid-str))))
|
||||
(t/is (nil? (d/parse-uuid "not-a-uuid")))
|
||||
(t/is (nil? (d/parse-uuid nil))))
|
||||
|
||||
(t/deftest coalesce-str-test
|
||||
;; On JVM: nan? uses (not= v v), which is false for all normal values.
|
||||
;; On CLJS: nan? uses js/isNaN, which is true for non-numeric strings.
|
||||
;; coalesce-str returns default when value is nil or nan?.
|
||||
(t/is (= "default" (d/coalesce-str nil "default")))
|
||||
;; Numbers always stringify on both platforms
|
||||
(t/is (= "42" (d/coalesce-str 42 "default")))
|
||||
;; ##NaN: nan? is true in CLJS, returns default;
|
||||
;; nan? is false in CLJ, so str(##NaN)="NaN" is returned.
|
||||
#?(:cljs (t/is (= "default" (d/coalesce-str ##NaN "default"))))
|
||||
#?(:clj (t/is (= "NaN" (d/coalesce-str ##NaN "default"))))
|
||||
;; Strings: in CLJS js/isNaN("hello")=true so "default" is returned;
|
||||
;; in CLJ nan? is false so (str "hello")="hello" is returned.
|
||||
#?(:cljs (t/is (= "default" (d/coalesce-str "hello" "default"))))
|
||||
#?(:clj (t/is (= "hello" (d/coalesce-str "hello" "default")))))
|
||||
|
||||
(t/deftest coalesce-test
|
||||
(t/is (= "hello" (d/coalesce "hello" "default")))
|
||||
(t/is (= "default" (d/coalesce nil "default")))
|
||||
;; coalesce uses `or`, so false is falsy and returns the default
|
||||
(t/is (= "default" (d/coalesce false "default")))
|
||||
(t/is (= 42 (d/coalesce 42 0))))
|
||||
|
||||
(t/deftest read-string-test
|
||||
(t/is (= {:a 1} (d/read-string "{:a 1}")))
|
||||
(t/is (= [1 2 3] (d/read-string "[1 2 3]")))
|
||||
(t/is (= :keyword (d/read-string ":keyword"))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; String / keyword helpers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest name-test
|
||||
(t/is (= "foo" (d/name :foo)))
|
||||
(t/is (= "foo" (d/name "foo")))
|
||||
(t/is (nil? (d/name nil)))
|
||||
(t/is (= "42" (d/name 42))))
|
||||
|
||||
(t/deftest prefix-keyword-test
|
||||
(t/is (= :prefix-test (d/prefix-keyword "prefix-" :test)))
|
||||
(t/is (= :ns-id (d/prefix-keyword :ns- :id)))
|
||||
(t/is (= :ab (d/prefix-keyword "a" "b"))))
|
||||
|
||||
(t/deftest kebab-keys-test
|
||||
(t/is (= {:foo-bar 1 :baz-qux 2}
|
||||
(d/kebab-keys {"fooBar" 1 "bazQux" 2})))
|
||||
(t/is (= {:my-key {:nested-key 1}}
|
||||
(d/kebab-keys {:myKey {:nestedKey 1}}))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Utility helpers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest regexp-test
|
||||
(t/is (d/regexp? #"foo"))
|
||||
(t/is (not (d/regexp? "foo")))
|
||||
(t/is (not (d/regexp? nil))))
|
||||
|
||||
(t/deftest nilf-test
|
||||
(let [safe-inc (d/nilf inc)]
|
||||
(t/is (nil? (safe-inc nil)))
|
||||
(t/is (= 2 (safe-inc 1))))
|
||||
(let [safe-add (d/nilf +)]
|
||||
(t/is (nil? (safe-add 1 nil)))
|
||||
(t/is (= 3 (safe-add 1 2)))))
|
||||
|
||||
(t/deftest nilv-test
|
||||
(t/is (= "default" (d/nilv nil "default")))
|
||||
(t/is (= "value" (d/nilv "value" "default")))
|
||||
(t/is (= false (d/nilv false "default")))
|
||||
;; transducer arity
|
||||
(t/is (= ["a" "default" "b"]
|
||||
(into [] (d/nilv "default") ["a" nil "b"]))))
|
||||
|
||||
(t/deftest any-key-test
|
||||
(t/is (d/any-key? {:a 1 :b 2} :a))
|
||||
(t/is (d/any-key? {:a 1 :b 2} :z :b))
|
||||
(t/is (not (d/any-key? {:a 1} :z :x))))
|
||||
|
||||
(t/deftest tap-test
|
||||
(let [received (atom nil)]
|
||||
(t/is (= [1 2 3] (d/tap #(reset! received %) [1 2 3])))
|
||||
(t/is (= [1 2 3] @received))))
|
||||
|
||||
(t/deftest tap-r-test
|
||||
(let [received (atom nil)]
|
||||
(t/is (= [1 2 3] (d/tap-r [1 2 3] #(reset! received %))))
|
||||
(t/is (= [1 2 3] @received))))
|
||||
|
||||
(t/deftest map-diff-test
|
||||
;; identical maps produce empty diff
|
||||
(t/is (= {} (d/map-diff {:a 1} {:a 1})))
|
||||
;; changed value
|
||||
(t/is (= {:a [1 2]} (d/map-diff {:a 1} {:a 2})))
|
||||
;; removed key
|
||||
(t/is (= {:b [2 nil]} (d/map-diff {:a 1 :b 2} {:a 1})))
|
||||
;; added key
|
||||
(t/is (= {:c [nil 3]} (d/map-diff {:a 1} {:a 1 :c 3})))
|
||||
;; nested diff
|
||||
(t/is (= {:b {:c [1 2]}} (d/map-diff {:b {:c 1}} {:b {:c 2}}))))
|
||||
|
||||
(t/deftest unique-name-test
|
||||
;; name not in used set — returned as-is
|
||||
(t/is (= "foo" (d/unique-name "foo" #{})))
|
||||
;; name already used — append counter
|
||||
(t/is (= "foo-1" (d/unique-name "foo" #{"foo"})))
|
||||
(t/is (= "foo-2" (d/unique-name "foo" #{"foo" "foo-1"})))
|
||||
;; name already has numeric suffix
|
||||
(t/is (= "foo-2" (d/unique-name "foo-1" #{"foo-1"})))
|
||||
;; prefix-first? mode — skips foo-1 (counter=1 returns bare prefix)
|
||||
;; so with #{} not used, still returns "foo"
|
||||
(t/is (= "foo" (d/unique-name "foo" #{} true)))
|
||||
;; with prefix-first? and "foo" used, counter=1 produces "foo" again (used),
|
||||
;; so jumps to counter=2 → "foo-2"
|
||||
(t/is (= "foo-2" (d/unique-name "foo" #{"foo"} true))))
|
||||
|
||||
(t/deftest toggle-selection-test
|
||||
;; without toggle, always returns set with just the value
|
||||
(let [s (d/ordered-set :a :b)]
|
||||
(t/is (= (d/ordered-set :c) (d/toggle-selection s :c))))
|
||||
;; with toggle=true, adds if not present
|
||||
(let [s (d/ordered-set :a)]
|
||||
(t/is (contains? (d/toggle-selection s :b true) :b)))
|
||||
;; with toggle=true, removes if already present
|
||||
(let [s (d/ordered-set :a :b)]
|
||||
(t/is (not (contains? (d/toggle-selection s :a true) :a)))))
|
||||
|
||||
(t/deftest invert-map-test
|
||||
(t/is (= {1 :a 2 :b} (d/invert-map {:a 1 :b 2})))
|
||||
(t/is (= {} (d/invert-map {}))))
|
||||
|
||||
(t/deftest obfuscate-string-test
|
||||
;; short string (< 10) — all stars
|
||||
(t/is (= "****" (d/obfuscate-string "abcd")))
|
||||
;; long string — first 5 chars kept
|
||||
(t/is (= "hello*****" (d/obfuscate-string "helloworld")))
|
||||
;; full? mode
|
||||
(t/is (= "***" (d/obfuscate-string "abc" true)))
|
||||
;; empty string
|
||||
(t/is (= "" (d/obfuscate-string ""))))
|
||||
|
||||
(t/deftest unstable-sort-test
|
||||
(t/is (= [1 2 3 4] (d/unstable-sort [3 1 4 2])))
|
||||
;; In CLJS, garray/sort requires a comparator returning -1/0/1 (not boolean).
|
||||
;; Use compare with reversed args for descending sort on both platforms.
|
||||
(t/is (= [4 3 2 1] (d/unstable-sort #(compare %2 %1) [3 1 4 2])))
|
||||
;; Empty collection: CLJ returns '(), CLJS returns nil (from seq on [])
|
||||
(t/is (empty? (d/unstable-sort []))))
|
||||
|
||||
(t/deftest opacity-to-hex-test
|
||||
;; opacity-to-hex uses JavaScript number methods (.toString 16 / .padStart)
|
||||
;; so it only produces output in CLJS environments.
|
||||
#?(:cljs (t/is (= "ff" (d/opacity-to-hex 1))))
|
||||
#?(:cljs (t/is (= "00" (d/opacity-to-hex 0))))
|
||||
#?(:cljs (t/is (= "80" (d/opacity-to-hex (/ 128 255)))))
|
||||
#?(:clj (t/is true "opacity-to-hex is CLJS-only")))
|
||||
|
||||
(t/deftest format-precision-test
|
||||
(t/is (= "12" (d/format-precision 12.0123 0)))
|
||||
(t/is (= "12" (d/format-precision 12.0123 1)))
|
||||
(t/is (= "12.01" (d/format-precision 12.0123 2)))
|
||||
(t/is (= "12.012" (d/format-precision 12.0123 3)))
|
||||
(t/is (= "0.1" (d/format-precision 0.1 2))))
|
||||
|
||||
(t/deftest format-number-test
|
||||
(t/is (= "3.14" (d/format-number 3.14159)))
|
||||
(t/is (= "3" (d/format-number 3.0)))
|
||||
(t/is (= "3.14" (d/format-number "3.14159")))
|
||||
(t/is (nil? (d/format-number nil)))
|
||||
(t/is (= "3.1416" (d/format-number 3.14159 {:precision 4}))))
|
||||
|
||||
(t/deftest append-class-test
|
||||
(t/is (= "foo bar" (d/append-class "foo" "bar")))
|
||||
(t/is (= "bar" (d/append-class nil "bar")))
|
||||
(t/is (= " bar" (d/append-class "" "bar"))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Additional helpers (5th batch)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest not-empty-predicate
|
||||
(t/is (d/not-empty? [1 2 3]))
|
||||
(t/is (d/not-empty? {:a 1}))
|
||||
(t/is (d/not-empty? "abc"))
|
||||
(t/is (not (d/not-empty? [])))
|
||||
(t/is (not (d/not-empty? {})))
|
||||
(t/is (not (d/not-empty? nil))))
|
||||
|
||||
(t/deftest editable-collection-predicate
|
||||
(t/is (d/editable-collection? []))
|
||||
(t/is (d/editable-collection? [1 2 3]))
|
||||
(t/is (d/editable-collection? {}))
|
||||
(t/is (d/editable-collection? {:a 1}))
|
||||
(t/is (not (d/editable-collection? nil)))
|
||||
(t/is (not (d/editable-collection? "hello")))
|
||||
(t/is (not (d/editable-collection? 42))))
|
||||
|
||||
(t/deftest num-predicate
|
||||
(t/is (d/num? 1))
|
||||
(t/is (d/num? 0))
|
||||
(t/is (d/num? -3.14))
|
||||
(t/is (not (d/num? ##NaN)))
|
||||
(t/is (not (d/num? ##Inf)))
|
||||
(t/is (not (d/num? nil)))
|
||||
;; In CLJS, js/isFinite coerces strings → (d/num? "1") is true on CLJS, false on JVM
|
||||
#?(:clj (t/is (not (d/num? "1"))))
|
||||
;; multi-arity
|
||||
(t/is (d/num? 1 2))
|
||||
(t/is (d/num? 1 2 3))
|
||||
(t/is (d/num? 1 2 3 4))
|
||||
(t/is (d/num? 1 2 3 4 5))
|
||||
(t/is (not (d/num? 1 ##NaN)))
|
||||
(t/is (not (d/num? 1 2 ##Inf)))
|
||||
(t/is (not (d/num? 1 2 3 ##NaN)))
|
||||
(t/is (not (d/num? 1 2 3 4 ##Inf))))
|
||||
|
||||
(t/deftest num-string-predicate
|
||||
;; num-string? returns true for strings that represent valid numbers
|
||||
(t/is (d/num-string? "42"))
|
||||
(t/is (d/num-string? "3.14"))
|
||||
(t/is (d/num-string? "-7"))
|
||||
(t/is (not (d/num-string? "hello")))
|
||||
(t/is (not (d/num-string? nil)))
|
||||
;; In CLJS, js/isNaN("") → false (empty string coerces to 0), so "" is numeric
|
||||
#?(:clj (t/is (not (d/num-string? ""))))
|
||||
#?(:cljs (t/is (d/num-string? ""))))
|
||||
|
||||
(t/deftest percent-predicate
|
||||
(t/is (d/percent? "50%"))
|
||||
(t/is (d/percent? "100%"))
|
||||
(t/is (d/percent? "0%"))
|
||||
(t/is (d/percent? "3.5%"))
|
||||
;; percent? uses str/rtrim which strips the trailing % then checks numeric,
|
||||
;; so a plain numeric string without % also returns true
|
||||
(t/is (d/percent? "50"))
|
||||
(t/is (not (d/percent? "abc%")))
|
||||
(t/is (not (d/percent? "abc"))))
|
||||
|
||||
(t/deftest parse-percent-test
|
||||
(t/is (= 0.5 (d/parse-percent "50%")))
|
||||
(t/is (= 1.0 (d/parse-percent "100%")))
|
||||
(t/is (= 0.0 (d/parse-percent "0%")))
|
||||
;; falls back to parse-double when no % suffix
|
||||
(t/is (= 0.75 (d/parse-percent "0.75")))
|
||||
;; invalid value returns default
|
||||
(t/is (nil? (d/parse-percent "abc%")))
|
||||
(t/is (= 0.0 (d/parse-percent "abc%" 0.0))))
|
||||
|
||||
(t/deftest lazy-map-test
|
||||
(let [calls (atom 0)
|
||||
m (d/lazy-map [:a :b :c]
|
||||
(fn [k]
|
||||
(swap! calls inc)
|
||||
(name k)))]
|
||||
;; The map has the right keys
|
||||
(t/is (= #{:a :b :c} (set (keys m))))
|
||||
;; Values are delays — force them
|
||||
(t/is (= "a" @(get m :a)))
|
||||
(t/is (= "b" @(get m :b)))
|
||||
(t/is (= "c" @(get m :c)))))
|
||||
|
||||
(t/deftest oreorder-before-test
|
||||
;; No ks path: insert k v before before-k in a flat ordered-map
|
||||
(let [om (d/ordered-map :a 1 :b 2 :c 3)
|
||||
result (d/oreorder-before om [] :d 4 :b)]
|
||||
(t/is (= [:a :d :b :c] (vec (keys result)))))
|
||||
;; before-k not found → appended at end
|
||||
(let [om (d/ordered-map :a 1 :b 2)
|
||||
result (d/oreorder-before om [] :c 3 :z)]
|
||||
(t/is (= [:a :b :c] (vec (keys result)))))
|
||||
;; nil before-k → appended at end
|
||||
(let [om (d/ordered-map :a 1 :b 2)
|
||||
result (d/oreorder-before om [] :c 3 nil)]
|
||||
(t/is (= [:a :b :c] (vec (keys result)))))
|
||||
;; existing key k is removed from its old position
|
||||
(let [om (d/ordered-map :a 1 :b 2 :c 3)
|
||||
result (d/oreorder-before om [] :c 99 :a)]
|
||||
(t/is (= [:c :a :b] (vec (keys result))))))
|
||||
|
||||
(t/deftest oassoc-in-before-test
|
||||
;; Simple case: add a new key before an existing key
|
||||
(let [om (d/ordered-map :a 1 :b 2 :c 3)
|
||||
result (d/oassoc-in-before om [:b] [:x] 99)]
|
||||
(t/is (= [:a :x :b :c] (vec (keys result))))
|
||||
(t/is (= 99 (get result :x))))
|
||||
;; before-k not found → oassoc-in behaviour (append)
|
||||
(let [om (d/ordered-map :a 1 :b 2)
|
||||
result (d/oassoc-in-before om [:z] [:x] 99)]
|
||||
(t/is (= 99 (get result :x)))))
|
||||
|
||||
(t/deftest reorder-test
|
||||
;; Move element from index 0 to position between index 2 and 3
|
||||
(t/is (= [:b :c :a :d] (d/reorder [:a :b :c :d] 0 3)))
|
||||
;; Move last element to the front
|
||||
(t/is (= [:d :a :b :c] (d/reorder [:a :b :c :d] 3 0)))
|
||||
;; No-op: same logical position (from-pos == to-space-between-pos)
|
||||
(t/is (= [:a :b :c :d] (d/reorder [:a :b :c :d] 1 1)))
|
||||
;; Clamp out-of-range positions
|
||||
(t/is (= [:b :c :d :a] (d/reorder [:a :b :c :d] 0 100)))
|
||||
(t/is (= [:a :b :c :d] (d/reorder [:a :b :c :d] -5 0))))
|
||||
|
||||
@@ -10,6 +10,7 @@
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.math :as mth]
|
||||
[app.common.pprint :as pp]
|
||||
[app.common.transit :as trans]
|
||||
@@ -18,6 +19,7 @@
|
||||
[app.common.types.path.helpers :as path.helpers]
|
||||
[app.common.types.path.impl :as path.impl]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[app.common.types.path.subpath :as path.subpath]
|
||||
[clojure.test :as t]))
|
||||
|
||||
(def sample-content
|
||||
@@ -537,3 +539,693 @@
|
||||
(t/deftest calculate-bool-content
|
||||
(let [result (path.bool/calculate-content :union contents-for-bool)]
|
||||
(t/is (= result bool-result))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SUBPATH TESTS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest subpath-pt=
|
||||
(t/testing "pt= returns true for nearby points"
|
||||
(t/is (path.subpath/pt= (gpt/point 0 0) (gpt/point 0.05 0.05))))
|
||||
(t/testing "pt= returns false for distant points"
|
||||
(t/is (not (path.subpath/pt= (gpt/point 0 0) (gpt/point 1 0))))))
|
||||
|
||||
(t/deftest subpath-make-subpath
|
||||
(t/testing "make-subpath from a single move-to command"
|
||||
(let [cmd {:command :move-to :params {:x 5.0 :y 10.0}}
|
||||
sp (path.subpath/make-subpath cmd)]
|
||||
(t/is (= (gpt/point 5.0 10.0) (:from sp)))
|
||||
(t/is (= (gpt/point 5.0 10.0) (:to sp)))
|
||||
(t/is (= [cmd] (:data sp)))))
|
||||
(t/testing "make-subpath from explicit from/to/data"
|
||||
(let [from (gpt/point 0 0)
|
||||
to (gpt/point 10 10)
|
||||
data [{:command :move-to :params {:x 0 :y 0}}
|
||||
{:command :line-to :params {:x 10 :y 10}}]
|
||||
sp (path.subpath/make-subpath from to data)]
|
||||
(t/is (= from (:from sp)))
|
||||
(t/is (= to (:to sp)))
|
||||
(t/is (= data (:data sp))))))
|
||||
|
||||
(t/deftest subpath-add-subpath-command
|
||||
(t/testing "adding a line-to command extends the subpath"
|
||||
(let [cmd0 {:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
cmd1 {:command :line-to :params {:x 5.0 :y 5.0}}
|
||||
sp (-> (path.subpath/make-subpath cmd0)
|
||||
(path.subpath/add-subpath-command cmd1))]
|
||||
(t/is (= (gpt/point 5.0 5.0) (:to sp)))
|
||||
(t/is (= 2 (count (:data sp))))))
|
||||
(t/testing "adding a close-path is replaced by a line-to at from"
|
||||
(let [cmd0 {:command :move-to :params {:x 1.0 :y 2.0}}
|
||||
sp (path.subpath/make-subpath cmd0)
|
||||
sp2 (path.subpath/add-subpath-command sp {:command :close-path :params {}})]
|
||||
;; The close-path gets replaced by a line-to back to :from
|
||||
(t/is (= (gpt/point 1.0 2.0) (:to sp2))))))
|
||||
|
||||
(t/deftest subpath-reverse-command
|
||||
(let [prev {:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
cmd {:command :line-to :params {:x 5.0 :y 3.0}}
|
||||
rev (path.subpath/reverse-command cmd prev)]
|
||||
(t/is (= :line-to (:command rev)))
|
||||
(t/is (= 0.0 (get-in rev [:params :x])))
|
||||
(t/is (= 0.0 (get-in rev [:params :y])))))
|
||||
|
||||
(t/deftest subpath-reverse-command-curve
|
||||
(let [prev {:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
cmd {:command :curve-to
|
||||
:params {:x 10.0 :y 0.0 :c1x 3.0 :c1y 5.0 :c2x 7.0 :c2y 5.0}}
|
||||
rev (path.subpath/reverse-command cmd prev)]
|
||||
;; end-point should be previous point coords
|
||||
(t/is (= 0.0 (get-in rev [:params :x])))
|
||||
(t/is (= 0.0 (get-in rev [:params :y])))
|
||||
;; handlers are swapped
|
||||
(t/is (= 7.0 (get-in rev [:params :c1x])))
|
||||
(t/is (= 5.0 (get-in rev [:params :c1y])))
|
||||
(t/is (= 3.0 (get-in rev [:params :c2x])))
|
||||
(t/is (= 5.0 (get-in rev [:params :c2y])))))
|
||||
|
||||
(def ^:private simple-open-content
|
||||
[{:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 10.0}}])
|
||||
|
||||
(def ^:private simple-closed-content
|
||||
[{:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 10.0}}
|
||||
{:command :line-to :params {:x 0.0 :y 0.0}}])
|
||||
|
||||
(t/deftest subpath-get-subpaths
|
||||
(t/testing "open path produces one subpath"
|
||||
(let [sps (path.subpath/get-subpaths simple-open-content)]
|
||||
(t/is (= 1 (count sps)))
|
||||
(t/is (= (gpt/point 0.0 0.0) (get-in sps [0 :from])))))
|
||||
(t/testing "content with two move-to produces two subpaths"
|
||||
(let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 5.0 :y 0.0}}
|
||||
{:command :move-to :params {:x 10.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 15.0 :y 0.0}}]
|
||||
sps (path.subpath/get-subpaths content)]
|
||||
(t/is (= 2 (count sps))))))
|
||||
|
||||
(t/deftest subpath-is-closed?
|
||||
(t/testing "subpath with same from/to is closed"
|
||||
(let [sp (path.subpath/make-subpath (gpt/point 0 0) (gpt/point 0 0) [])]
|
||||
(t/is (path.subpath/is-closed? sp))))
|
||||
(t/testing "subpath with different from/to is not closed"
|
||||
(let [sp (path.subpath/make-subpath (gpt/point 0 0) (gpt/point 10 10) [])]
|
||||
(t/is (not (path.subpath/is-closed? sp))))))
|
||||
|
||||
(t/deftest subpath-reverse-subpath
|
||||
(let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 10.0}}]
|
||||
sps (path.subpath/get-subpaths content)
|
||||
sp (first sps)
|
||||
rev (path.subpath/reverse-subpath sp)]
|
||||
(t/is (= (:to sp) (:from rev)))
|
||||
(t/is (= (:from sp) (:to rev)))
|
||||
;; reversed data starts with a move-to at old :to
|
||||
(t/is (= :move-to (get-in rev [:data 0 :command])))))
|
||||
|
||||
(t/deftest subpath-subpaths-join
|
||||
(let [sp1 (path.subpath/make-subpath (gpt/point 0 0) (gpt/point 5 0)
|
||||
[{:command :move-to :params {:x 0 :y 0}}
|
||||
{:command :line-to :params {:x 5 :y 0}}])
|
||||
sp2 (path.subpath/make-subpath (gpt/point 5 0) (gpt/point 10 0)
|
||||
[{:command :move-to :params {:x 5 :y 0}}
|
||||
{:command :line-to :params {:x 10 :y 0}}])
|
||||
joined (path.subpath/subpaths-join sp1 sp2)]
|
||||
(t/is (= (gpt/point 0 0) (:from joined)))
|
||||
(t/is (= (gpt/point 10 0) (:to joined)))
|
||||
;; data has move-to from sp1 + line-to from sp1 + line-to from sp2 (rest of sp2)
|
||||
(t/is (= 3 (count (:data joined))))))
|
||||
|
||||
(t/deftest subpath-close-subpaths
|
||||
(t/testing "content that is already a closed triangle stays closed"
|
||||
(let [result (path.subpath/close-subpaths simple-closed-content)]
|
||||
(t/is (seq result))))
|
||||
(t/testing "two open fragments that form a closed loop get merged"
|
||||
;; fragment A: 0,0 → 5,0
|
||||
;; fragment B: 10,0 → 5,0 (reversed, connects to A's end)
|
||||
;; After close-subpaths the result should have segments
|
||||
(let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 5.0 :y 0.0}}
|
||||
{:command :move-to :params {:x 10.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 5.0 :y 0.0}}]
|
||||
result (path.subpath/close-subpaths content)]
|
||||
(t/is (seq result)))))
|
||||
|
||||
(t/deftest subpath-reverse-content
|
||||
(let [result (path.subpath/reverse-content simple-open-content)]
|
||||
(t/is (= (count simple-open-content) (count result)))
|
||||
;; First command of reversed content is a move-to at old end
|
||||
(t/is (= :move-to (:command (first result))))
|
||||
(t/is (mth/close? 10.0 (get-in (first result) [:params :x])))
|
||||
(t/is (mth/close? 10.0 (get-in (first result) [:params :y])))))
|
||||
|
||||
(t/deftest subpath-clockwise?
|
||||
(t/testing "square drawn clockwise is detected as clockwise"
|
||||
;; A square drawn clockwise: top-left → top-right → bottom-right → bottom-left
|
||||
(let [cw-content [{:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 10.0}}
|
||||
{:command :line-to :params {:x 0.0 :y 10.0}}
|
||||
{:command :line-to :params {:x 0.0 :y 0.0}}]]
|
||||
(t/is (path.subpath/clockwise? cw-content))))
|
||||
(t/testing "counter-clockwise square is not clockwise"
|
||||
(let [ccw-content [{:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 0.0 :y 10.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 10.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 0.0 :y 0.0}}]]
|
||||
(t/is (not (path.subpath/clockwise? ccw-content))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; HELPERS TESTS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest helpers-s=
|
||||
(t/is (path.helpers/s= 0.0 0.0))
|
||||
(t/is (path.helpers/s= 1.0 1.0000000001))
|
||||
(t/is (not (path.helpers/s= 0.0 1.0))))
|
||||
|
||||
(t/deftest helpers-make-move-to
|
||||
(let [pt (gpt/point 3.0 7.0)
|
||||
cmd (path.helpers/make-move-to pt)]
|
||||
(t/is (= :move-to (:command cmd)))
|
||||
(t/is (= 3.0 (get-in cmd [:params :x])))
|
||||
(t/is (= 7.0 (get-in cmd [:params :y])))))
|
||||
|
||||
(t/deftest helpers-make-line-to
|
||||
(let [pt (gpt/point 4.0 8.0)
|
||||
cmd (path.helpers/make-line-to pt)]
|
||||
(t/is (= :line-to (:command cmd)))
|
||||
(t/is (= 4.0 (get-in cmd [:params :x])))
|
||||
(t/is (= 8.0 (get-in cmd [:params :y])))))
|
||||
|
||||
(t/deftest helpers-make-curve-params
|
||||
(t/testing "single point form — point and handlers coincide"
|
||||
(let [p (gpt/point 5.0 5.0)
|
||||
params (path.helpers/make-curve-params p)]
|
||||
(t/is (mth/close? 5.0 (:x params)))
|
||||
(t/is (mth/close? 5.0 (:c1x params)))
|
||||
(t/is (mth/close? 5.0 (:c2x params)))))
|
||||
(t/testing "two-arg form — handler specified"
|
||||
(let [p (gpt/point 10.0 0.0)
|
||||
h (gpt/point 5.0 5.0)
|
||||
params (path.helpers/make-curve-params p h)]
|
||||
(t/is (mth/close? 10.0 (:x params)))
|
||||
(t/is (mth/close? 5.0 (:c1x params)))
|
||||
;; c2 defaults to point
|
||||
(t/is (mth/close? 10.0 (:c2x params))))))
|
||||
|
||||
(t/deftest helpers-make-curve-to
|
||||
(let [to (gpt/point 10.0 0.0)
|
||||
h1 (gpt/point 3.0 5.0)
|
||||
h2 (gpt/point 7.0 5.0)
|
||||
cmd (path.helpers/make-curve-to to h1 h2)]
|
||||
(t/is (= :curve-to (:command cmd)))
|
||||
(t/is (= 10.0 (get-in cmd [:params :x])))
|
||||
(t/is (= 3.0 (get-in cmd [:params :c1x])))
|
||||
(t/is (= 7.0 (get-in cmd [:params :c2x])))))
|
||||
|
||||
(t/deftest helpers-update-curve-to
|
||||
(let [base {:command :line-to :params {:x 10.0 :y 0.0}}
|
||||
h1 (gpt/point 3.0 5.0)
|
||||
h2 (gpt/point 7.0 5.0)
|
||||
cmd (path.helpers/update-curve-to base h1 h2)]
|
||||
(t/is (= :curve-to (:command cmd)))
|
||||
(t/is (= 3.0 (get-in cmd [:params :c1x])))
|
||||
(t/is (= 7.0 (get-in cmd [:params :c2x])))))
|
||||
|
||||
(t/deftest helpers-prefix->coords
|
||||
(t/is (= [:c1x :c1y] (path.helpers/prefix->coords :c1)))
|
||||
(t/is (= [:c2x :c2y] (path.helpers/prefix->coords :c2)))
|
||||
(t/is (nil? (path.helpers/prefix->coords nil))))
|
||||
|
||||
(t/deftest helpers-position-fixed-angle
|
||||
(t/testing "returns point unchanged when from-point is nil"
|
||||
(let [pt (gpt/point 5.0 3.0)]
|
||||
(t/is (= pt (path.helpers/position-fixed-angle pt nil)))))
|
||||
(t/testing "snaps to nearest 45-degree angle"
|
||||
(let [from (gpt/point 0 0)
|
||||
;; Angle ~30° from from, should snap to 45°
|
||||
to (gpt/point 10 6)
|
||||
snapped (path.helpers/position-fixed-angle to from)]
|
||||
;; result should have same distance
|
||||
(let [d-orig (gpt/distance to from)
|
||||
d-snapped (gpt/distance snapped from)]
|
||||
(t/is (mth/close? d-orig d-snapped 0.01))))))
|
||||
|
||||
(t/deftest helpers-command->line
|
||||
(let [prev {:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
cmd {:command :line-to :params {:x 5.0 :y 3.0} :prev (gpt/point 0 0)}
|
||||
[from to] (path.helpers/command->line cmd (path.helpers/segment->point prev))]
|
||||
(t/is (= (gpt/point 0.0 0.0) from))
|
||||
(t/is (= (gpt/point 5.0 3.0) to))))
|
||||
|
||||
(t/deftest helpers-command->bezier
|
||||
(let [prev {:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
cmd {:command :curve-to
|
||||
:params {:x 10.0 :y 0.0 :c1x 3.0 :c1y 5.0 :c2x 7.0 :c2y 5.0}}
|
||||
[from to h1 h2] (path.helpers/command->bezier cmd (path.helpers/segment->point prev))]
|
||||
(t/is (= (gpt/point 0.0 0.0) from))
|
||||
(t/is (= (gpt/point 10.0 0.0) to))
|
||||
(t/is (= (gpt/point 3.0 5.0) h1))
|
||||
(t/is (= (gpt/point 7.0 5.0) h2))))
|
||||
|
||||
(t/deftest helpers-line-values
|
||||
(let [from (gpt/point 0.0 0.0)
|
||||
to (gpt/point 10.0 0.0)
|
||||
mid (path.helpers/line-values [from to] 0.5)]
|
||||
(t/is (mth/close? 5.0 (:x mid)))
|
||||
(t/is (mth/close? 0.0 (:y mid)))))
|
||||
|
||||
(t/deftest helpers-curve-split
|
||||
(let [start (gpt/point 0.0 0.0)
|
||||
end (gpt/point 10.0 0.0)
|
||||
h1 (gpt/point 3.0 5.0)
|
||||
h2 (gpt/point 7.0 5.0)
|
||||
[[s1 e1 _ _] [s2 e2 _ _]] (path.helpers/curve-split start end h1 h2 0.5)]
|
||||
;; First sub-curve starts at start and ends near midpoint
|
||||
(t/is (mth/close? 0.0 (:x s1) 0.01))
|
||||
(t/is (mth/close? 10.0 (:x e2) 0.01))
|
||||
;; The split point (e1 / s2) should be the same
|
||||
(t/is (mth/close? (:x e1) (:x s2) 0.01))
|
||||
(t/is (mth/close? (:y e1) (:y s2) 0.01))))
|
||||
|
||||
(t/deftest helpers-split-line-to
|
||||
(let [from (gpt/point 0.0 0.0)
|
||||
seg {:command :line-to :params {:x 10.0 :y 0.0}}
|
||||
[s1 s2] (path.helpers/split-line-to from seg 0.5)]
|
||||
(t/is (= :line-to (:command s1)))
|
||||
(t/is (mth/close? 5.0 (get-in s1 [:params :x])))
|
||||
(t/is (= s2 seg))))
|
||||
|
||||
(t/deftest helpers-split-curve-to
|
||||
(let [from (gpt/point 0.0 0.0)
|
||||
seg {:command :curve-to
|
||||
:params {:x 10.0 :y 0.0 :c1x 3.0 :c1y 5.0 :c2x 7.0 :c2y 5.0}}
|
||||
[s1 s2] (path.helpers/split-curve-to from seg 0.5)]
|
||||
(t/is (= :curve-to (:command s1)))
|
||||
(t/is (= :curve-to (:command s2)))
|
||||
;; s2 ends at original endpoint
|
||||
(t/is (mth/close? 10.0 (get-in s2 [:params :x]) 0.01))
|
||||
(t/is (mth/close? 0.0 (get-in s2 [:params :y]) 0.01))))
|
||||
|
||||
(t/deftest helpers-split-line-to-ranges
|
||||
(t/testing "no split values returns original segment"
|
||||
(let [from (gpt/point 0.0 0.0)
|
||||
seg {:command :line-to :params {:x 10.0 :y 0.0}}
|
||||
result (path.helpers/split-line-to-ranges from seg [])]
|
||||
(t/is (= [seg] result))))
|
||||
(t/testing "splits at 0.25 and 0.75 produces 3 segments"
|
||||
(let [from (gpt/point 0.0 0.0)
|
||||
seg {:command :line-to :params {:x 10.0 :y 0.0}}
|
||||
result (path.helpers/split-line-to-ranges from seg [0.25 0.75])]
|
||||
(t/is (= 3 (count result))))))
|
||||
|
||||
(t/deftest helpers-split-curve-to-ranges
|
||||
(t/testing "no split values returns original segment"
|
||||
(let [from (gpt/point 0.0 0.0)
|
||||
seg {:command :curve-to
|
||||
:params {:x 10.0 :y 0.0 :c1x 3.0 :c1y 5.0 :c2x 7.0 :c2y 5.0}}
|
||||
result (path.helpers/split-curve-to-ranges from seg [])]
|
||||
(t/is (= [seg] result))))
|
||||
(t/testing "split at 0.5 produces 2 segments"
|
||||
(let [from (gpt/point 0.0 0.0)
|
||||
seg {:command :curve-to
|
||||
:params {:x 10.0 :y 0.0 :c1x 3.0 :c1y 5.0 :c2x 7.0 :c2y 5.0}}
|
||||
result (path.helpers/split-curve-to-ranges from seg [0.5])]
|
||||
(t/is (= 2 (count result))))))
|
||||
|
||||
(t/deftest helpers-line-has-point?
|
||||
(let [from (gpt/point 0.0 0.0)
|
||||
to (gpt/point 10.0 0.0)]
|
||||
(t/is (path.helpers/line-has-point? (gpt/point 5.0 0.0) [from to]))
|
||||
(t/is (not (path.helpers/line-has-point? (gpt/point 5.0 1.0) [from to])))))
|
||||
|
||||
(t/deftest helpers-segment-has-point?
|
||||
(let [from (gpt/point 0.0 0.0)
|
||||
to (gpt/point 10.0 0.0)]
|
||||
(t/is (path.helpers/segment-has-point? (gpt/point 5.0 0.0) [from to]))
|
||||
;; Outside segment bounds even though on same infinite line
|
||||
(t/is (not (path.helpers/segment-has-point? (gpt/point 15.0 0.0) [from to])))))
|
||||
|
||||
(t/deftest helpers-curve-has-point?
|
||||
(let [start (gpt/point 0.0 0.0)
|
||||
end (gpt/point 10.0 0.0)
|
||||
h1 (gpt/point 0.0 0.0)
|
||||
h2 (gpt/point 10.0 0.0)
|
||||
;; degenerate curve (same as line) — midpoint should be on it
|
||||
curve [start end h1 h2]]
|
||||
(t/is (path.helpers/curve-has-point? (gpt/point 5.0 0.0) curve))
|
||||
(t/is (not (path.helpers/curve-has-point? (gpt/point 5.0 100.0) curve)))))
|
||||
|
||||
(t/deftest helpers-curve-tangent
|
||||
(let [start (gpt/point 0.0 0.0)
|
||||
end (gpt/point 10.0 0.0)
|
||||
h1 (gpt/point 3.0 0.0)
|
||||
h2 (gpt/point 7.0 0.0)
|
||||
tangent (path.helpers/curve-tangent [start end h1 h2] 0.5)]
|
||||
;; For a nearly-horizontal curve, the tangent y-component is small
|
||||
(t/is (mth/close? 1.0 (:x tangent) 0.01))
|
||||
(t/is (mth/close? 0.0 (:y tangent) 0.01))))
|
||||
|
||||
(t/deftest helpers-curve->lines
|
||||
(let [start (gpt/point 0.0 0.0)
|
||||
end (gpt/point 10.0 0.0)
|
||||
h1 (gpt/point 3.0 5.0)
|
||||
h2 (gpt/point 7.0 5.0)
|
||||
lines (path.helpers/curve->lines start end h1 h2)]
|
||||
;; curve->lines produces num-segments lines (10 by default, closed [0..1] => 11 pairs)
|
||||
(t/is (pos? (count lines)))
|
||||
(t/is (= 2 (count (first lines))))))
|
||||
|
||||
(t/deftest helpers-line-line-intersect
|
||||
(t/testing "perpendicular lines intersect"
|
||||
(let [l1 [(gpt/point 5.0 0.0) (gpt/point 5.0 10.0)]
|
||||
l2 [(gpt/point 0.0 5.0) (gpt/point 10.0 5.0)]
|
||||
result (path.helpers/line-line-intersect l1 l2)]
|
||||
(t/is (some? result))))
|
||||
(t/testing "parallel lines do not intersect"
|
||||
(let [l1 [(gpt/point 0.0 0.0) (gpt/point 10.0 0.0)]
|
||||
l2 [(gpt/point 0.0 5.0) (gpt/point 10.0 5.0)]
|
||||
result (path.helpers/line-line-intersect l1 l2)]
|
||||
(t/is (nil? result)))))
|
||||
|
||||
(t/deftest helpers-subcurve-range
|
||||
(let [start (gpt/point 0.0 0.0)
|
||||
end (gpt/point 10.0 0.0)
|
||||
h1 (gpt/point 3.0 5.0)
|
||||
h2 (gpt/point 7.0 5.0)
|
||||
[s e _ _] (path.helpers/subcurve-range start end h1 h2 0.25 0.75)]
|
||||
;; sub-curve should start near t=0.25 and end near t=0.75
|
||||
(t/is (some? s))
|
||||
(t/is (some? e))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SEGMENT UNTESTED FUNCTIONS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest segment-update-handler
|
||||
(let [cmd {:command :curve-to
|
||||
:params {:x 10.0 :y 0.0 :c1x 0.0 :c1y 0.0 :c2x 0.0 :c2y 0.0}}
|
||||
pt (gpt/point 3.0 5.0)
|
||||
r (path.segment/update-handler cmd :c1 pt)]
|
||||
(t/is (= 3.0 (get-in r [:params :c1x])))
|
||||
(t/is (= 5.0 (get-in r [:params :c1y])))))
|
||||
|
||||
(t/deftest segment-get-handler
|
||||
(let [cmd {:command :curve-to
|
||||
:params {:x 10.0 :y 0.0 :c1x 3.0 :c1y 5.0 :c2x 7.0 :c2y 2.0}}]
|
||||
(t/is (= (gpt/point 3.0 5.0) (path.segment/get-handler cmd :c1)))
|
||||
(t/is (= (gpt/point 7.0 2.0) (path.segment/get-handler cmd :c2)))
|
||||
(t/is (nil? (path.segment/get-handler {:command :line-to :params {:x 1 :y 2}} :c1)))))
|
||||
|
||||
(t/deftest segment-handler->node
|
||||
(let [content (path/content sample-content-2)]
|
||||
;; For :c1 prefix, the node is the previous segment
|
||||
(let [node (path.segment/handler->node (vec content) 2 :c1)]
|
||||
(t/is (some? node)))
|
||||
;; For :c2 prefix, the node is the current segment's endpoint
|
||||
(let [node (path.segment/handler->node (vec content) 2 :c2)]
|
||||
(t/is (some? node)))))
|
||||
|
||||
(t/deftest segment-calculate-opposite-handler
|
||||
(let [pt (gpt/point 5.0 5.0)
|
||||
h (gpt/point 8.0 5.0)
|
||||
opp (path.segment/calculate-opposite-handler pt h)]
|
||||
(t/is (mth/close? 2.0 (:x opp)))
|
||||
(t/is (mth/close? 5.0 (:y opp)))))
|
||||
|
||||
(t/deftest segment-opposite-handler
|
||||
(let [pt (gpt/point 5.0 5.0)
|
||||
h (gpt/point 8.0 5.0)
|
||||
opp (path.segment/opposite-handler pt h)]
|
||||
(t/is (mth/close? 2.0 (:x opp)))
|
||||
(t/is (mth/close? 5.0 (:y opp)))))
|
||||
|
||||
(t/deftest segment-point-indices
|
||||
(let [content (path/content sample-content-2)
|
||||
pt (gpt/point 480.0 839.0)
|
||||
idxs (path.segment/point-indices content pt)]
|
||||
(t/is (= [0] (vec idxs)))))
|
||||
|
||||
(t/deftest segment-opposite-index
|
||||
(let [content (path/content sample-content-2)]
|
||||
;; Index 2 with :c2 prefix — the node is the current point of index 2
|
||||
(let [result (path.segment/opposite-index content 2 :c2)]
|
||||
;; result is either nil or [index prefix]
|
||||
(t/is (or (nil? result) (vector? result))))))
|
||||
|
||||
(t/deftest segment-split-segments
|
||||
(let [content (path/content sample-content-square)
|
||||
points #{(gpt/point 10.0 0.0)
|
||||
(gpt/point 0.0 0.0)}
|
||||
result (path.segment/split-segments content points 0.5)]
|
||||
;; result should have more segments than original (splits added)
|
||||
(t/is (> (count result) (count sample-content-square)))))
|
||||
|
||||
(t/deftest segment-content->selrect
|
||||
(let [content (path/content sample-content-square)
|
||||
rect (path.segment/content->selrect content)]
|
||||
(t/is (some? rect))
|
||||
(t/is (mth/close? 0.0 (:x1 rect) 0.1))
|
||||
(t/is (mth/close? 0.0 (:y1 rect) 0.1))
|
||||
(t/is (mth/close? 10.0 (:x2 rect) 0.1))
|
||||
(t/is (mth/close? 10.0 (:y2 rect) 0.1))))
|
||||
|
||||
(t/deftest segment-content-center
|
||||
(let [content (path/content sample-content-square)
|
||||
center (path.segment/content-center content)]
|
||||
(t/is (some? center))
|
||||
(t/is (mth/close? 5.0 (:x center) 0.1))
|
||||
(t/is (mth/close? 5.0 (:y center) 0.1))))
|
||||
|
||||
(t/deftest segment-move-content
|
||||
(let [content (path/content sample-content-square)
|
||||
move-vec (gpt/point 5.0 5.0)
|
||||
result (path.segment/move-content content move-vec)
|
||||
first-seg (first (vec result))]
|
||||
(t/is (= :move-to (:command first-seg)))
|
||||
(t/is (mth/close? 5.0 (get-in first-seg [:params :x])))))
|
||||
|
||||
(t/deftest segment-is-curve?
|
||||
(let [content (path/content sample-content-2)]
|
||||
;; point at index 0 is 480,839 — no handler offset, not a curve
|
||||
(let [pt (gpt/point 480.0 839.0)]
|
||||
;; is-curve? can return nil (falsy) or boolean — just check it doesn't throw
|
||||
(t/is (not (path.segment/is-curve? content pt))))
|
||||
;; A point that is reached by a curve-to command should be detectable
|
||||
(let [curve-pt (gpt/point 4.0 4.0)]
|
||||
(t/is (or (nil? (path.segment/is-curve? content curve-pt))
|
||||
(boolean? (path.segment/is-curve? content curve-pt)))))))
|
||||
|
||||
(t/deftest segment-append-segment
|
||||
(let [content (path/content sample-content)
|
||||
seg {:command :line-to :params {:x 100.0 :y 100.0}}
|
||||
result (path.segment/append-segment content seg)]
|
||||
(t/is (= (inc (count (vec content))) (count result)))))
|
||||
|
||||
(t/deftest segment-remove-nodes
|
||||
(let [content (path/content simple-open-content)
|
||||
;; remove the midpoint
|
||||
pt (gpt/point 10.0 0.0)
|
||||
result (path.segment/remove-nodes content #{pt})]
|
||||
;; should have fewer segments
|
||||
(t/is (< (count result) (count simple-open-content)))))
|
||||
|
||||
(t/deftest segment-join-nodes
|
||||
(let [content (path/content simple-open-content)
|
||||
pt1 (gpt/point 0.0 0.0)
|
||||
pt2 (gpt/point 10.0 10.0)
|
||||
result (path.segment/join-nodes content #{pt1 pt2})]
|
||||
;; join-nodes adds new segments connecting the given points
|
||||
(t/is (>= (count result) (count simple-open-content)))))
|
||||
|
||||
(t/deftest segment-separate-nodes
|
||||
(let [content (path/content simple-open-content)
|
||||
pt (gpt/point 10.0 0.0)
|
||||
result (path.segment/separate-nodes content #{pt})]
|
||||
;; separate-nodes should return a collection (vector or seq)
|
||||
(t/is (coll? result))))
|
||||
|
||||
(t/deftest segment-make-corner-point
|
||||
(let [content (path/content sample-content-2)
|
||||
;; Take a curve point and make it a corner
|
||||
pt (gpt/point 439.0 802.0)
|
||||
result (path.segment/make-corner-point content pt)]
|
||||
;; Result is a PathData instance
|
||||
(t/is (some? result))))
|
||||
|
||||
(t/deftest segment-next-node
|
||||
(t/testing "no prev-point returns move-to"
|
||||
(let [content (path/content sample-content)
|
||||
position (gpt/point 100.0 100.0)
|
||||
result (path.segment/next-node content position nil nil)]
|
||||
(t/is (= :move-to (:command result)))))
|
||||
(t/testing "with prev-point and no handler and last command is not close-path"
|
||||
;; Use a content that does NOT end with :close-path
|
||||
(let [content (path/content simple-open-content)
|
||||
position (gpt/point 100.0 100.0)
|
||||
prev (gpt/point 50.0 50.0)
|
||||
result (path.segment/next-node content position prev nil)]
|
||||
(t/is (= :line-to (:command result))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PATH TOP-LEVEL UNTESTED FUNCTIONS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest path-from-plain
|
||||
(let [result (path/from-plain sample-content)]
|
||||
(t/is (path/content? result))
|
||||
(t/is (= (count sample-content) (count (vec result))))))
|
||||
|
||||
(t/deftest path-calc-selrect
|
||||
(let [content (path/content sample-content-square)
|
||||
rect (path/calc-selrect content)]
|
||||
(t/is (some? rect))
|
||||
(t/is (mth/close? 0.0 (:x1 rect) 0.1))
|
||||
(t/is (mth/close? 0.0 (:y1 rect) 0.1))))
|
||||
|
||||
(t/deftest path-close-subpaths
|
||||
(let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 0.0}}
|
||||
{:command :move-to :params {:x 10.0 :y 5.0}}
|
||||
{:command :line-to :params {:x 0.0 :y 0.0}}]
|
||||
result (path/close-subpaths content)]
|
||||
(t/is (path/content? result))
|
||||
(t/is (seq (vec result)))))
|
||||
|
||||
(t/deftest path-move-content
|
||||
(let [content (path/content sample-content-square)
|
||||
move-vec (gpt/point 3.0 4.0)
|
||||
result (path/move-content content move-vec)
|
||||
first-r (first (vec result))]
|
||||
(t/is (= :move-to (:command first-r)))
|
||||
(t/is (mth/close? 3.0 (get-in first-r [:params :x])))
|
||||
(t/is (mth/close? 4.0 (get-in first-r [:params :y])))))
|
||||
|
||||
(t/deftest path-move-content-zero-vec
|
||||
(t/testing "moving by zero returns same content"
|
||||
(let [content (path/content sample-content-square)
|
||||
result (path/move-content content (gpt/point 0 0))]
|
||||
;; should return same object (identity) when zero vector
|
||||
(t/is (= (vec content) (vec result))))))
|
||||
|
||||
(t/deftest path-shape-with-open-path?
|
||||
(t/testing "path shape with open content is open"
|
||||
(let [shape {:type :path
|
||||
:content (path/content simple-open-content)}]
|
||||
(t/is (path/shape-with-open-path? shape))))
|
||||
(t/testing "path shape with closed content is not open"
|
||||
(let [shape {:type :path
|
||||
:content (path/content simple-closed-content)}]
|
||||
(t/is (not (path/shape-with-open-path? shape))))))
|
||||
|
||||
(t/deftest path-get-byte-size
|
||||
(let [content (path/content sample-content)
|
||||
size (path/get-byte-size content)]
|
||||
(t/is (pos? size))))
|
||||
|
||||
(t/deftest path-apply-content-modifiers
|
||||
(let [content (path/content sample-content)
|
||||
;; shift the first point by x=5, y=3
|
||||
modifiers {0 {:x 5.0 :y 3.0}}
|
||||
result (path/apply-content-modifiers content modifiers)
|
||||
first-seg (first (vec result))]
|
||||
(t/is (mth/close? (+ 480.0 5.0) (get-in first-seg [:params :x])))
|
||||
(t/is (mth/close? (+ 839.0 3.0) (get-in first-seg [:params :y])))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; BOOL OPERATIONS — INTERSECTION / DIFFERENCE / EXCLUSION
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; Two non-overlapping rectangles for bool tests
|
||||
(def ^:private rect-a
|
||||
[{:command :move-to :params {:x 0.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 0.0}}
|
||||
{:command :line-to :params {:x 10.0 :y 10.0}}
|
||||
{:command :line-to :params {:x 0.0 :y 10.0}}
|
||||
{:command :line-to :params {:x 0.0 :y 0.0}}
|
||||
{:command :close-path :params {}}])
|
||||
|
||||
(def ^:private rect-b
|
||||
[{:command :move-to :params {:x 5.0 :y 5.0}}
|
||||
{:command :line-to :params {:x 15.0 :y 5.0}}
|
||||
{:command :line-to :params {:x 15.0 :y 15.0}}
|
||||
{:command :line-to :params {:x 5.0 :y 15.0}}
|
||||
{:command :line-to :params {:x 5.0 :y 5.0}}
|
||||
{:command :close-path :params {}}])
|
||||
|
||||
(def ^:private rect-c
|
||||
[{:command :move-to :params {:x 20.0 :y 20.0}}
|
||||
{:command :line-to :params {:x 30.0 :y 20.0}}
|
||||
{:command :line-to :params {:x 30.0 :y 30.0}}
|
||||
{:command :line-to :params {:x 20.0 :y 30.0}}
|
||||
{:command :line-to :params {:x 20.0 :y 20.0}}
|
||||
{:command :close-path :params {}}])
|
||||
|
||||
(t/deftest bool-difference
|
||||
(let [result (path.bool/calculate-content :difference [rect-a rect-b])]
|
||||
;; difference result must be a sequence (possibly empty for degenerate cases)
|
||||
(t/is (or (nil? result) (sequential? result)))))
|
||||
|
||||
(t/deftest bool-intersection
|
||||
(let [result (path.bool/calculate-content :intersection [rect-a rect-b])]
|
||||
(t/is (or (nil? result) (sequential? result)))))
|
||||
|
||||
(t/deftest bool-exclusion
|
||||
(let [result (path.bool/calculate-content :exclude [rect-a rect-b])]
|
||||
(t/is (or (nil? result) (sequential? result)))))
|
||||
|
||||
(t/deftest bool-union-non-overlapping
|
||||
(let [result (path.bool/calculate-content :union [rect-a rect-c])]
|
||||
;; non-overlapping union should contain both shapes' segments
|
||||
(t/is (seq result))
|
||||
(t/is (> (count result) (count rect-a)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SHAPE-TO-PATH TESTS (via path/convert-to-path)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn- make-selrect [x y w h]
|
||||
(grc/make-rect x y w h))
|
||||
|
||||
(t/deftest shape-to-path-rect-simple
|
||||
(let [shape {:type :rect :x 0.0 :y 0.0 :width 100.0 :height 50.0
|
||||
:selrect (make-selrect 0.0 0.0 100.0 50.0)}
|
||||
result (path/convert-to-path shape {})]
|
||||
(t/is (= :path (:type result)))
|
||||
(t/is (path/content? (:content result)))
|
||||
;; A simple rect (no radius) produces an empty path in the current impl
|
||||
;; so we just check it doesn't throw and returns a :path type
|
||||
(t/is (some? (:content result)))))
|
||||
|
||||
(t/deftest shape-to-path-circle
|
||||
(let [shape {:type :circle :x 0.0 :y 0.0 :width 100.0 :height 100.0
|
||||
:selrect (make-selrect 0.0 0.0 100.0 100.0)}
|
||||
result (path/convert-to-path shape {})]
|
||||
(t/is (= :path (:type result)))
|
||||
(t/is (path/content? (:content result)))
|
||||
;; A circle converts to bezier curves — should have multiple segments
|
||||
(t/is (> (count (vec (:content result))) 1))))
|
||||
|
||||
(t/deftest shape-to-path-path
|
||||
(let [shape {:type :path :content (path/content sample-content)}
|
||||
result (path/convert-to-path shape {})]
|
||||
;; A path shape stays a path shape unchanged
|
||||
(t/is (= :path (:type result)))))
|
||||
|
||||
(t/deftest shape-to-path-rect-with-radius
|
||||
(let [shape {:type :rect :x 0.0 :y 0.0 :width 100.0 :height 100.0
|
||||
:r1 10.0 :r2 10.0 :r3 10.0 :r4 10.0
|
||||
:selrect (make-selrect 0.0 0.0 100.0 100.0)}
|
||||
result (path/convert-to-path shape {})]
|
||||
(t/is (= :path (:type result)))
|
||||
;; rounded rect should have curve-to segments
|
||||
(let [segs (vec (:content result))
|
||||
curve-segs (filter #(= :curve-to (:command %)) segs)]
|
||||
(t/is (pos? (count curve-segs))))))
|
||||
|
||||
Reference in New Issue
Block a user