feat: add calendar widget components

Add date picker and event calendar components inspired by shadcn/radix
Calendar and org-mode-agenda-cli.

Components:
- ui.calendar: Month grid date picker with navigation, today/selected
  highlighting, outside-month dimming. Pure date math utilities
  (days-in-month, day-of-week, calendar-days, etc.)
- ui.calendar-events: Event-aware grid with colored pills, horizontal
  day ticker strip with dot indicators, and agenda list view with
  grouped events by day

CSS: Token-based styling with dark mode support for event color
variants (accent/danger/success/warning). Responsive breakpoints.

All three targets supported (squint/cljs/clj). Dev pages show calendar
on its own page with interactive demos (date selection, month nav,
event grid, ticker, agenda list).

Tests: 27 new assertions covering date math, class generation,
component structure, event filtering/sorting.
This commit is contained in:
Florian Schroedl
2026-03-29 09:42:29 +02:00
parent d4f21f80a5
commit 25f868fb69
10 changed files with 1990 additions and 6 deletions

View File

@@ -0,0 +1,117 @@
(ns ui.calendar-events-test
(:require [clojure.test :refer [deftest is testing]]
[ui.calendar-events :as cal-events]))
(def sample-events
[{:title "Team standup" :date "2026-03-29" :time-start "09:00" :time-end "09:30" :color :accent}
{:title "Lunch with Alex" :date "2026-03-29" :time-start "12:00" :time-end "13:00" :color :success}
{:title "Deploy v2.0" :date "2026-03-29" :time-start "15:00" :color :danger}
{:title "Design review" :date "2026-03-30" :time-start "10:00" :color :warning}
{:title "All-day planning" :date "2026-03-31" :color nil :done? true}])
(deftest event-color-class-test
(testing "named colors"
(is (= "cal-event-accent" (cal-events/event-color-class :accent)))
(is (= "cal-event-danger" (cal-events/event-color-class :danger)))
(is (= "cal-event-success" (cal-events/event-color-class :success)))
(is (= "cal-event-warning" (cal-events/event-color-class :warning))))
(testing "nil or unknown returns default"
(is (= "cal-event-default" (cal-events/event-color-class nil)))
(is (= "cal-event-default" (cal-events/event-color-class :unknown)))))
(deftest events-for-date-test
(testing "returns events for a matching date"
(let [evts (cal-events/events-for-date sample-events "2026-03-29")]
(is (= 3 (count evts)))))
(testing "sorted by time-start"
(let [evts (cal-events/events-for-date sample-events "2026-03-29")]
(is (= "09:00" (:time-start (first evts))))
(is (= "15:00" (:time-start (last evts))))))
(testing "returns empty for non-matching date"
(is (empty? (cal-events/events-for-date sample-events "2026-04-01"))))
(testing "events without time sort last"
(let [evts (cal-events/events-for-date sample-events "2026-03-31")]
(is (= 1 (count evts)))
(is (= "All-day planning" (:title (first evts)))))))
(deftest format-time-test
(testing "formats HH:MM"
(is (= "09:00" (cal-events/format-time "09:00")))
(is (= "14:30" (cal-events/format-time "14:30"))))
(testing "nil returns nil"
(is (nil? (cal-events/format-time nil)))))
(deftest event-time-display-test
(testing "time range with start and end"
(is (= "09:00 \u2013 09:30"
(cal-events/event-time-display {:time-start "09:00" :time-end "09:30"}))))
(testing "start only"
(is (= "15:00"
(cal-events/event-time-display {:time-start "15:00"}))))
(testing "no time"
(is (nil? (cal-events/event-time-display {})))))
(deftest event-pill-class-list-test
(testing "default"
(is (= ["cal-event-pill" "cal-event-default"]
(cal-events/event-pill-class-list {}))))
(testing "with color"
(is (= ["cal-event-pill" "cal-event-accent"]
(cal-events/event-pill-class-list {:color :accent}))))
(testing "done event"
(is (= ["cal-event-pill" "cal-event-default" "cal-event-done"]
(cal-events/event-pill-class-list {:done? true}))))
(testing "color + done"
(is (= ["cal-event-pill" "cal-event-danger" "cal-event-done"]
(cal-events/event-pill-class-list {:color :danger :done? true})))))
(deftest ticker-day-class-list-test
(testing "default"
(is (= ["cal-ticker-day"]
(cal-events/ticker-day-class-list {}))))
(testing "today"
(is (= ["cal-ticker-day" "cal-ticker-today"]
(cal-events/ticker-day-class-list {:today? true}))))
(testing "selected"
(is (= ["cal-ticker-day" "cal-ticker-selected"]
(cal-events/ticker-day-class-list {:selected? true}))))
(testing "today + selected"
(is (= ["cal-ticker-day" "cal-ticker-today" "cal-ticker-selected"]
(cal-events/ticker-day-class-list {:today? true :selected? true})))))
(deftest agenda-event-class-list-test
(testing "default"
(is (= ["cal-agenda-event"]
(cal-events/agenda-event-class-list {}))))
(testing "done"
(is (= ["cal-agenda-event" "cal-agenda-event-done"]
(cal-events/agenda-event-class-list {:done? true})))))
(deftest event-pill-component-test
(testing "renders event pill (clj target)"
(let [evt {:title "Test" :color :accent :time-start "10:00"}
result (cal-events/event-pill {:event evt})]
(is (= :div (first result)))
(is (= "cal-event-pill cal-event-accent"
(get-in result [1 :class]))))))
(deftest agenda-event-row-component-test
(testing "renders agenda event row (clj target)"
(let [evt {:title "Meeting" :color :danger :time-start "14:00" :time-end "15:00"}
result (cal-events/agenda-event-row {:event evt})]
(is (= :div (first result)))
(is (= "cal-agenda-event"
(get-in result [1 :class]))))))
(deftest agenda-day-group-component-test
(testing "renders day group with events"
(let [result (cal-events/agenda-day-group {:date "2026-03-29"
:label "Today"
:events sample-events})]
(is (some? result))
(is (= :div (first result)))))
(testing "returns nil for date with no events"
(let [result (cal-events/agenda-day-group {:date "2026-04-01"
:label "Wed"
:events sample-events})]
(is (nil? result)))))

166
test/ui/calendar_test.clj Normal file
View File

@@ -0,0 +1,166 @@
(ns ui.calendar-test
(:require [clojure.test :refer [deftest is testing]]
[ui.calendar :as cal]))
(deftest leap-year-test
(testing "standard leap years"
(is (true? (cal/leap-year? 2024)))
(is (true? (cal/leap-year? 2000)))
(is (true? (cal/leap-year? 1600))))
(testing "non-leap years"
(is (false? (cal/leap-year? 2023)))
(is (false? (cal/leap-year? 1900)))
(is (false? (cal/leap-year? 2100)))))
(deftest days-in-month-test
(testing "31-day months"
(is (= 31 (cal/days-in-month 2026 1)))
(is (= 31 (cal/days-in-month 2026 3)))
(is (= 31 (cal/days-in-month 2026 5)))
(is (= 31 (cal/days-in-month 2026 7)))
(is (= 31 (cal/days-in-month 2026 8)))
(is (= 31 (cal/days-in-month 2026 10)))
(is (= 31 (cal/days-in-month 2026 12))))
(testing "30-day months"
(is (= 30 (cal/days-in-month 2026 4)))
(is (= 30 (cal/days-in-month 2026 6)))
(is (= 30 (cal/days-in-month 2026 9)))
(is (= 30 (cal/days-in-month 2026 11))))
(testing "February"
(is (= 28 (cal/days-in-month 2026 2)))
(is (= 29 (cal/days-in-month 2024 2)))
(is (= 28 (cal/days-in-month 1900 2)))
(is (= 29 (cal/days-in-month 2000 2)))))
(deftest day-of-week-test
(testing "known dates"
;; 2026-03-29 is a Sunday = 6 in our system (0=Mon)
(is (= 6 (cal/day-of-week 2026 3 29)))
;; 2026-01-01 is a Thursday = 3
(is (= 3 (cal/day-of-week 2026 1 1)))
;; 2024-01-01 is a Monday = 0
(is (= 0 (cal/day-of-week 2024 1 1)))
;; 2023-12-25 is a Monday = 0
(is (= 0 (cal/day-of-week 2023 12 25)))))
(deftest first-day-of-week-test
(testing "first-day-of-week delegates to day-of-week"
;; March 2026 starts on Sunday = 6
(is (= 6 (cal/first-day-of-week 2026 3)))
;; January 2024 starts on Monday = 0
(is (= 0 (cal/first-day-of-week 2024 1)))))
(deftest pad2-test
(testing "single digit padded"
(is (= "01" (cal/pad2 1)))
(is (= "09" (cal/pad2 9))))
(testing "double digit not padded"
(is (= "10" (cal/pad2 10)))
(is (= "31" (cal/pad2 31)))))
(deftest date-str-test
(testing "formats date as YYYY-MM-DD"
(is (= "2026-03-29" (cal/date-str 2026 3 29)))
(is (= "2026-01-01" (cal/date-str 2026 1 1)))))
(deftest month-name-test
(testing "month names"
(is (= "January" (cal/month-name 1)))
(is (= "December" (cal/month-name 12)))
(is (= "March" (cal/month-name 3)))))
(deftest prev-month-test
(testing "normal"
(is (= [2026 2] (cal/prev-month 2026 3))))
(testing "year boundary"
(is (= [2025 12] (cal/prev-month 2026 1)))))
(deftest next-month-test
(testing "normal"
(is (= [2026 4] (cal/next-month 2026 3))))
(testing "year boundary"
(is (= [2027 1] (cal/next-month 2026 12)))))
(deftest calendar-days-test
(testing "generates correct number of days in complete weeks"
(let [days (cal/calendar-days 2026 3)]
;; Must be divisible by 7
(is (zero? (mod (count days) 7)))
;; Must contain all 31 days of March 2026
(let [current (filter :current-month? days)]
(is (= 31 (count current)))
(is (= 1 (:day (first current))))
(is (= 31 (:day (last current)))))))
(testing "leading days from previous month"
;; March 2026 starts on Sunday (6), so 6 leading days from Feb
(let [days (cal/calendar-days 2026 3)
leading (take-while #(not (:current-month? %)) days)]
(is (= 6 (count leading)))
(is (= 2 (:month (first leading))))))
(testing "trailing days from next month"
(let [days (cal/calendar-days 2026 3)
trailing (drop-while #(or (:current-month? %)
(= 2 (:month %)))
days)]
;; All trailing days should be in April
(is (every? #(= 4 (:month %)) trailing))))
(testing "month starting on Monday has no leading days"
;; June 2026 starts on Monday
(let [days (cal/calendar-days 2026 6)
leading (take-while #(not (:current-month? %)) days)]
(is (= 0 (count leading))))))
(deftest calendar-class-list-test
(testing "default"
(is (= ["cal"] (cal/calendar-class-list {})))))
(deftest day-cell-class-list-test
(testing "default day"
(is (= ["cal-day"] (cal/day-cell-class-list {:current-month? true}))))
(testing "today"
(is (= ["cal-day" "cal-day-today"]
(cal/day-cell-class-list {:current-month? true :today? true}))))
(testing "selected"
(is (= ["cal-day" "cal-day-selected"]
(cal/day-cell-class-list {:current-month? true :selected? true}))))
(testing "outside month"
(is (= ["cal-day" "cal-day-outside"]
(cal/day-cell-class-list {:current-month? false}))))
(testing "disabled"
(is (= ["cal-day" "cal-day-disabled"]
(cal/day-cell-class-list {:current-month? true :disabled? true}))))
(testing "today + selected"
(is (= ["cal-day" "cal-day-today" "cal-day-selected"]
(cal/day-cell-class-list {:current-month? true :today? true :selected? true})))))
(deftest calendar-component-test
(testing "renders correct hiccup structure (clj target)"
(let [result (cal/calendar {:year 2026 :month 3 :today-str "2026-03-29"})]
(is (= :div (first result)))
(is (= "cal" (get-in result [1 :class])))))
(testing "extra class gets appended"
(let [result (cal/calendar {:year 2026 :month 3 :class "my-cal"})]
(is (= "cal my-cal" (get-in result [1 :class])))))
(testing "calendar header contains month and year"
(let [result (cal/calendar-header {:year 2026 :month 3})]
;; Header is a div with nav-title containing "March 2026"
(is (= :div (first result)))
;; Find the title div
(let [children (drop 2 result)
title-div (some #(when (and (vector? %)
(= :div (first %))
(= "cal-nav-title" (get-in % [1 :class])))
%)
children)]
(is (some? title-div))
(is (= "March 2026" (last title-div)))))))