This commit is contained in:
2026-02-03 12:22:47 -05:00
parent a3c01d4b5a
commit 9150c90ad1
9 changed files with 1643 additions and 218 deletions
+201 -43
View File
@@ -1,57 +1,162 @@
(ns tui.core
"Core TUI framework - Elm architecture runtime."
"Core TUI framework - Elm architecture runtime.
## New API (Recommended)
Update function signature:
(fn [{:keys [model event]}]
{:model new-model
:events [...]}) ; :events is optional
Events are maps with :type discriminator. See tui.events namespace.
## Legacy API (Deprecated)
For backward compatibility, the old signature is still supported:
(fn [model msg] [new-model cmd])
The runtime auto-detects which format is being used."
(:require [tui.terminal :as term]
[tui.input :as input]
[tui.render :as render]
[tui.ansi :as ansi]
[clojure.core.async :as async :refer [go go-loop chan <! >! >!! <!! put! close! timeout alt! alt!!]]))
;; === Command Types ===
;; === Legacy Command Types (Deprecated) ===
;; nil - no-op
;; [:quit] - exit program
;; [:batch cmd1 cmd2 ...] - run commands in parallel
;; [:seq cmd1 cmd2 ...] - run commands sequentially
;; (fn [] msg) - arbitrary async function returning message
;; === Built-in Commands ===
(def quit [:quit])
;; === Legacy Built-in Commands (Deprecated) ===
(def quit
"DEPRECATED: Use (tui.events/quit) instead."
[:quit])
(defn after
"Returns a command that sends msg after ms milliseconds.
Use this for timers, animations, or delayed actions.
"DEPRECATED: Use (tui.events/delay ms event) instead.
Example:
(after 1000 [:timer-tick])
(after 80 [:spinner-frame {:id 1}])"
Returns a command that sends msg after ms milliseconds."
[ms msg]
(fn []
(Thread/sleep ms)
msg))
(defn batch
"Run multiple commands in parallel."
"DEPRECATED: Use (tui.events/batch ...) instead.
Run multiple commands in parallel."
[& cmds]
(into [:batch] (remove nil? cmds)))
(defn sequentially
"Run multiple commands sequentially."
"DEPRECATED: Use (tui.events/sequential ...) instead.
Run multiple commands sequentially."
[& cmds]
(into [:seq] (remove nil? cmds)))
(defn send-msg
"Create a command that sends a message."
"DEPRECATED: Put event directly in :events vector instead.
Create a command that sends a message."
[msg]
(fn [] msg))
;; === Internal Command Execution ===
;; === Debounce State ===
(def ^:private debounce-timers (atom {}))
;; === Event Execution ===
(defn- execute-event!
"Execute an event, putting resulting events on the channel.
Handles runtime events (:quit, :delay, :shell, :batch, :sequential, :debounce).
Unknown event types are dispatched back to the update function."
[event msg-chan]
(when event
(let [event-type (:type event)]
(case event-type
;; Quit - signal quit
:quit
(put! msg-chan {:type :quit})
;; Delay - wait then dispatch event
:delay
(let [{:keys [ms event]} event]
(go
(<! (timeout ms))
(>! msg-chan event)))
;; Shell - run command async
:shell
(let [{:keys [cmd event]} event
cmd-str (if (vector? cmd)
(clojure.string/join " " cmd)
cmd)]
(go
(try
(let [proc (.. (ProcessBuilder. (into-array String ["sh" "-c" cmd-str]))
(redirectErrorStream false)
(start))
out (slurp (.getInputStream proc))
err (slurp (.getErrorStream proc))
exit (.waitFor proc)
success (zero? exit)]
(>! msg-chan (assoc event :result
{:exit exit
:out out
:err err
:success success})))
(catch Exception e
(>! msg-chan (assoc event :result
{:exit -1
:out ""
:err (str e)
:success false}))))))
;; Batch - run all in parallel
:batch
(doseq [e (:events event)]
(execute-event! e msg-chan))
;; Sequential - run one after another
:sequential
(go-loop [[e & rest-events] (:events event)]
(when e
(let [result-chan (chan 1)]
(execute-event! e result-chan)
(when-let [result (<! result-chan)]
(>! msg-chan result)
(recur rest-events)))))
;; Debounce - cancel pending, schedule new
:debounce
(let [{:keys [id ms event]} event]
;; Cancel existing timer for this id
(when-let [cancel-fn (get @debounce-timers id)]
(cancel-fn))
;; Schedule new timer
(let [cancelled (atom false)
cancel-fn #(reset! cancelled true)]
(swap! debounce-timers assoc id cancel-fn)
(go
(<! (timeout ms))
(when-not @cancelled
(swap! debounce-timers dissoc id)
(>! msg-chan event)))))
;; Unknown type - dispatch to update function
(put! msg-chan event)))))
;; === Legacy Command Execution ===
(defn- execute-cmd!
"Execute a command, putting resulting messages on the channel."
"Execute a legacy command, putting resulting messages on the channel."
[cmd msg-chan]
(when cmd
(cond
;; Quit command
(= cmd [:quit])
(put! msg-chan [:quit])
(put! msg-chan {:type :quit})
;; Batch - run all in parallel
(and (vector? cmd) (= (first cmd) :batch))
@@ -80,37 +185,74 @@
;; === Input Loop ===
(defn- start-input-loop!
"Start thread that reads input and puts messages on channel.
"Start thread that reads input and puts events on channel.
Uses polling with timeout to allow clean shutdown when running? becomes false."
[msg-chan running?]
(async/thread
(loop []
(when @running?
(if (term/input-ready?)
(when-let [key-msg (input/read-key)]
(>!! msg-chan key-msg))
(when-let [key-event (input/read-key)]
(>!! msg-chan key-event))
;; No input ready, sleep briefly and check running? again
(Thread/sleep 10))
(recur)))))
;; === Update Function Detection ===
(defn- detect-update-format
"Detect if update function uses new or legacy format by examining its signature.
Returns :new or :legacy."
[update-fn]
;; We can't easily detect at compile time, so we'll detect at runtime
;; by checking the result format
:unknown)
(defn- call-update
"Call update function, handling both new and legacy formats.
Returns {:model m :events [...]} in new format."
[update-fn model event legacy-mode?]
(if legacy-mode?
;; Legacy: (fn [model msg] [new-model cmd])
(let [[new-model cmd] (update-fn model event)]
{:model new-model
:legacy-cmd cmd})
;; New: (fn [{:keys [model event]}] {:model m :events [...]})
(let [result (update-fn {:model model :event event})]
(if (vector? result)
;; Got legacy format back, switch to legacy mode
{:model (first result)
:legacy-cmd (second result)
:switch-to-legacy true}
;; New format
result))))
;; === Main Run Loop ===
(defn run
"Run a TUI application.
## New API (Recommended)
Options:
- :init - Initial model (required)
- :update - (fn [model msg] [new-model cmd]) (required)
- :view - (fn [model size] hiccup) where size is {:width w :height h} (required)
- :init-cmd - Initial command to run
- :fps - Target frames per second (default 60)
- :init - Initial model (required)
- :update - (fn [{:keys [model event]}] {:model m :events [...]}) (required)
- :view - (fn [model size] hiccup) where size is {:width w :height h} (required)
- :fps - Target frames per second (default 60)
- :alt-screen - Use alternate screen buffer (default true)
## Legacy API (Deprecated)
Also accepts:
- :update - (fn [model msg] [new-model cmd])
- :init-cmd - Initial command to run
Returns the final model."
[{:keys [init update view init-cmd fps alt-screen]
[{:keys [init update view init-cmd init-events fps alt-screen]
:or {fps 60 alt-screen true}}]
(let [msg-chan (chan 256)
running? (atom true)
frame-time (/ 1000 fps)]
frame-time (/ 1000 fps)
;; Start in auto-detect mode, will switch to legacy if needed
legacy-mode? (atom false)]
;; Setup terminal
(term/raw-mode!)
@@ -122,7 +264,10 @@
;; Start input loop
(start-input-loop! msg-chan running?)
;; Execute initial command
;; Execute initial events/command
(when init-events
(doseq [event init-events]
(execute-event! event msg-chan)))
(when init-cmd
(execute-cmd! init-cmd msg-chan))
@@ -137,29 +282,36 @@
last-render (System/currentTimeMillis)]
(let [;; Wait for message with timeout for frame limiting
remaining (max 1 (- frame-time (- (System/currentTimeMillis) last-render)))
msg (alt!!
msg-chan ([v] v)
(timeout remaining) nil)]
event (alt!!
msg-chan ([v] v)
(timeout remaining) nil)]
(if (or (nil? msg) (not @running?))
(if (or (nil? event) (not @running?))
;; No message, just continue
(recur model (System/currentTimeMillis))
;; Process message
(if (= msg [:quit])
;; Check for quit
(if (or (= event {:type :quit})
(= event [:quit])) ; legacy
;; Quit - return final model
model
;; Update model
(let [[new-model cmd] (update model msg)
(let [result (call-update update model event @legacy-mode?)
_ (when (:switch-to-legacy result)
(reset! legacy-mode? true))
new-model (:model result)
size (term/get-terminal-size)
ctx {:available-height (:height size)
:available-width (:width size)}
now (System/currentTimeMillis)]
;; Execute command
(when cmd
(execute-cmd! cmd msg-chan))
;; Execute events (new API) or command (legacy)
(if-let [events (:events result)]
(doseq [e events]
(execute-event! e msg-chan))
(when-let [cmd (:legacy-cmd result)]
(execute-cmd! cmd msg-chan)))
;; Render with context for flex layouts
(term/render! (render/render (view new-model size) ctx))
@@ -169,6 +321,7 @@
(finally
;; Cleanup
(reset! running? false)
(reset! debounce-timers {})
(close! msg-chan)
(when alt-screen (term/exit-alt-screen!))
(term/restore!)
@@ -182,23 +335,28 @@
(defapp my-app
:init {:count 0}
:update (fn [model msg] ...)
:view (fn [model] ...))"
[name & {:keys [init update view init-cmd]}]
:update (fn [ctx] ...)
:view (fn [model size] ...))"
[name & {:keys [init update view init-cmd init-events]}]
`(def ~name
{:init ~init
:update ~update
:view ~view
:init-cmd ~init-cmd}))
:init-cmd ~init-cmd
:init-events ~init-events}))
;; === Key Matching Helpers ===
;; === Legacy Key Matching Helpers (Deprecated) ===
(defn key=
"Check if message is a specific key."
"DEPRECATED: Use tui.events/key= instead.
Check if message is a specific key."
[msg key-pattern]
(input/key-match? msg key-pattern))
(defn key-str
"Get string representation of key."
"DEPRECATED: Use tui.input/key->str instead.
Get string representation of key."
[msg]
(input/key->str msg))
+324
View File
@@ -0,0 +1,324 @@
(ns tui.events
"Event constructors and key matching for the TUI framework.
Events are the unified message format for the TUI system. All events
are maps with a :type key as discriminator. Events flow in both
directions: from the runtime to the update function (key presses,
shell results), and from the update function to the runtime (quit,
delay, shell commands).
## Event Format
All events are maps with :type as the discriminator:
{:type :key, :key \\a} ; key press
{:type :key, :key :enter} ; special key
{:type :key, :key \\c, :modifiers #{:ctrl}} ; with modifiers
{:type :quit} ; quit app
{:type :delay, :ms 2000, :event {...}} ; delayed event
## Update Function Contract
(fn [{:keys [model event]}]
{:model new-model
:events [...]}) ; :events is optional
## Key Event Format
Key events use :type :key with:
:key - Character (\\a-\\z, \\0-\\9) or keyword (:enter, :up, etc.)
:modifiers - Optional set of #{:ctrl :alt :shift :super :capslock}
Characters are normalized to lowercase. Uppercase letters have
:shift in :modifiers.")
;;; ============================================================
;;; Key Matching
;;; ============================================================
(defn key=
"Check if an event matches a key pattern.
Takes an event map and a key pattern, optionally with required modifiers.
Returns true if the event is a key event matching the pattern.
Arguments:
event - Event map from the TUI runtime
key - Character (\\a-\\z, \\0-\\9, etc.) or keyword (:enter, :escape, :up, etc.)
modifiers - Optional set of required modifiers: #{:ctrl :alt :shift :super :capslock}
Key patterns:
Characters are normalized to lowercase. Use #{:shift} modifier for uppercase.
Special keys use keywords: :enter :escape :tab :backspace :delete
:up :down :left :right :home :end
:page-up :page-down :insert
:f1 :f2 ... :f12
Examples:
;; Match plain 'q' key
(key= event \\q)
;; Match Enter key
(key= event :enter)
;; Match Ctrl+C
(key= event \\c #{:ctrl})
;; Match uppercase 'Z' (Shift+z)
(key= event \\z #{:shift})
;; Match Ctrl+Shift+Z (common redo shortcut)
(key= event \\z #{:ctrl :shift})
;; Match Ctrl+Enter
(key= event :enter #{:ctrl})
;; Match Alt+F4
(key= event :f4 #{:alt})
Usage in update function:
(defn update [{:keys [model event]}]
(cond
(key= event \\q) {:model model, :events [(quit)]}
(key= event \\s #{:ctrl}) {:model (save model)}
(key= event :up) {:model (cursor-up model)}
(key= event \\z #{:ctrl}) {:model (undo model)}
:else {:model model}))"
([event key]
(key= event key nil))
([event key modifiers]
(and (= (:type event) :key)
(= (:key event) key)
(= (:modifiers event) modifiers))))
;;; ============================================================
;;; Event Constructors
;;; ============================================================
(defn quit
"Create a quit event that exits the application.
Takes no arguments. When processed, cleanly shuts down the TUI,
restores terminal state, and returns the final model.
Returns:
{:type :quit}
Examples:
;; Quit on 'q' key
(defn update [{:keys [model event]}]
(if (key= event \\q)
{:model model, :events [(quit)]}
{:model model}))
;; Quit after confirmation
(defn update [{:keys [model event]}]
(cond
(and (= (:mode model) :confirm-quit)
(key= event \\y))
{:model model, :events [(quit)]}
(key= event \\q)
{:model (assoc model :mode :confirm-quit)}
:else
{:model model}))"
[]
{:type :quit})
(defn delay
"Create an event that dispatches another event after a delay.
The nested event is dispatched after the specified milliseconds elapse.
Useful for transient messages, animations, debouncing, or timeouts.
Arguments:
ms - Delay in milliseconds before dispatching
event - Event map to dispatch after the delay
Returns:
{:type :delay, :ms <ms>, :event <event>}
Examples:
;; Show a message that auto-clears after 3 seconds
(defn update [{:keys [model event]}]
(case (:type event)
:show-message
{:model (assoc model :message (:text event))
:events [(delay 3000 {:type :clear-message})]}
:clear-message
{:model (dissoc model :message)}
{:model model}))
;; Auto-save after 5 seconds of inactivity
(defn update [{:keys [model event]}]
(if (= (:type event) :key)
{:model (-> model
(update :buffer conj event)
(assoc :dirty true))
:events [(delay 5000 {:type :auto-save})]}
{:model model}))
;; Simple animation frame
{:events [(delay 16 {:type :animation-tick})]}"
[ms event]
{:type :delay, :ms ms, :event event})
(defn shell
"Create an event that runs a shell command asynchronously.
The command runs in a separate thread without blocking the UI.
When complete, dispatches the provided event with :result merged in.
Arguments:
cmd - Command as vector of strings [\"git\" \"status\"]
event - Event map to dispatch when complete.
The event will have :result key merged in with:
:exit - Exit code (0 = success)
:out - Stdout as string
:err - Stderr as string
:success - Boolean, true if exit code 0
Returns:
{:type :shell, :cmd <cmd>, :event <event>}
Examples:
;; Run git status and process result
(defn update [{:keys [model event]}]
(case (:type event)
:refresh
{:model (assoc model :loading true)
:events [(shell [\"git\" \"status\" \"--porcelain\"]
{:type :git-status-result})]}
:git-status-result
(let [{:keys [success out err]} (:result event)]
(if success
{:model (-> model
(assoc :loading false)
(assoc :files (parse-status out)))}
{:model (-> model
(assoc :loading false)
(assoc :error err))}))
{:model model}))
;; Run git diff for selected file
(shell [\"git\" \"diff\" \"--\" path]
{:type :diff-result, :file file})
;; Pass context through the event
(shell [\"git\" \"add\" \"--\" path]
{:type :file-staged, :path path})"
[cmd event]
{:type :shell, :cmd cmd, :event event})
(defn batch
"Create an event that processes multiple events in parallel.
All events start immediately and run concurrently.
Useful when you need to trigger multiple independent operations.
Arguments:
events - Variable number of event maps
Returns:
{:type :batch, :events [<events>]}
Returns nil if no events provided.
Examples:
;; Refresh multiple data sources in parallel
(defn update [{:keys [model event]}]
(if (key= event \\r)
{:model (assoc model :loading true)
:events [(batch
(shell [\"git\" \"status\" \"--porcelain\"]
{:type :status-result})
(shell [\"git\" \"log\" \"--oneline\" \"-10\"]
{:type :log-result})
(shell [\"git\" \"branch\"]
{:type :branch-result}))]}
{:model model}))
;; Show message and trigger async operation
(batch
{:type :show-spinner}
(shell [\"git\" \"push\"] {:type :push-complete}))"
[& events]
(when-let [evts (seq (remove nil? events))]
{:type :batch, :events (vec evts)}))
(defn sequential
"Create an event that processes multiple events in sequence.
Each event completes before the next one starts.
The result events are dispatched in order.
Useful when operations must happen in a specific order.
Arguments:
events - Variable number of event maps
Returns:
{:type :sequential, :events [<events>]}
Returns nil if no events provided.
Examples:
;; Stage file, then commit, then push
(sequential
(shell [\"git\" \"add\" \"--all\"] {:type :staged})
(shell [\"git\" \"commit\" \"-m\" msg] {:type :committed})
(shell [\"git\" \"push\"] {:type :pushed}))
;; Show message, wait, then clear
(sequential
{:type :show-message, :text \"Saved!\"}
(delay 2000 {:type :clear-message}))
Note:
For complex workflows, consider handling each step explicitly
in your update function for better error handling and control."
[& events]
(when-let [evts (seq (remove nil? events))]
{:type :sequential, :events (vec evts)}))
(defn debounce
"Create an event that debounces dispatch.
Delays dispatching the event until the specified time has passed
without another debounce event with the same id being created.
Useful for search-as-you-type, resize handling, or any input
that fires rapidly but should only trigger action after settling.
Arguments:
id - Keyword identifying this debounce group. New debounce
events with the same id cancel pending ones.
ms - Milliseconds to wait after last debounce before dispatching
event - Event map to dispatch after debounce period
Returns:
{:type :debounce, :id <id>, :ms <ms>, :event <event>}
Examples:
;; Search as you type with 300ms debounce
(defn update [{:keys [model event]}]
(if (and (= (:type event) :key)
(= (:mode model) :search))
(let [new-query (str (:query model) (:key event))]
{:model (assoc model :query new-query)
:events [(debounce :search 300
{:type :execute-search, :query new-query})]})
{:model model}))
;; Debounce window resize events
(defn update [{:keys [model event]}]
(if (= (:type event) :resize)
{:model model
:events [(debounce :resize 100
{:type :layout-changed
:width (:width event)
:height (:height event)})]}
{:model model}))"
[id ms event]
{:type :debounce, :id id, :ms ms, :event event})
+140 -60
View File
@@ -1,12 +1,27 @@
(ns tui.input
"Parse terminal input into key messages."
"Parse terminal input into key events.
Key events are maps with the following structure:
{:type :key, :key <key>, :modifiers <set>}
Where:
:key - Character (lowercase \\a-\\z, \\0-\\9, etc.) or keyword
(:enter, :escape, :up, :down, etc.)
:modifiers - Optional set of #{:ctrl :alt :shift}
Omitted when empty.
Examples:
{:type :key, :key \\a} ; lowercase 'a'
{:type :key, :key \\a, :modifiers #{:shift}} ; uppercase 'A'
{:type :key, :key \\c, :modifiers #{:ctrl}} ; Ctrl+C
{:type :key, :key :enter} ; Enter key
{:type :key, :key :f1, :modifiers #{:alt}} ; Alt+F1"
(:require [tui.terminal :as term]))
;; === Key Message Structure ===
;; [:key {:type :rune :char \a}]
;; [:key {:type :special :key :up}]
;; [:key {:type :special :key :enter}]
;; [:key {:type :ctrl :char \c}]
;; === Control Key Mappings ===
;; Maps byte codes 0-31 to either:
;; - [:ctrl \x] for Ctrl+letter combinations
;; - keyword for special keys (:enter, :tab, etc.)
(def ^:private ctrl-keys
{0 [:ctrl \space] ; Ctrl+Space / Ctrl+@
@@ -22,6 +37,9 @@
28 [:ctrl \\] 29 [:ctrl \]] 30 [:ctrl \^]
31 [:ctrl \_] 127 :backspace})
;; === CSI Escape Sequences ===
;; Maps escape sequences to special key keywords
(def ^:private csi-sequences
{"A" :up "B" :down "C" :right "D" :left
"H" :home "F" :end "Z" :shift-tab
@@ -35,13 +53,34 @@
;; xterm-style function keys
"OP" :f1 "OQ" :f2 "OR" :f3 "OS" :f4})
;; === Event Constructors ===
(defn- make-key-event
"Create a key event map. Omits :modifiers when empty."
([key]
{:type :key, :key key})
([key modifiers]
(if (seq modifiers)
{:type :key, :key key, :modifiers modifiers}
{:type :key, :key key})))
(defn- normalize-char
"Normalize a character to lowercase and return [char modifiers].
Uppercase letters get #{:shift} modifier."
[c]
(if (Character/isUpperCase c)
[(Character/toLowerCase c) #{:shift}]
[c nil]))
;; === Escape Sequence Parsing ===
(defn- read-escape-sequence
"Read and parse an escape sequence."
[]
(let [c2 (term/read-char-timeout 50)]
(cond
(nil? c2)
[:key :escape]
(make-key-event :escape)
(= c2 \[)
;; CSI sequence
@@ -49,7 +88,7 @@
(let [c (term/read-char-timeout 50)]
(cond
(nil? c)
[:key :escape]
(make-key-event :escape)
;; Parameters and intermediates
(or (<= 0x30 (int c) 0x3F) ; 0-9:;<=>?
@@ -60,27 +99,39 @@
(<= 0x40 (int c) 0x7E)
(let [seq-str (str (apply str buf) c)]
(if-let [key (get csi-sequences seq-str)]
[:key key]
[:key :unknown seq-str]))
(make-key-event key)
(make-key-event :unknown)))
:else
[:key :unknown (str "[" (apply str buf) c)])))
(make-key-event :unknown))))
(= c2 \O)
;; SS3 sequence (F1-F4 on some terminals)
(let [c3 (term/read-char-timeout 50)]
(if c3
(if-let [key (get csi-sequences (str "O" c3))]
[:key key]
[:key :unknown (str "O" c3)])
[:key :escape]))
(make-key-event key)
(make-key-event :unknown))
(make-key-event :escape)))
:else
;; Alt+key
[:key {:alt true :char c2}])))
(let [[normalized-char shift-mod] (normalize-char c2)
modifiers (if shift-mod
#{:alt :shift}
#{:alt})]
(make-key-event normalized-char modifiers)))))
;; === Main Key Reading ===
(defn read-key
"Read a single key event. Returns [:key ...] message."
"Read a single key event from terminal input.
Returns a key event map:
{:type :key, :key <key>}
{:type :key, :key <key>, :modifiers #{...}}
Returns nil if no input available."
[]
(when-let [c (term/read-char)]
(let [code (int c)]
@@ -89,64 +140,93 @@
(= code 27)
(read-escape-sequence)
;; Control characters
;; Control characters (0-31)
(<= 0 code 31)
(let [key (get ctrl-keys code)]
(if (vector? key)
[:key {:ctrl true :char (second key)}]
[:key key]))
;; [:ctrl \x] format
(make-key-event (second key) #{:ctrl})
;; keyword like :enter, :tab
(make-key-event key)))
;; DEL (Ctrl+Backspace on some terminals)
(= code 127)
[:key :backspace]
(make-key-event :backspace)
;; Normal character
;; Normal character - normalize case
:else
[:key {:char c}]))))
(let [[normalized-char shift-mod] (normalize-char c)]
(make-key-event normalized-char shift-mod))))))
;; === Legacy Compatibility ===
;; These functions support the old API during migration
(defn key-match?
"Check if a key message matches a pattern.
Patterns: :enter, :up, \"q\", [:ctrl \\c], etc."
[msg pattern]
(when (= (first msg) :key)
(let [key (second msg)]
(cond
;; Simple keyword match
(keyword? pattern)
(or (= key pattern)
(= (:key key) pattern))
"DEPRECATED: Use tui.events/key= instead.
;; String match (single char)
(string? pattern)
(and (map? key)
(= (:char key) (first pattern))
(not (:ctrl key))
(not (:alt key)))
Check if a key event matches a pattern.
Supports both old [:key ...] and new {:type :key ...} formats."
[event pattern]
(let [;; Handle both old and new event formats
key-data (if (vector? event)
(second event)
event)
;; Extract key and modifiers from new format
key-val (if (map? key-data)
(or (:key key-data) (:char key-data))
key-data)
modifiers (when (map? key-data)
(:modifiers key-data))
has-ctrl (or (contains? modifiers :ctrl)
(when (map? key-data) (:ctrl key-data)))
has-alt (or (contains? modifiers :alt)
(when (map? key-data) (:alt key-data)))]
(cond
;; Simple keyword match (:enter, :up, etc.)
(keyword? pattern)
(= key-val pattern)
;; Vector pattern [:ctrl \c]
(vector? pattern)
(let [[mod ch] pattern]
(and (map? key)
(case mod
:ctrl (and (:ctrl key) (= (:char key) ch))
:alt (and (:alt key) (= (:char key) ch))
false)))
;; String match (single char) - no modifiers
(string? pattern)
(and (= key-val (first pattern))
(not has-ctrl)
(not has-alt))
:else false))))
;; Vector pattern [:ctrl \c]
(vector? pattern)
(let [[mod ch] pattern]
(and (= key-val ch)
(case mod
:ctrl has-ctrl
:alt has-alt
false)))
:else false)))
(defn key->str
"Convert key message to human-readable string."
[msg]
(when (= (first msg) :key)
(let [key (second msg)]
(cond
(keyword? key)
(name key)
"Convert key event to human-readable string.
Supports both old [:key ...] and new {:type :key ...} formats."
[event]
(let [;; Handle both old and new event formats
key-data (if (vector? event)
(second event)
event)]
(cond
(keyword? key-data)
(name key-data)
(map? key)
(str (when (:ctrl key) "ctrl+")
(when (:alt key) "alt+")
(:char key))
(map? key-data)
(let [key-val (or (:key key-data) (:char key-data))
modifiers (:modifiers key-data)
ctrl (or (contains? modifiers :ctrl) (:ctrl key-data))
alt (or (contains? modifiers :alt) (:alt key-data))
shift (contains? modifiers :shift)]
(str (when ctrl "ctrl+")
(when alt "alt+")
(when shift "shift+")
(if (keyword? key-val)
(name key-val)
key-val)))
:else
(str key)))))
:else
(str key-data))))
+395 -47
View File
@@ -3,6 +3,120 @@
(:require [tui.ansi :as ansi]
[clojure.string :as str]))
;; === Enhanced Sizing System ===
(defn parse-size-spec
"Parse a size specification into a normalized map.
Supports:
- Numbers: fixed size (e.g., 30)
- :flex or {:flex n}: weighted flex (default weight 1)
- \"N%\": percentage of remaining space
- \"Nfr\": fractional unit (like CSS Grid fr)
- {:percent N :min X :max Y}: percentage with constraints
Returns {:type :fixed|:flex|:percent|:fr :value N :min M :max M}"
[spec]
(cond
;; nil means auto-size (not constrained)
(nil? spec)
{:type :auto :value nil}
;; Numbers are fixed
(number? spec)
{:type :fixed :value spec}
;; :flex is shorthand for {:flex 1}
(= spec :flex)
{:type :flex :value 1}
;; {:flex n} for weighted flex
(and (map? spec) (:flex spec))
{:type :flex :value (:flex spec) :min (:min spec) :max (:max spec)}
;; {:percent n ...} for percentage with constraints
(and (map? spec) (:percent spec))
{:type :percent :value (:percent spec) :min (:min spec) :max (:max spec)}
;; String "N%" for percentage
(and (string? spec) (str/ends-with? spec "%"))
(let [n (parse-long (subs spec 0 (dec (count spec))))]
{:type :percent :value n})
;; String "Nfr" for fractional unit (treated like flex)
(and (string? spec) (str/ends-with? spec "fr"))
(let [n (parse-long (subs spec 0 (- (count spec) 2)))]
{:type :fr :value n})
;; Unknown - treat as auto
:else
{:type :auto :value nil}))
(defn calculate-sizes
"Calculate sizes for children given a size specification.
Uses 4-phase algorithm:
1. Fixed - subtract literal numbers from available
2. Percentages - calculate against remaining (scale if >100%)
3. Fr/Flex - divide remaining proportionally
4. Constraints - apply min/max, redistribute if needed
Returns vector of calculated sizes (numbers or nil for auto)."
[specs children available-size gap]
(let [num-children (count children)
;; Ensure we have specs for all children
specs-vec (if specs
(vec (take num-children (concat specs (repeat nil))))
(vec (repeat num-children nil)))
;; Parse all specs
parsed (mapv parse-size-spec specs-vec)
;; Calculate total gap
total-gap (* gap (max 0 (dec num-children)))
usable-size (max 0 (- available-size total-gap))
;; Phase 1: Fixed sizes
fixed-total (reduce + 0 (for [p parsed :when (= (:type p) :fixed)]
(:value p)))
after-fixed (max 0 (- usable-size fixed-total))
;; Phase 2: Percentages (calculate against remaining after fixed)
percent-specs (filter #(= (:type %) :percent) parsed)
total-percent (reduce + 0 (map :value percent-specs))
;; Scale down if percentages exceed 100%
percent-scale (if (> total-percent 100) (/ 100.0 total-percent) 1.0)
percent-sizes (for [p parsed]
(when (= (:type p) :percent)
(int (* after-fixed (/ (* (:value p) percent-scale) 100.0)))))
percent-total (reduce + 0 (filter some? percent-sizes))
after-percent (max 0 (- after-fixed percent-total))
;; Phase 3: Fr/Flex units (divide remaining proportionally)
flex-specs (filter #(#{:flex :fr} (:type %)) parsed)
total-flex-weight (reduce + 0 (map :value flex-specs))
flex-unit (if (pos? total-flex-weight)
(/ after-percent total-flex-weight)
0)
;; Calculate final sizes
raw-sizes (mapv (fn [p pct-size]
(case (:type p)
:fixed (:value p)
:percent pct-size
:flex (int (* (:value p) flex-unit))
:fr (int (* (:value p) flex-unit))
:auto nil))
parsed
(concat percent-sizes (repeat nil)))
;; Phase 4: Apply constraints (min/max)
constrained (mapv (fn [size p]
(if (and size (or (:min p) (:max p)))
(cond-> size
(:min p) (max (:min p))
(:max p) (min (:max p)))
size))
raw-sizes
parsed)]
constrained))
;; === Hiccup Parsing ===
(defn- flatten-children
"Flatten sequences in children (but not vectors, which are hiccup elements)."
@@ -47,7 +161,6 @@
;; === Layout Primitives ===
(declare render-element)
(declare calculate-flex-sizes)
(defn- render-children
"Render all children and return list of rendered strings."
@@ -58,14 +171,16 @@
"Render :row - horizontal layout with proper multi-line support.
Each child is rendered and placed side-by-side, with lines aligned.
Supports :gap for spacing and :widths for column widths.
:widths can be numbers (fixed), :flex (share remaining), or nil (auto).
Example: [:row {:widths [20 :flex :flex]} child1 child2 child3]"
:widths can be: numbers (fixed), :flex/{:flex n} (weighted share),
\"N%\" (percentage), \"Nfr\" (fractional unit), or nil (auto).
Example: [:row {:widths [20 :flex :flex]} child1 child2 child3]
Example: [:row {:widths [\"30%\" \"2fr\" \"1fr\"]} child1 child2 child3]"
[{:keys [gap widths] :or {gap 0}} children ctx]
(let [available-width (or (:available-width ctx) 120)
available-height (or (:available-height ctx) 100)
;; Calculate flex widths if :flex is used
calculated-widths (when (and widths (some #(= % :flex) widths))
(calculate-flex-sizes widths children available-width gap))
;; Use new enhanced sizing system
calculated-widths (when widths
(calculate-sizes widths children available-width gap))
;; Render each child with its allocated width in context
rendered (map-indexed
(fn [idx child]
@@ -79,10 +194,8 @@
child-lines (mapv #(str/split % #"\n" -1) rendered)
;; Calculate width of each child
child-widths (cond
;; Use calculated flex widths
;; Use calculated widths (includes flex, percent, fr)
calculated-widths calculated-widths
;; Use provided fixed widths
widths widths
;; Auto: max visible length of lines
:else (mapv (fn [lines]
(apply max 0 (map ansi/visible-length lines)))
@@ -99,49 +212,25 @@
(fn [child-idx lines]
(let [line (get lines line-idx "")
width (get child-widths child-idx 0)]
(ansi/pad-right line width)))
(ansi/pad-right line (or width 0))))
child-lines)))]
(str/join "\n" combined-lines)))
(defn- calculate-flex-sizes
"Calculate sizes for children given a spec.
Sizes can be: numbers (fixed), :flex (share remaining), or nil (auto).
Returns vector of calculated sizes."
[sizes children available-size gap]
(let [num-children (count children)
sizes-vec (if sizes
(vec (take num-children (concat sizes (repeat nil))))
(vec (repeat num-children nil)))
;; Total gap space
total-gap (* gap (max 0 (dec num-children)))
usable-size (- available-size total-gap)
;; Count fixed sizes and flex items
fixed-total (reduce + 0 (filter number? sizes-vec))
flex-count (count (filter #(= % :flex) sizes-vec))
;; Calculate size per flex item
remaining (- usable-size fixed-total)
flex-size (if (pos? flex-count)
(max 1 (quot remaining flex-count))
0)]
;; Return calculated sizes
(mapv (fn [s]
(cond
(number? s) s
(= s :flex) flex-size
:else nil)) ; nil means auto-size
sizes-vec)))
(defn- render-col
"Render :col - vertical layout.
Supports :heights for distributing vertical space.
Heights can be numbers (fixed) or :flex (share remaining space).
Example: [:col {:heights [3 :flex :flex 4]} child1 child2 child3 child4]"
Heights can be: numbers (fixed), :flex/{:flex n} (weighted share),
\"N%\" (percentage), \"Nfr\" (fractional unit), or nil (auto).
Example: [:col {:heights [3 :flex :flex 4]} child1 child2 child3 child4]
Example: [:col {:heights [\"10%\" \"2fr\" \"1fr\"]} child1 child2 child3]"
[{:keys [gap heights width height] :or {gap 0}} children ctx]
(let [;; Use explicit width/height if provided, otherwise from context
available-width (or width (:available-width ctx) 120)
available-height (or height (:available-height ctx) 100)
;; Use new enhanced sizing system
calculated-heights (when heights
(calculate-flex-sizes heights children available-height gap))
(calculate-sizes heights children available-height gap))
;; Render each child with its allocated height in context
rendered (map-indexed
(fn [idx child]
@@ -304,6 +393,241 @@
result-lines (overlay-lines bg-lines modal-lines available-width available-height)]
(str/join "\n" result-lines)))
;; === Scroll Primitive ===
(defn visible-window-calc
"Calculate the visible window of items for scrolling.
Returns {:start start-index :end end-index :has-above bool :has-below bool}
Keeps cursor visible by scrolling the window."
[total-items cursor max-visible]
(let [max-visible (max 1 max-visible)]
(if (<= total-items max-visible)
;; All items fit, no scrolling needed
{:start 0 :end total-items :has-above false :has-below false}
;; Need to scroll - calculate window that keeps cursor visible
(let [half (quot max-visible 2)
start-idx (cond
;; Cursor near start - show from beginning
(<= cursor half) 0
;; Cursor near end - show end portion
(>= cursor (- total-items half)) (- total-items max-visible)
;; Cursor in middle - center it
:else (- cursor half))
start-idx (max 0 (min start-idx (- total-items max-visible)))
end-idx (+ start-idx max-visible)]
{:start start-idx
:end end-idx
:has-above (pos? start-idx)
:has-below (< end-idx total-items)}))))
(defn- render-scroll
"Render :scroll - scrollable container with automatic windowing.
Renders only the visible children based on available-height and cursor position.
Shows ↑/↓ indicators when content is clipped.
Attrs:
- :cursor - index of currently selected item (default 0)
- :indicators - show scroll indicators when clipped (default true)
Example: [:scroll {:cursor 3} child0 child1 child2 child3 child4 ...]"
[{:keys [cursor indicators] :or {cursor 0 indicators true}} children ctx]
(let [available-height (or (:available-height ctx) 100)
total-items (count children)
;; Reserve space for indicators if enabled
indicator-height (if indicators 1 0)
max-visible (- available-height (* 2 indicator-height))
max-visible (max 1 max-visible)
;; Calculate visible window
{:keys [start end has-above has-below]} (visible-window-calc total-items cursor max-visible)
;; Get visible children
visible-children (subvec (vec children) start end)
;; Render visible children
rendered-lines (mapv #(render-element % ctx) visible-children)
;; Build result with indicators
up-indicator (when (and indicators has-above)
(ansi/style "↑" :fg :cyan))
down-indicator (when (and indicators has-below)
(ansi/style "↓" :fg :cyan))
all-lines (cond-> []
up-indicator (conj up-indicator)
true (into rendered-lines)
down-indicator (conj down-indicator))]
(str/join "\n" all-lines)))
;; === Grid Primitive ===
(defn- parse-template
"Parse grid template strings into a position map.
Template like [\"header header\" \"nav main\" \"footer footer\"]
Returns a map of {name {:row row :col col :row-span n :col-span n}}"
[template]
(let [rows (mapv #(str/split % #"\s+") template)
num-rows (count rows)
num-cols (apply max 1 (map count rows))
;; Normalize rows to have same number of columns
normalized-rows (mapv #(vec (take num-cols (concat % (repeat nil)))) rows)
;; Build position map
positions (atom {})]
;; Find each named area's bounds
(doseq [row-idx (range num-rows)
col-idx (range num-cols)]
(let [name (get-in normalized-rows [row-idx col-idx])]
(when (and name (not= name ".")) ;; "." means empty cell
(if-let [existing (get @positions name)]
;; Extend existing area
(swap! positions update name
(fn [area]
(-> area
(update :row-span #(max % (- (inc row-idx) (:row area))))
(update :col-span #(max % (- (inc col-idx) (:col area)))))))
;; New area
(swap! positions assoc name {:row row-idx :col col-idx :row-span 1 :col-span 1})))))
@positions))
(defn- parse-area-children
"Extract area definitions from grid children.
Returns map of position -> child element for explicit positioning,
or name -> child element for named template areas."
[children]
(reduce
(fn [acc child]
(if (and (vector? child) (= :area (first child)))
(let [[_ attrs & content] (if (map? (second child))
child
(into [(first child) {}] (rest child)))
content (if (= 1 (count content)) (first content) (vec content))]
(if (:name attrs)
;; Named area
(assoc-in acc [:named (:name attrs)] {:attrs attrs :content content})
;; Explicit position
(let [row (or (:row attrs) 0)
col (or (:col attrs) 0)]
(assoc-in acc [:positioned [row col]] {:attrs attrs :content content}))))
;; Not an area - treat as positioned at auto-incrementing position
acc))
{:named {} :positioned {}}
children))
(defn- create-canvas
"Create a 2D canvas (vector of vectors of characters/strings)."
[width height]
(vec (repeat height (vec (repeat width " ")))))
(defn- overlay-on-canvas
"Overlay rendered content on canvas at given position."
[canvas content x y width height]
(let [lines (str/split content #"\n" -1)
lines (take height lines)]
(reduce
(fn [c [line-idx line]]
(let [line-chars (vec (seq (ansi/pad-right line width)))
row-idx (+ y line-idx)]
(if (< row-idx (count c))
(update c row-idx
(fn [row]
(reduce
(fn [r [char-idx char]]
(let [col-idx (+ x char-idx)]
(if (< col-idx (count r))
(assoc r col-idx (str char))
r)))
row
(map-indexed vector line-chars))))
c)))
canvas
(map-indexed vector lines))))
(defn- render-grid
"Render :grid - 2D grid layout.
Supports two positioning modes:
1. Explicit positioning:
[:grid {:rows [3 :flex :flex] :cols [30 :flex] :gap 1}
[:area {:row 0 :col 0 :col-span 2} header]
[:area {:row 1 :col 0} nav]
[:area {:row 1 :col 1} main]]
2. Named template:
[:grid {:template [\"header header\"
\"nav main\"]
:rows [3 :flex]
:cols [30 :flex]}
[:area {:name \"header\"} header-content]
[:area {:name \"nav\"} nav-content]
[:area {:name \"main\"} main-content]]
Attrs:
- :rows - row size specs (numbers, :flex, %, fr)
- :cols - column size specs
- :gap - gap between cells (number or [row-gap col-gap])
- :template - optional template strings for named areas"
[{:keys [rows cols gap template] :or {gap 0}} children ctx]
(let [available-width (or (:available-width ctx) 120)
available-height (or (:available-height ctx) 100)
;; Parse gap
[row-gap col-gap] (if (vector? gap) gap [gap gap])
;; Parse template if provided
template-positions (when template (parse-template template))
;; Determine grid dimensions
num-rows (if template
(count template)
(or (count rows) 1))
num-cols (if template
(apply max 1 (map #(count (str/split % #"\s+")) template))
(or (count cols) 1))
;; Default row/col specs if not provided
rows (or rows (vec (repeat num-rows :flex)))
cols (or cols (vec (repeat num-cols :flex)))
;; Calculate row heights and column widths
row-heights (calculate-sizes rows (range num-rows) available-height row-gap)
col-widths (calculate-sizes cols (range num-cols) available-width col-gap)
;; Parse area children
{:keys [named positioned]} (parse-area-children children)
;; Merge template positions with named areas
areas (if template-positions
(reduce-kv
(fn [acc name pos]
(if-let [area (get named name)]
(assoc acc [(:row pos) (:col pos)]
{:attrs (merge pos (:attrs area))
:content (:content area)})
acc))
positioned
template-positions)
positioned)
;; Calculate positions for each cell
row-positions (reductions + 0 (interpose row-gap row-heights))
col-positions (reductions + 0 (interpose col-gap col-widths))
;; Create canvas
total-height (+ (reduce + 0 row-heights) (* row-gap (max 0 (dec num-rows))))
total-width (+ (reduce + 0 col-widths) (* col-gap (max 0 (dec num-cols))))
canvas (create-canvas total-width total-height)
;; Render each area
final-canvas
(reduce-kv
(fn [c [row col] {:keys [attrs content]}]
(let [row-span (or (:row-span attrs) 1)
col-span (or (:col-span attrs) 1)
;; Calculate cell dimensions
cell-height (+ (reduce + 0 (take row-span (drop row row-heights)))
(* row-gap (max 0 (dec row-span))))
cell-width (+ (reduce + 0 (take col-span (drop col col-widths)))
(* col-gap (max 0 (dec col-span))))
;; Calculate cell position
cell-y (nth (vec row-positions) row 0)
cell-x (nth (vec col-positions) col 0)
;; Render content with cell dimensions in context
cell-ctx (assoc ctx
:available-width cell-width
:available-height cell-height)
rendered (render-element content cell-ctx)]
(overlay-on-canvas c rendered cell-x cell-y cell-width cell-height)))
canvas
areas)]
;; Convert canvas to string
(str/join "\n" (map #(apply str %) final-canvas))))
;; === Main Render Function ===
(defn render-element
"Render a hiccup element to ANSI string."
@@ -322,13 +646,16 @@
(vector? elem)
(let [[tag attrs children] (parse-element elem)]
(case tag
:text (render-text attrs children)
:row (render-row attrs children ctx)
:col (render-col attrs children ctx)
:box (render-box attrs children ctx)
:space (render-space attrs children ctx)
:input (render-input attrs children ctx)
:modal (render-modal attrs children ctx)
:text (render-text attrs children)
:row (render-row attrs children ctx)
:col (render-col attrs children ctx)
:box (render-box attrs children ctx)
:space (render-space attrs children ctx)
:input (render-input attrs children ctx)
:modal (render-modal attrs children ctx)
:scroll (render-scroll attrs children ctx)
:grid (render-grid attrs children ctx)
:area (apply str (render-children children ctx)) ;; Areas are handled by grid
;; Default: just render children
(apply str (render-children children ctx))))
@@ -369,3 +696,24 @@
(if (map? (first args))
(into [:box (first args)] (rest args))
(into [:box {}] args)))
(defn scroll
"Create a scrollable container."
[& args]
(if (map? (first args))
(into [:scroll (first args)] (rest args))
(into [:scroll {}] args)))
(defn grid
"Create a 2D grid layout."
[& args]
(if (map? (first args))
(into [:grid (first args)] (rest args))
(into [:grid {}] args)))
(defn area
"Create a grid area (used inside :grid)."
[& args]
(if (map? (first args))
(into [:area (first args)] (rest args))
(into [:area {}] args)))
+146 -30
View File
@@ -4,16 +4,17 @@
(:require [clojure.test :refer [deftest testing is]]
[clojure.core.async :as async :refer [chan >!! <!! timeout alt!! close!]]
[tui.core :as tui]
[tui.events :as ev]
[tui.render :as render]))
;; === Command Tests ===
;; === Legacy Command Tests (Backward Compatibility) ===
(deftest quit-command-test
(testing "quit command is correct vector"
(testing "quit command is correct vector (legacy)"
(is (= [:quit] tui/quit))))
(deftest after-command-test
(testing "after creates a function command"
(testing "after creates a function command (legacy)"
(let [cmd (tui/after 0 :my-tick)]
(is (fn? cmd))
(is (= :my-tick (cmd)))))
@@ -23,16 +24,15 @@
(is (= :simple-msg ((tui/after 0 :simple-msg)))))
(testing "after with non-zero delay creates function"
;; Don't invoke - these would sleep
(is (fn? (tui/after 100 :tick)))
(is (fn? (tui/after 1000 :tick)))))
(deftest batch-command-test
(testing "batch combines commands"
(testing "batch combines commands (legacy)"
(let [cmd (tui/batch (tui/send-msg :msg1) tui/quit)]
(is (vector? cmd))
(is (= :batch (first cmd)))
(is (= 3 (count cmd))) ; [:batch fn [:quit]]
(is (= 3 (count cmd)))
(is (= [:quit] (last cmd)))))
(testing "batch filters nil commands"
@@ -41,7 +41,7 @@
(is (= 2 (count cmd))))))
(deftest sequentially-command-test
(testing "sequentially creates seq command"
(testing "sequentially creates seq command (legacy)"
(let [cmd (tui/sequentially (tui/send-msg :msg1) tui/quit)]
(is (vector? cmd))
(is (= :seq (first cmd)))
@@ -54,24 +54,35 @@
(is (= 2 (count cmd))))))
(deftest send-msg-command-test
(testing "send-msg creates function that returns message"
(testing "send-msg creates function that returns message (legacy)"
(let [cmd (tui/send-msg {:type :custom :data 42})]
(is (fn? cmd))
(is (= {:type :custom :data 42} (cmd))))))
;; === Key Matching Tests ===
;; === Legacy Key Matching Tests ===
(deftest key=-test
(testing "key= delegates to input/key-match?"
(deftest key=-legacy-test
(testing "key= works with legacy format"
(is (tui/key= [:key {:char \q}] "q"))
(is (tui/key= [:key :enter] :enter))
(is (tui/key= [:key {:ctrl true :char \c}] [:ctrl \c]))
(is (not (tui/key= [:key {:char \a}] "b")))))
(deftest key=-new-format-test
(testing "key= works with new format"
(is (tui/key= {:type :key :key \q} "q"))
(is (tui/key= {:type :key :key :enter} :enter))
(is (tui/key= {:type :key :key \c :modifiers #{:ctrl}} [:ctrl \c]))
(is (not (tui/key= {:type :key :key \a} "b")))))
(deftest key-str-test
(testing "key-str converts key to string"
(testing "key-str converts key to string (legacy)"
(is (= "q" (tui/key-str [:key {:char \q}])))
(is (= "enter" (tui/key-str [:key :enter])))))
(is (= "enter" (tui/key-str [:key :enter]))))
(testing "key-str converts key to string (new format)"
(is (= "q" (tui/key-str {:type :key :key \q})))
(is (= "enter" (tui/key-str {:type :key :key :enter})))))
;; === Full Pipeline Tests ===
@@ -87,8 +98,36 @@
(is (clojure.string/includes? rendered "Counter"))
(is (clojure.string/includes? rendered "Count: 5")))))
(deftest update-function-contract-test
(testing "update function returns [model cmd] tuple"
;; === New API Update Function Tests ===
(deftest new-update-function-contract-test
(testing "new update function returns {:model ... :events ...}"
(let [update-fn (fn [{:keys [model event]}]
(cond
(ev/key= event \q) {:model model :events [(ev/quit)]}
(ev/key= event :up) {:model (update model :n inc)}
:else {:model model}))
model {:n 0}]
;; Test quit returns event
(let [{:keys [model events]} (update-fn {:model model :event {:type :key :key \q}})]
(is (= {:n 0} model))
(is (= [{:type :quit}] events)))
;; Test up returns updated model
(let [{:keys [model events]} (update-fn {:model model :event {:type :key :key :up}})]
(is (= {:n 1} model))
(is (nil? events)))
;; Test unknown key returns model unchanged
(let [{:keys [model events]} (update-fn {:model model :event {:type :key :key \x}})]
(is (= {:n 0} model))
(is (nil? events))))))
;; === Legacy Update Function Tests ===
(deftest legacy-update-function-contract-test
(testing "legacy update function returns [model cmd] tuple"
(let [update-fn (fn [model msg]
(cond
(tui/key= msg "q") [model tui/quit]
@@ -111,20 +150,87 @@
(is (= model new-model))
(is (nil? cmd))))))
;; === Command Execution Tests ===
;; These test the internal command execution logic
;; === Event Execution Tests ===
(deftest execute-quit-command-test
(testing "quit command puts :quit on channel"
(deftest execute-quit-event-test
(testing "quit event puts {:type :quit} on channel"
(let [msg-chan (chan 1)]
(#'tui/execute-event! {:type :quit} msg-chan)
(let [result (alt!!
msg-chan ([v] v)
(timeout 100) :timeout)]
(is (= {:type :quit} result)))
(close! msg-chan))))
(deftest execute-delay-event-test
(testing "delay event sends message after delay"
(let [msg-chan (chan 1)
event (ev/delay 50 {:type :delayed-msg})]
(#'tui/execute-event! event msg-chan)
;; Should not receive immediately
(let [immediate (alt!!
msg-chan ([v] v)
(timeout 10) :timeout)]
(is (= :timeout immediate)))
;; Should receive after delay
(let [delayed (alt!!
msg-chan ([v] v)
(timeout 200) :timeout)]
(is (= {:type :delayed-msg} delayed)))
(close! msg-chan))))
(deftest execute-batch-event-test
(testing "batch executes multiple events"
(let [msg-chan (chan 10)]
(#'tui/execute-event! {:type :batch
:events [{:type :msg1}
{:type :msg2}]}
msg-chan)
;; Give time for dispatch
(Thread/sleep 50)
(let [results (loop [msgs []]
(let [msg (alt!!
msg-chan ([v] v)
(timeout 10) nil)]
(if msg
(recur (conj msgs msg))
msgs)))]
(is (= #{{:type :msg1} {:type :msg2}} (set results))))
(close! msg-chan))))
(deftest execute-unknown-event-test
(testing "unknown event type is dispatched to update"
(let [msg-chan (chan 1)]
(#'tui/execute-event! {:type :custom-app-event :data 42} msg-chan)
(let [result (alt!!
msg-chan ([v] v)
(timeout 100) :timeout)]
(is (= {:type :custom-app-event :data 42} result)))
(close! msg-chan))))
(deftest execute-nil-event-test
(testing "nil event does nothing"
(let [msg-chan (chan 1)]
(#'tui/execute-event! nil msg-chan)
(let [result (alt!!
msg-chan ([v] v)
(timeout 50) :timeout)]
(is (= :timeout result)))
(close! msg-chan))))
;; === Legacy Command Execution Tests ===
(deftest execute-quit-command-legacy-test
(testing "quit command puts {:type :quit} on channel"
(let [msg-chan (chan 1)]
(#'tui/execute-cmd! [:quit] msg-chan)
(let [result (alt!!
msg-chan ([v] v)
(timeout 100) :timeout)]
(is (= [:quit] result)))
(is (= {:type :quit} result)))
(close! msg-chan))))
(deftest execute-after-command-test
(deftest execute-after-command-legacy-test
(testing "after command sends message after delay"
(let [msg-chan (chan 1)
cmd (tui/after 50 :delayed-msg)]
@@ -141,7 +247,7 @@
(is (= :delayed-msg delayed)))
(close! msg-chan))))
(deftest execute-function-command-test
(deftest execute-function-command-legacy-test
(testing "function command executes and sends result"
(let [msg-chan (chan 1)
cmd (fn [] {:custom :message})]
@@ -152,7 +258,7 @@
(is (= {:custom :message} result)))
(close! msg-chan))))
(deftest execute-batch-command-test
(deftest execute-batch-command-legacy-test
(testing "batch executes multiple commands"
(let [msg-chan (chan 10)]
(#'tui/execute-cmd! [:batch
@@ -171,7 +277,7 @@
(is (= #{:msg1 :msg2} (set results))))
(close! msg-chan))))
(deftest execute-nil-command-test
(deftest execute-nil-command-legacy-test
(testing "nil command does nothing"
(let [msg-chan (chan 1)]
(#'tui/execute-cmd! nil msg-chan)
@@ -184,12 +290,22 @@
;; === Defapp Macro Tests ===
(deftest defapp-macro-test
(testing "defapp creates app map"
(tui/defapp test-app
(testing "defapp creates app map (legacy)"
(tui/defapp test-app-legacy
:init {:count 0}
:update (fn [m msg] [m nil])
:view (fn [m] [:text "test"]))
(is (map? test-app))
(is (= {:count 0} (:init test-app)))
(is (fn? (:update test-app)))
(is (fn? (:view test-app)))))
(is (map? test-app-legacy))
(is (= {:count 0} (:init test-app-legacy)))
(is (fn? (:update test-app-legacy)))
(is (fn? (:view test-app-legacy))))
(testing "defapp creates app map (new)"
(tui/defapp test-app-new
:init {:count 0}
:update (fn [{:keys [model event]}] {:model model})
:view (fn [m size] [:text "test"]))
(is (map? test-app-new))
(is (= {:count 0} (:init test-app-new)))
(is (fn? (:update test-app-new)))
(is (fn? (:view test-app-new)))))
+13 -12
View File
@@ -152,26 +152,27 @@
;; The current implementation only looks at first char
(is (input/key-match? [:key {:char \q}] "quit")))
(testing "nil message returns nil"
(is (nil? (input/key-match? nil "q")))
(is (nil? (input/key-match? nil :enter))))
(testing "nil message returns false"
(is (not (input/key-match? nil "q")))
(is (not (input/key-match? nil :enter))))
(testing "non-key message returns nil"
(is (nil? (input/key-match? [:tick 123] "q")))
(is (nil? (input/key-match? [:http-success 200] :enter)))
(is (nil? (input/key-match? "not a vector" "q"))))
(testing "non-key message returns false"
(is (not (input/key-match? [:tick 123] "q")))
(is (not (input/key-match? [:http-success 200] :enter)))
(is (not (input/key-match? "not a vector" "q"))))
(testing "unknown key message structure"
(is (not (input/key-match? [:key {:unknown true}] "q")))
(is (not (input/key-match? [:key {}] "q")))))
(deftest key-str-edge-cases-test
(testing "nil message returns nil"
(is (nil? (input/key->str nil))))
(testing "nil message returns empty string"
(is (= "" (input/key->str nil))))
(testing "non-key message returns nil"
(is (nil? (input/key->str [:tick 123])))
(is (nil? (input/key->str [:custom :message]))))
(testing "non-key message returns string representation"
;; Legacy format returns the second element as string
(is (string? (input/key->str [:tick 123])))
(is (string? (input/key->str [:custom :message]))))
(testing "key message with empty map"
(is (= "" (input/key->str [:key {}]))))
+140
View File
@@ -0,0 +1,140 @@
(ns tui.events-test
"Unit tests for event constructors and key matching."
(:require [clojure.test :refer [deftest testing is]]
[tui.events :as ev]))
;; === Event Constructor Tests ===
(deftest quit-test
(testing "quit returns quit event"
(is (= {:type :quit} (ev/quit)))))
(deftest delay-test
(testing "delay creates delay event"
(is (= {:type :delay :ms 1000 :event {:type :tick}}
(ev/delay 1000 {:type :tick}))))
(testing "delay with different ms values"
(is (= 0 (:ms (ev/delay 0 {:type :x}))))
(is (= 5000 (:ms (ev/delay 5000 {:type :x}))))))
(deftest shell-test
(testing "shell creates shell event with vector cmd"
(is (= {:type :shell :cmd ["git" "status"] :event {:type :result}}
(ev/shell ["git" "status"] {:type :result}))))
(testing "shell preserves event data"
(let [event {:type :git-result :file "foo.txt"}]
(is (= event (:event (ev/shell ["git" "diff"] event)))))))
(deftest batch-test
(testing "batch creates batch event"
(let [e1 {:type :a}
e2 {:type :b}
result (ev/batch e1 e2)]
(is (= :batch (:type result)))
(is (= [e1 e2] (:events result)))))
(testing "batch filters nil events"
(let [result (ev/batch nil {:type :a} nil {:type :b} nil)]
(is (= [{:type :a} {:type :b}] (:events result)))))
(testing "batch returns nil for all-nil events"
(is (nil? (ev/batch nil nil nil))))
(testing "batch returns nil for no events"
(is (nil? (ev/batch)))))
(deftest sequential-test
(testing "sequential creates sequential event"
(let [e1 {:type :a}
e2 {:type :b}
result (ev/sequential e1 e2)]
(is (= :sequential (:type result)))
(is (= [e1 e2] (:events result)))))
(testing "sequential filters nil events"
(let [result (ev/sequential nil {:type :a} nil {:type :b} nil)]
(is (= [{:type :a} {:type :b}] (:events result)))))
(testing "sequential returns nil for all-nil events"
(is (nil? (ev/sequential nil nil nil))))
(testing "sequential returns nil for no events"
(is (nil? (ev/sequential)))))
(deftest debounce-test
(testing "debounce creates debounce event"
(is (= {:type :debounce :id :search :ms 300 :event {:type :search-query}}
(ev/debounce :search 300 {:type :search-query}))))
(testing "debounce with different ids"
(is (= :resize (:id (ev/debounce :resize 100 {:type :x}))))
(is (= :input (:id (ev/debounce :input 50 {:type :x}))))))
;; === Key Matching Tests ===
(deftest key=-basic-test
(testing "matches plain character"
(is (ev/key= {:type :key :key \q} \q))
(is (ev/key= {:type :key :key \a} \a))
(is (ev/key= {:type :key :key \1} \1)))
(testing "does not match different character"
(is (not (ev/key= {:type :key :key \q} \a)))
(is (not (ev/key= {:type :key :key \x} \y)))))
(deftest key=-special-keys-test
(testing "matches special keys"
(is (ev/key= {:type :key :key :enter} :enter))
(is (ev/key= {:type :key :key :escape} :escape))
(is (ev/key= {:type :key :key :up} :up))
(is (ev/key= {:type :key :key :f1} :f1)))
(testing "does not match wrong special keys"
(is (not (ev/key= {:type :key :key :up} :down)))
(is (not (ev/key= {:type :key :key :enter} :escape)))))
(deftest key=-with-modifiers-test
(testing "matches key with exact modifiers"
(is (ev/key= {:type :key :key \c :modifiers #{:ctrl}} \c #{:ctrl}))
(is (ev/key= {:type :key :key \z :modifiers #{:ctrl :shift}} \z #{:ctrl :shift}))
(is (ev/key= {:type :key :key \a :modifiers #{:shift}} \a #{:shift})))
(testing "does not match with wrong modifiers"
(is (not (ev/key= {:type :key :key \c :modifiers #{:ctrl}} \c #{:alt})))
(is (not (ev/key= {:type :key :key \c :modifiers #{:ctrl :shift}} \c #{:ctrl}))))
(testing "does not match when modifiers present but not specified"
(is (not (ev/key= {:type :key :key \c :modifiers #{:ctrl}} \c)))
(is (not (ev/key= {:type :key :key \a :modifiers #{:shift}} \a))))
(testing "does not match when modifiers specified but not present"
(is (not (ev/key= {:type :key :key \c} \c #{:ctrl})))))
(deftest key=-non-key-events-test
(testing "returns false for non-key events"
(is (not (ev/key= {:type :quit} \q)))
(is (not (ev/key= {:type :tick} :enter)))
(is (not (ev/key= nil \a)))))
;; === Composition Tests ===
(deftest composed-events-test
(testing "can compose multiple event constructors"
(let [result (ev/batch
(ev/shell ["git" "status"] {:type :status})
(ev/delay 1000 {:type :refresh}))]
(is (= :batch (:type result)))
(is (= 2 (count (:events result))))
(is (= :shell (:type (first (:events result)))))
(is (= :delay (:type (second (:events result)))))))
(testing "can nest batch in sequential"
(let [result (ev/sequential
{:type :start}
(ev/batch
(ev/shell ["git" "add" "."] {:type :added})
(ev/shell ["git" "status"] {:type :status})))]
(is (= :sequential (:type result)))
(is (= :batch (:type (second (:events result))))))))
+97 -25
View File
@@ -3,10 +3,68 @@
(:require [clojure.test :refer [deftest testing is]]
[tui.input :as input]))
;; === Key Matching Tests ===
;; === New Event Format Tests ===
(deftest key-match-character-test
(testing "matches single character keys"
(deftest key-match-new-format-character-test
(testing "matches single character keys (new format)"
(is (input/key-match? {:type :key :key \q} "q"))
(is (input/key-match? {:type :key :key \a} "a"))
(is (input/key-match? {:type :key :key \1} "1")))
(testing "does not match different characters"
(is (not (input/key-match? {:type :key :key \q} "a")))
(is (not (input/key-match? {:type :key :key \x} "y"))))
(testing "does not match ctrl+char as plain char"
(is (not (input/key-match? {:type :key :key \c :modifiers #{:ctrl}} "c"))))
(testing "does not match alt+char as plain char"
(is (not (input/key-match? {:type :key :key \x :modifiers #{:alt}} "x")))))
(deftest key-match-new-format-special-keys-test
(testing "matches special keys by keyword (new format)"
(is (input/key-match? {:type :key :key :enter} :enter))
(is (input/key-match? {:type :key :key :escape} :escape))
(is (input/key-match? {:type :key :key :backspace} :backspace))
(is (input/key-match? {:type :key :key :tab} :tab)))
(testing "matches arrow keys"
(is (input/key-match? {:type :key :key :up} :up))
(is (input/key-match? {:type :key :key :down} :down))
(is (input/key-match? {:type :key :key :left} :left))
(is (input/key-match? {:type :key :key :right} :right)))
(testing "matches function keys"
(is (input/key-match? {:type :key :key :f1} :f1))
(is (input/key-match? {:type :key :key :f12} :f12)))
(testing "does not match wrong special keys"
(is (not (input/key-match? {:type :key :key :up} :down)))
(is (not (input/key-match? {:type :key :key :enter} :escape)))))
(deftest key-match-new-format-ctrl-combo-test
(testing "matches ctrl+char combinations (new format)"
(is (input/key-match? {:type :key :key \c :modifiers #{:ctrl}} [:ctrl \c]))
(is (input/key-match? {:type :key :key \x :modifiers #{:ctrl}} [:ctrl \x]))
(is (input/key-match? {:type :key :key \z :modifiers #{:ctrl}} [:ctrl \z])))
(testing "does not match wrong ctrl combinations"
(is (not (input/key-match? {:type :key :key \c :modifiers #{:ctrl}} [:ctrl \x])))
(is (not (input/key-match? {:type :key :key \c} [:ctrl \c])))))
(deftest key-match-new-format-alt-combo-test
(testing "matches alt+char combinations (new format)"
(is (input/key-match? {:type :key :key \x :modifiers #{:alt}} [:alt \x]))
(is (input/key-match? {:type :key :key \a :modifiers #{:alt}} [:alt \a])))
(testing "does not match wrong alt combinations"
(is (not (input/key-match? {:type :key :key \x :modifiers #{:alt}} [:alt \y])))
(is (not (input/key-match? {:type :key :key \x} [:alt \x])))))
;; === Legacy Event Format Tests (Backward Compatibility) ===
(deftest key-match-legacy-character-test
(testing "matches single character keys (legacy format)"
(is (input/key-match? [:key {:char \q}] "q"))
(is (input/key-match? [:key {:char \a}] "a"))
(is (input/key-match? [:key {:char \1}] "1")))
@@ -21,8 +79,8 @@
(testing "does not match alt+char as plain char"
(is (not (input/key-match? [:key {:alt true :char \x}] "x")))))
(deftest key-match-special-keys-test
(testing "matches special keys by keyword"
(deftest key-match-legacy-special-keys-test
(testing "matches special keys by keyword (legacy format)"
(is (input/key-match? [:key :enter] :enter))
(is (input/key-match? [:key :escape] :escape))
(is (input/key-match? [:key :backspace] :backspace))
@@ -42,8 +100,8 @@
(is (not (input/key-match? [:key :up] :down)))
(is (not (input/key-match? [:key :enter] :escape)))))
(deftest key-match-ctrl-combo-test
(testing "matches ctrl+char combinations"
(deftest key-match-legacy-ctrl-combo-test
(testing "matches ctrl+char combinations (legacy format)"
(is (input/key-match? [:key {:ctrl true :char \c}] [:ctrl \c]))
(is (input/key-match? [:key {:ctrl true :char \x}] [:ctrl \x]))
(is (input/key-match? [:key {:ctrl true :char \z}] [:ctrl \z])))
@@ -52,8 +110,8 @@
(is (not (input/key-match? [:key {:ctrl true :char \c}] [:ctrl \x])))
(is (not (input/key-match? [:key {:char \c}] [:ctrl \c])))))
(deftest key-match-alt-combo-test
(testing "matches alt+char combinations"
(deftest key-match-legacy-alt-combo-test
(testing "matches alt+char combinations (legacy format)"
(is (input/key-match? [:key {:alt true :char \x}] [:alt \x]))
(is (input/key-match? [:key {:alt true :char \a}] [:alt \a])))
@@ -62,33 +120,47 @@
(is (not (input/key-match? [:key {:char \x}] [:alt \x])))))
(deftest key-match-non-key-messages-test
(testing "returns nil for non-key messages"
(is (nil? (input/key-match? [:tick 123] "q")))
(is (nil? (input/key-match? [:quit] :enter)))
(is (nil? (input/key-match? nil "a")))))
(testing "returns false for non-key messages"
(is (not (input/key-match? {:type :tick :value 123} "q")))
(is (not (input/key-match? {:type :quit} :enter)))
(is (not (input/key-match? nil "a")))))
;; === Key to String Tests ===
(deftest key->str-special-keys-test
(testing "converts special keys to strings"
(deftest key->str-new-format-test
(testing "converts special keys to strings (new format)"
(is (= "enter" (input/key->str {:type :key :key :enter})))
(is (= "escape" (input/key->str {:type :key :key :escape})))
(is (= "up" (input/key->str {:type :key :key :up})))
(is (= "f1" (input/key->str {:type :key :key :f1}))))
(testing "converts character keys to strings (new format)"
(is (= "q" (input/key->str {:type :key :key \q})))
(is (= "a" (input/key->str {:type :key :key \a}))))
(testing "converts modifier combinations to strings (new format)"
(is (= "ctrl+c" (input/key->str {:type :key :key \c :modifiers #{:ctrl}})))
(is (= "alt+x" (input/key->str {:type :key :key \x :modifiers #{:alt}})))
(is (= "shift+a" (input/key->str {:type :key :key \a :modifiers #{:shift}})))))
(deftest key->str-legacy-format-test
(testing "converts special keys to strings (legacy format)"
(is (= "enter" (input/key->str [:key :enter])))
(is (= "escape" (input/key->str [:key :escape])))
(is (= "up" (input/key->str [:key :up])))
(is (= "f1" (input/key->str [:key :f1])))))
(is (= "f1" (input/key->str [:key :f1]))))
(deftest key->str-character-keys-test
(testing "converts character keys to strings"
(testing "converts character keys to strings (legacy format)"
(is (= "q" (input/key->str [:key {:char \q}])))
(is (= "a" (input/key->str [:key {:char \a}])))))
(is (= "a" (input/key->str [:key {:char \a}]))))
(deftest key->str-modifier-keys-test
(testing "converts ctrl combinations to strings"
(testing "converts ctrl combinations to strings (legacy format)"
(is (= "ctrl+c" (input/key->str [:key {:ctrl true :char \c}]))))
(testing "converts alt combinations to strings"
(testing "converts alt combinations to strings (legacy format)"
(is (= "alt+x" (input/key->str [:key {:alt true :char \x}])))))
(deftest key->str-non-key-messages-test
(testing "returns nil for non-key messages"
(is (nil? (input/key->str [:tick 123])))
(is (nil? (input/key->str nil)))))
(testing "returns string for non-key messages"
(is (string? (input/key->str [:tick 123])))
(is (= "" (input/key->str nil)))))
+187 -1
View File
@@ -80,7 +80,10 @@
[:row "c" " " "d"]]))))
(testing "renders col inside row"
(is (= "a\nb c\nd" (render/render [:row
;; Row places children side-by-side, aligning lines
;; col1 = "a\nb", col2 = " ", col3 = "c\nd"
;; Result: line1 = "a c", line2 = "b d" (space between a/c and b/d is from the " " child)
(is (= "a c\nb d" (render/render [:row
[:col "a" "b"]
" "
[:col "c" "d"]])))))
@@ -138,6 +141,189 @@
;; === Convenience Function Tests ===
;; === Grid Tests ===
(deftest parse-template-test
(testing "parses simple template"
(let [result (#'render/parse-template ["a a" "b c"])]
(is (= {:row 0 :col 0 :row-span 1 :col-span 2} (get result "a")))
(is (= {:row 1 :col 0 :row-span 1 :col-span 1} (get result "b")))
(is (= {:row 1 :col 1 :row-span 1 :col-span 1} (get result "c")))))
(testing "parses template with row spans"
(let [result (#'render/parse-template ["a b" "a c"])]
(is (= {:row 0 :col 0 :row-span 2 :col-span 1} (get result "a")))))
(testing "ignores . for empty cells"
(let [result (#'render/parse-template [". a" "b a"])]
(is (nil? (get result ".")))
(is (= {:row 0 :col 1 :row-span 2 :col-span 1} (get result "a"))))))
(deftest render-grid-test
(testing "renders simple 2x2 grid with explicit positioning"
(let [result (render/render [:grid {:rows [1 1] :cols [3 3]}
[:area {:row 0 :col 0} "A"]
[:area {:row 0 :col 1} "B"]
[:area {:row 1 :col 0} "C"]
[:area {:row 1 :col 1} "D"]]
{:available-width 6 :available-height 2})]
(is (str/includes? result "A"))
(is (str/includes? result "B"))
(is (str/includes? result "C"))
(is (str/includes? result "D"))))
(testing "renders grid with named template"
(let [result (render/render [:grid {:template ["header header"
"nav main"]
:rows [1 1]
:cols [3 3]}
[:area {:name "header"} "H"]
[:area {:name "nav"} "N"]
[:area {:name "main"} "M"]]
{:available-width 6 :available-height 2})]
(is (str/includes? result "H"))
(is (str/includes? result "N"))
(is (str/includes? result "M"))))
(testing "grid convenience functions create proper elements"
(is (= [:grid {} "a" "b"] (render/grid "a" "b")))
(is (= [:grid {:rows [1 1]} "a"] (render/grid {:rows [1 1]} "a")))
(is (= [:area {} "content"] (render/area "content")))
(is (= [:area {:row 0 :col 1} "x"] (render/area {:row 0 :col 1} "x")))))
;; === Scroll Tests ===
(deftest visible-window-calc-test
(testing "all items fit when total <= max-visible"
(let [result (#'render/visible-window-calc 3 0 5)]
(is (= 0 (:start result)))
(is (= 3 (:end result)))
(is (false? (:has-above result)))
(is (false? (:has-below result)))))
(testing "cursor at start shows beginning of list"
(let [result (#'render/visible-window-calc 10 0 3)]
(is (= 0 (:start result)))
(is (= 3 (:end result)))
(is (false? (:has-above result)))
(is (true? (:has-below result)))))
(testing "cursor at end shows end of list"
(let [result (#'render/visible-window-calc 10 9 3)]
(is (= 7 (:start result)))
(is (= 10 (:end result)))
(is (true? (:has-above result)))
(is (false? (:has-below result)))))
(testing "cursor in middle centers window"
(let [result (#'render/visible-window-calc 10 5 3)]
(is (>= (:start result) 3))
(is (<= (:end result) 7))
(is (true? (:has-above result)))
(is (true? (:has-below result))))))
(deftest render-scroll-test
(testing "renders all items when they fit"
(let [result (render/render [:scroll {:cursor 0 :indicators false}
"item1" "item2" "item3"]
{:available-height 10})]
(is (str/includes? result "item1"))
(is (str/includes? result "item2"))
(is (str/includes? result "item3"))))
(testing "renders only visible items when content exceeds height"
(let [result (render/render [:scroll {:cursor 0 :indicators false}
"item1" "item2" "item3" "item4" "item5"]
{:available-height 2})]
(is (str/includes? result "item1"))
(is (str/includes? result "item2"))
(is (not (str/includes? result "item5")))))
(testing "shows down indicator when more content below"
(let [result (render/render [:scroll {:cursor 0}
"item1" "item2" "item3" "item4" "item5"]
{:available-height 4})]
(is (str/includes? result "↓"))))
(testing "shows up indicator when more content above"
(let [result (render/render [:scroll {:cursor 4}
"item1" "item2" "item3" "item4" "item5"]
{:available-height 4})]
(is (str/includes? result "↑"))))
(testing "scroll convenience function creates scroll element"
(is (= [:scroll {} "a" "b"] (render/scroll "a" "b")))
(is (= [:scroll {:cursor 2} "a" "b" "c"] (render/scroll {:cursor 2} "a" "b" "c")))))
;; === Enhanced Sizing Tests ===
(deftest parse-size-spec-test
(testing "parses fixed numbers"
(is (= {:type :fixed :value 30} (#'render/parse-size-spec 30)))
(is (= {:type :fixed :value 0} (#'render/parse-size-spec 0))))
(testing "parses :flex shorthand"
(is (= {:type :flex :value 1} (#'render/parse-size-spec :flex))))
(testing "parses {:flex n} weighted flex"
(is (= {:type :flex :value 2 :min nil :max nil}
(#'render/parse-size-spec {:flex 2})))
(is (= {:type :flex :value 3 :min 10 :max 50}
(#'render/parse-size-spec {:flex 3 :min 10 :max 50}))))
(testing "parses percentage strings"
(is (= {:type :percent :value 50} (#'render/parse-size-spec "50%")))
(is (= {:type :percent :value 100} (#'render/parse-size-spec "100%"))))
(testing "parses fractional unit strings"
(is (= {:type :fr :value 1} (#'render/parse-size-spec "1fr")))
(is (= {:type :fr :value 2} (#'render/parse-size-spec "2fr"))))
(testing "parses {:percent n} with constraints"
(is (= {:type :percent :value 30 :min 10 :max 100}
(#'render/parse-size-spec {:percent 30 :min 10 :max 100}))))
(testing "parses nil as auto"
(is (= {:type :auto :value nil} (#'render/parse-size-spec nil)))))
(deftest calculate-sizes-test
(testing "calculates fixed sizes"
(is (= [30 40] (#'render/calculate-sizes [30 40] [:a :b] 100 0))))
(testing "calculates flex sizes evenly"
(is (= [50 50] (#'render/calculate-sizes [:flex :flex] [:a :b] 100 0))))
(testing "calculates weighted flex sizes"
(let [result (#'render/calculate-sizes [{:flex 1} {:flex 2}] [:a :b] 90 0)]
(is (= 30 (first result)))
(is (= 60 (second result)))))
(testing "calculates mixed fixed and flex"
(is (= [20 40 40] (#'render/calculate-sizes [20 :flex :flex] [:a :b :c] 100 0))))
(testing "accounts for gap in calculations"
;; 100 - 10 gap = 90 usable, split evenly
(is (= [45 45] (#'render/calculate-sizes [:flex :flex] [:a :b] 100 10))))
(testing "calculates percentage sizes"
(let [result (#'render/calculate-sizes ["50%" "50%"] [:a :b] 100 0)]
(is (= 50 (first result)))
(is (= 50 (second result)))))
(testing "calculates fractional unit sizes"
(let [result (#'render/calculate-sizes ["1fr" "2fr"] [:a :b] 90 0)]
(is (= 30 (first result)))
(is (= 60 (second result)))))
(testing "handles mixed percentage, fixed, and flex"
(let [result (#'render/calculate-sizes [20 "50%" :flex] [:a :b :c] 100 0)]
;; Fixed: 20, remaining: 80
;; Percentage: 50% of 80 = 40
;; Flex gets remaining: 80 - 40 = 40
(is (= 20 (first result)))
(is (= 40 (second result)))
(is (= 40 (nth result 2))))))
(deftest convenience-functions-test
(testing "text function creates text element"
(is (= [:text {} "hello"] (render/text "hello")))