From fb860e5330832a46382c7990f9786f78aea2b478 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Thu, 24 Sep 2026 18:10:05 -0400 Subject: [PATCH] Refuse runs on an unreachable endpoint, TUI input history, selection and notifications A run started with the local model server down spent six turns of retries on every branch before the provider-error limit stopped it. Starting or resuming a run now asks the endpoint first and answers 503 naming it when nothing answers (gates.edn :endpoint-preflight). The llama.cpp probe no longer reads "connection refused" as "not llama.cpp": what an endpoint says is remembered per endpoint only once it answers, so a server started after the harness still gets prefix caching and the right fold role. A project whose gates.edn predates the key starts runs as before instead of a 500. The client retries only IOExceptions; an error raised by harness code inside a call is fatal and no longer counted as provider trouble. The supervisor's notice prints its measurements as words, the warm-up warning no longer talks about https, and the front ends wait longer for a run start than the server does. TUI: Up/Down at the compose box's edges walk the sent history and keep the line being typed; text can be drag-selected (the box included) and is copied to the clipboard on release; notifications are raised by the terminal itself, so clicking one goes to the tab instead of Script Editor. --- resources/gates.edn | 11 +++ resources/prompts/endpoint-unreachable.md | 1 + resources/userspace.edn | 1 + src/samizdat/agent/oversight.clj | 13 ++- src/samizdat/api/client.clj | 26 +++--- src/samizdat/api/control.clj | 49 ++++++++++-- src/samizdat/api/openai.clj | 5 +- src/samizdat/core.clj | 10 ++- src/samizdat/llm/client.clj | 84 +++++++++++++++++--- src/samizdat/system.clj | 55 ++++++------- test-tui/samizdat/tui/input_test.clj | 64 +++++++++++++++ test-tui/samizdat/tui/test_runner.clj | 3 +- test/samizdat/base_test.clj | 13 +-- test/samizdat/control_test.clj | 97 +++++++++++++++++++++++ test/samizdat/llm_test.clj | 87 ++++++++++++++++++++ test/samizdat/oversight_test.clj | 8 ++ test/samizdat/tui_commands_test.clj | 12 +++ test/samizdat/tui_notify_test.clj | 35 ++++++++ test/samizdat/tui_widgets_test.clj | 12 +++ tui/samizdat/tui/core.clj | 21 ++++- tui/samizdat/tui/notify.clj | 67 +++++++++++++--- tui/samizdat/tui/state.clj | 24 +++--- tui/samizdat/tui/widgets.clj | 7 +- 23 files changed, 610 insertions(+), 95 deletions(-) create mode 100644 resources/prompts/endpoint-unreachable.md create mode 100644 test-tui/samizdat/tui/input_test.clj diff --git a/resources/gates.edn b/resources/gates.edn index d0cd95af..88b345b5 100644 --- a/resources/gates.edn +++ b/resources/gates.edn @@ -286,6 +286,17 @@ images alive through a slow foreign call, at the cost of a branch waiting that much longer for a REPL that may never answer."} + :endpoint-preflight + {:value true :kind :threshold :capability-tunable? false + :provenance ["karamazov-rhrf"] + :doc "Whether starting or resuming a run is refused, with a 503 naming the + endpoint, when the run's model endpoint does not answer at all + (refused, unresolvable, timed out) — the same probe that learns what + the endpoint is. Run 0f4b9b55 started with the local model server + down and spent six turns of three attempts on every branch and the + supervisor before :provider-error-limit abandoned them. False starts + the run anyway and leaves the outage to that limit."} + :run-start-deadline-ms {:value 120000 :kind :threshold :capability-tunable? true :provenance ["karamazov-iev2" "karamazov-5fyo"] diff --git a/resources/prompts/endpoint-unreachable.md b/resources/prompts/endpoint-unreachable.md new file mode 100644 index 00000000..e8fc3973 --- /dev/null +++ b/resources/prompts/endpoint-unreachable.md @@ -0,0 +1 @@ +the model endpoint {{url}} is not answering ({{reason}}) — start it, then start the run again diff --git a/resources/userspace.edn b/resources/userspace.edn index cec374e4..0c844260 100644 --- a/resources/userspace.edn +++ b/resources/userspace.edn @@ -88,6 +88,7 @@ :dispatch-refused "prompts/dispatch-refused.md" :drift "prompts/drift.md" :emergency-review "prompts/emergency-review.md" + :endpoint-unreachable "prompts/endpoint-unreachable.md" :eval-calls-main "prompts/eval-calls-main.md" :eval-error "prompts/eval-error.md" :eval-image "prompts/eval-image.md" diff --git a/src/samizdat/agent/oversight.clj b/src/samizdat/agent/oversight.clj index dfe5bd47..266d842b 100644 --- a/src/samizdat/agent/oversight.clj +++ b/src/samizdat/agent/oversight.clj @@ -39,7 +39,8 @@ trigger: it used to fire the pass every two minutes whether or not the implementer had done anything, which evaluated no turn in particular and spent looks on a run that was idle." - (:require [clojure.tools.logging :as log] + (:require [clojure.string :as str] + [clojure.tools.logging :as log] [ebb.core :as ebb] [samizdat.cancel :as cancel] [samizdat.events :as events] @@ -142,6 +143,14 @@ (not (contains? wanted (keyword (name (:severity %)))))) findings))) +(defn evidence-text + "A finding's measurements as words — `turns 1, retried 10` — for a notice + a person reads in the agent log as well as the branch. Printing the map + put `{:turns 1, :retried 10}` in front of both (karamazov-8cih)." + [evidence] + (str/join ", " (for [[k v] evidence] + (str (str/replace (name k) "-" " ") " " v)))) + (defn- react! "Say something about one finding, through the one write path. @@ -159,7 +168,7 @@ :payload {:text (prompt/render "watch-intervention" {:kind (name kind) :detail detail - :evidence (pr-str evidence)})}}) + :evidence (evidence-text evidence)})}}) (journal/note! conn run-id :watch-intervention {:data {:finding kind :evidence evidence}}) (log/info "watch: raised" kind "-" detail)) diff --git a/src/samizdat/api/client.clj b/src/samizdat/api/client.clj index ffcba504..fe6d88e3 100644 --- a/src/samizdat/api/client.clj +++ b/src/samizdat/api/client.clj @@ -165,24 +165,22 @@ (def start-timeout-ms "How long to wait for POST /v1/runs. - Deliberately longer than the 30s api.control/start-run! itself waits on - (deref promised 30000). That endpoint does not answer when the run row is - written — beam/run! opens every branch in the beam first and only then - calls on-start — so a start can legitimately take tens of seconds, and how - long depends on the beam width and on what else the machine is doing. - - Under the shared 10s default this reported a failure for a run that was - starting normally: the row was already committed, so the user was told the - run had failed AND left with a live run consuming provider spend, with the - same request succeeding under curl. Any client bound tighter than the - server's own budget has that bug; this one has to outlast it." - 40000) + Longer than the server's own wait, gates.edn :run-start-deadline-ms (120 s + shipped), because a start can legitimately take that long and the server + answers when the run row exists, not before. A client bound tighter than + the server reports a failure for a run that started normally — the row + already committed, the run already spending — and a re-post starts a + second one (karamazov-5fyo). This stayed at 40 s after the server's wait + went to 120 s; control-test pins the ordering against the shipped policy. + A project that raises its deadline past this has to raise it here too." + 150000) (defn start-run! "Start a fresh run and return its id in the body. - The server answers 503 when the beam does not come up inside its 30s window, - which `result` already turns into {:ok false}. It used to answer 200 with an + The server answers 503 when the run row does not exist inside its deadline + or the model endpoint does not answer, which `result` already turns into + {:ok false}. It used to answer 200 with an `{:error ...}` body instead, so a plain 2xx was not proof a run existed; the unwrap below is kept as a belt-and-braces check on that older shape, since a caller that mistakes a refusal for a started run goes on to poll a run id diff --git a/src/samizdat/api/control.clj b/src/samizdat/api/control.clj index dcb2b341..a21d6998 100644 --- a/src/samizdat/api/control.clj +++ b/src/samizdat/api/control.clj @@ -29,11 +29,13 @@ [clojure.string :as str] [clojure.tools.logging :as log] [samizdat.agent.beam :as beam] + [samizdat.agent.gates :as gates] [samizdat.agent.live :as live] [samizdat.agent.resume :as resume] [samizdat.approval :as approval] [samizdat.cancel :as cancel] [samizdat.config :as config] + [samizdat.llm.client :as llm] [samizdat.llm.registry :as registry] [samizdat.prompt :as prompt] [samizdat.store.grants :as grants] @@ -95,6 +97,38 @@ model (assoc :model model) effort (assoc :reasoning-effort effort))))) +;; A run's endpoint is asked what it is before the run starts (llm/with- +;; discovery — remembered per endpoint once it answers), and one that does not +;; answer at all refuses the run here rather than letting every branch retry +;; into :provider-error-limit (karamazov-rhrf). Whether to refuse is policy. +;; +;; A project's gates.edn and role map are its OWN copies, and what a later +;; release adds reaches one only when it adopts the new file — endless-flight +;; had neither the key nor the prompt, and a throwing read made every run +;; start a 500. So an absent key is gates/threshold's nil, the behaviour from +;; before the key existed, and absent prose falls back to what the endpoint +;; itself said. +(defn- unreachable-message [url why] + (try (str/trim (prompt/render "endpoint-unreachable" {:url url :reason why})) + (catch Throwable e + (log/warn "endpoint-unreachable prompt:" (ex-message e)) + (str url " - " why)))) + +(defn discovered + "`llm-config` with what its endpoint said about itself, and the refusal to + answer with when it said nothing and gates.edn :endpoint-preflight is on: + `[llm-config refusal-or-nil]`. The llm config never carries :unreachable + onward — that is this check's, not the run's." + [llm-config] + (let [probed (llm/with-discovery llm-config) + why (:unreachable probed)] + [(dissoc probed :unreachable) + (when (and why (gates/threshold :endpoint-preflight)) + (log/warn "refusing a run: model endpoint" (:base-url probed) "-" why) + {:status 503 + :body {:error {:message (unreachable-message (:base-url probed) why) + :type "endpoint_unreachable"}}})])) + (defn start-run! "Kick off a run in the background and return its id immediately. @@ -117,8 +151,9 @@ {:status 400 :body {:error {:message "a run needs a non-blank `problem`" :type "invalid_request_error"}}} - (let [llm-config (run-llm-config config (:llm config) body) - adapter (registry/adapter-for (:provider llm-config)) + (let [[llm-config refusal] (discovered (run-llm-config config (:llm config) body))] + (or refusal + (let [adapter (registry/adapter-for (:provider llm-config)) abort (atom false) promised (promise) cancel* (atom nil) @@ -182,7 +217,7 @@ {:status 503 :body {:error {:message (str/trim (prompt/render "run-start-timeout" - {:seconds (quot start-deadline 1000)}))}}}))))) + {:seconds (quot start-deadline 1000)}))}}}))))))) (defn abort! "Stop a run without asking it to cooperate. Cancels the run task, which is @@ -241,8 +276,10 @@ :else ;; A resume may name an arm too — a run that crashed on one model can be ;; picked up on another, and saying nothing keeps the original. - (let [llm-config (run-llm-config config (or recorded (:llm config)) body) - adapter (registry/adapter-for (:provider llm-config)) + (let [[llm-config refusal] (discovered (run-llm-config config (or recorded (:llm config)) body))] + (if refusal + (assoc-in refusal [:body :run_id] run-id) + (let [adapter (registry/adapter-for (:provider llm-config)) abort (atom false) max-turns (or (:max_turns body) (:max-turns body)) ;; A run already driven by this process is not resumed: a second @@ -283,7 +320,7 @@ ;; max_turns extension was reported as the old budget more often than ;; not. {:body {:run_id run-id :status "resuming" - :max_turns (or max-turns (:max_turns (runs/get-run conn run-id)))}})))))) + :max_turns (or max-turns (:max_turns (runs/get-run conn run-id)))}})))))))) (defn- grant-pattern "The pattern from a grant payload. Accepts a map (what body-json yields), a bare string, or nil. Blank is not a pattern — an unset form posts empty diff --git a/src/samizdat/api/openai.clj b/src/samizdat/api/openai.clj index 689051c9..3083e3bd 100644 --- a/src/samizdat/api/openai.clj +++ b/src/samizdat/api/openai.clj @@ -74,7 +74,7 @@ (defn chat-completion "Run the harness on the last user message and answer in OpenAI's shape." [{:keys [conn config]} body] - (let [llm-config (:llm config) + (let [[llm-config refusal] (api-control/discovered (:llm config)) adapter (registry/adapter-for (:provider llm-config)) model (:model llm-config) messages (or (:messages body) (get body "messages")) @@ -84,6 +84,9 @@ {:status 400 :body {:error {:message "no user message in `messages`" :type "invalid_request_error"}}} + ;; The endpoint did not answer at all (gates.edn :endpoint-preflight). + refusal refusal + ;; The bypass. Same model, same question, no verification. (or (:raw body) (get body "raw")) (let [r (llm/chat adapter llm-config messages)] diff --git a/src/samizdat/core.clj b/src/samizdat/core.clj index 60eba900..71961c75 100644 --- a/src/samizdat/core.clj +++ b/src/samizdat/core.clj @@ -97,9 +97,13 @@ "— available:" (pr-str (take 10 models))) :model-missing))) (catch Throwable e - (log/warn "provider warm-up failed:" (ex-message e) - "— the harness will start, but https is expected to stay broken" - "in this process once nREPL loads") + ;; This used to say https would stay broken once nREPL loaded — true + ;; of an ordering bug fixed upstream long ago (see the ns docstring), + ;; and wrong about the usual cause, a model server not started yet + ;; (karamazov-mxf9). + (log/warn "provider" provider "is not reachable:" (ex-message e) + "— the harness will start; with gates.edn :endpoint-preflight on," + "a run is refused until the endpoint answers") :failed)))) (defn start-nrepl! diff --git a/src/samizdat/llm/client.clj b/src/samizdat/llm/client.clj index 7f39439c..c4eecda2 100644 --- a/src/samizdat/llm/client.clj +++ b/src/samizdat/llm/client.clj @@ -45,6 +45,7 @@ [ebb.core :as ebb] [jolt.http-client :as http] [samizdat.cancel :as cancel] + [samizdat.config :as config] [samizdat.lexicon :as lexicon] [samizdat.llm.adapter :as adapter] [samizdat.llm.message :as message] @@ -441,10 +442,23 @@ ;; transient blip. {:outcome :fatal :reason :timeout :error (str "read timeout: " m)} - ;; A real transport failure — connection reset, TLS - ;; error, connect timeout — is what retrying exists - ;; for. - {:outcome :retry :error (str "transport: " m)})))) + (cond + ;; A cancel is the run being told to stop, and + ;; the ladder is not the place to answer it. + (cancel/control-signal? e) (throw e) + ;; A real transport failure — connection reset, + ;; refused, TLS error, connect timeout — is an + ;; IOException, and is what retrying exists for. + (instance? java.io.IOException e) + {:outcome :retry :error (str "transport: " m)} + ;; Anything else was raised by the harness's own + ;; code inside the call. Run 74ddebb8 retried an + ;; ebb fork-in-finally error as `transport:` 2004 + ;; times and read it as an unreliable provider + ;; (karamazov-q8dy); a retry only reproduces a bug. + :else + {:outcome :fatal :reason :harness-error + :error (str "harness: " m)}))))) errors (conj errors (:error result))] (cond (= :ok (:outcome result)) @@ -538,9 +552,12 @@ cannot make a single request. A probe asks; it does not hope. `/props` is llama.cpp's own endpoint and `total_slots` is the field only it - serves. Anything else — a 404, a hosted provider's error page, a connection - refused — is `nil`, meaning `not llama.cpp`, which is the safe answer in - every direction. + serves. Any other ANSWER — a 404, a hosted provider's error page — is + `nil`, meaning `not llama.cpp`. No answer at all (refused, unresolvable, + timed out) is `{:unreachable message}`: it says nothing about what the + endpoint is, and reading it as `not llama.cpp` cost a harness started + before its model server its prefix caching and fold role for the life of + the process (karamazov-k9q3). `total_slots` is worth having on its own: RFC-005 said an explicit `:slots` table was the only option because `a slot count is a property of how the @@ -556,10 +573,12 @@ :throw-exceptions false})] (when (<= 200 (:status resp) 299) (llama-props->probe (decode (:body resp))))) + (catch java.io.IOException e + {:unreachable (str (ex-message e))}) (catch Throwable _ - ;; Unreachable, not-llama.cpp and malformed are the same answer here, and - ;; none of them is a reason not to start: the harness must come up - ;; against an endpoint that is merely slow to boot. + ;; A malformed answer is still an answer, and not llama.cpp's. None of + ;; these is a reason not to start: the harness must come up against an + ;; endpoint that is merely slow to boot. nil))) (def ^:private fold-role-refusal-re @@ -615,6 +634,51 @@ (fold-role-from-status (:status resp) (:body resp))) (catch Throwable _ nil))) +;; What each endpoint said about itself, by base URL: the probe's facts plus +;; the fold role, or {} for an endpoint that answered and is not llama.cpp. +;; Only ANSWERS are kept. An endpoint that was down when asked is asked again +;; the next time, so a model server started after the harness is found by the +;; next run rather than never (karamazov-k9q3). +(defonce ^:private discoveries (atom {})) + +(defn forget-discoveries! + "Drop every remembered endpoint answer — a test's reset, or a REPL's after + swapping the model behind a server." + [] + (reset! discoveries {})) + +(defn- discover + "Ask the endpoint what it is. `{:unreachable message}` when nothing answered, + else the facts to merge into its llm config." + [llm] + (let [probed (probe-llama-cpp llm)] + (if (:unreachable probed) + probed + (let [fold-role (when (:llama-cpp? probed) + (probe-fold-role (config/apply-discovery llm probed)))] + (cond-> (or probed {}) + fold-role (assoc :fold-role fold-role)))))) + +(defn with-discovery + "`llm` with what its endpoint said about itself merged in (see + `config/apply-discovery`), asking it once per endpoint per process. When it + did not answer, `llm` comes back carrying `:unreachable` — the reason — and + nothing is remembered. An llm with no :base-url is not asked." + [llm] + (let [url (:base-url llm)] + (if (str/blank? (str url)) + llm + (let [facts (or (get @discoveries url) + (let [found (discover llm)] + (when-not (:unreachable found) + (swap! discoveries assoc url found)) + found))] + (if (:unreachable facts) + (assoc llm :unreachable (:unreachable facts)) + (let [fold-role (:fold-role facts)] + (cond-> (config/apply-discovery llm (not-empty (dissoc facts :fold-role))) + fold-role (assoc :fold-role fold-role)))))))) + (defn list-models "Model ids the endpoint advertises, or [] when it has no such endpoint." [adapter config] diff --git a/src/samizdat/system.clj b/src/samizdat/system.clj index 337a019b..4b8352ce 100644 --- a/src/samizdat/system.clj +++ b/src/samizdat/system.clj @@ -141,38 +141,35 @@ ;; point gets it: the tests, the benchmark runner and a REPL session ;; all bring the system up through start! without going through -main. _ (platform/set-max-response-ms! (get-in cfg [:llm :max-response-ms])) - ;; Ask the endpoint what it is, once, at startup. A llama.cpp server - ;; answers /props with a total_slots; anything else answers something - ;; else, and the probe returns nil. RFC-005 recorded that :local was - ;; decided by which config key an endpoint sat under, so a - ;; llama-server configured as :openai silently lost prefix pinning — - ;; asking is what fixes that, and asking is specifically NOT the same - ;; as sending the knob hopefully, which a strict OpenAI-compatible - ;; server answers with a 422 on the whole request. + ;; Ask the endpoint what it is. A llama.cpp server answers /props + ;; with a total_slots; anything else answers something else. RFC-005 + ;; recorded that :local was decided by which config key an endpoint + ;; sat under, so a llama-server configured as :openai silently lost + ;; prefix pinning — asking is what fixes that, and asking is + ;; specifically NOT the same as sending the knob hopefully, which a + ;; strict OpenAI-compatible server answers with a 422 on the whole + ;; request. A llama.cpp server is also asked whether its chat + ;; template takes a system message after a user turn — the shape of + ;; every compaction fold; Qwen3.5's 500s on it (karamazov-fp21.2). ;; - ;; Merged into the LLM config so it reaches chat-body the way every - ;; other endpoint fact does, and so a test can set it directly. - probed (llm-client/probe-llama-cpp (:llm cfg)) - ;; What the endpoint can do: the preset's declared set plus what - ;; the probe found (config/apply-discovery). Everything downstream - ;; reads :llm :features rather than guessing from a URL or an id. - cfg (update cfg :llm config/apply-discovery probed) - _ (when probed - (log/info "endpoint identified as llama.cpp:" - (:total-slots probed) "KV slots — prefix caching on" - (when-let [m (:model-id probed)] (str "— serving " m)))) + ;; llm-client/with-discovery remembers the answer per endpoint, and + ;; only an answer: a server that is down now is asked again when a + ;; run starts, rather than being taken for `not llama.cpp` for the + ;; life of the process (karamazov-k9q3). Merged into the LLM config + ;; so it reaches chat-body the way every other endpoint fact does. + discovered (llm-client/with-discovery (:llm cfg)) + cfg (assoc cfg :llm (dissoc discovered :unreachable)) + _ (if-let [why (:unreachable discovered)] + (log/warn "model endpoint" (:base-url discovered) "is not answering:" why + "— it will be asked again when a run starts") + (when (:llama-cpp? discovered) + (log/info "endpoint identified as llama.cpp:" + (:total-slots discovered) "KV slots — prefix caching on" + (when-let [m (:model-id discovered)] (str "— serving " m))) + (log/info "compaction fold marker role:" + (or (:fold-role discovered) "system (probe inconclusive)")))) _ (log/info "provider" (get-in cfg [:llm :provider]) "features:" (str/join " " (map name (sort (get-in cfg [:llm :features]))))) - ;; And whether its chat template takes a system message after a user - ;; turn — the shape of every compaction fold. Qwen3.5's template 500s - ;; on it (karamazov-fp21.2); asked once here so the fold cell knows - ;; which role to carry before the first fold, not after the first - ;; fatal call. gates.edn :fold-role decides what to do with the answer. - fold-role (when probed (llm-client/probe-fold-role (:llm cfg))) - cfg (cond-> cfg fold-role (assoc-in [:llm :fold-role] fold-role)) - _ (when probed - (log/info "compaction fold marker role:" - (or fold-role "system (probe inconclusive)"))) ;; Which config files were read, so a surprising value is traceable ;; to its layer rather than to a guess about which file won. _ (doseq [{:keys [layer path present? error]} (config/config-sources diff --git a/test-tui/samizdat/tui/input_test.clj b/test-tui/samizdat/tui/input_test.clj new file mode 100644 index 00000000..b768d038 --- /dev/null +++ b/test-tui/samizdat/tui/input_test.clj @@ -0,0 +1,64 @@ +;; samizdat - a self-hosting agentic harness +;; Copyright (C) 2026 Dmitri Sotnikov +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; +;; SPDX-License-Identifier: GPL-3.0-or-later + +(ns samizdat.tui.input-test + "The compose box through real FTXUI: that Up on its top row reaches the + history and a drag over it selects what was typed. The data tests show the + widget names :on-up-edge; only the toolkit can say a key press gets there." + (:require [clojure.string :as str] + [clojure.test :refer [deftest testing is]] + [ftxui.core :as ui] + [samizdat.tui.state :as st] + [samizdat.tui.widgets :as w])) + +(defn- box [state] + (fn [] + (w/input (assoc @state :on {:input #(swap! state st/set-input %) + :history-back #(swap! state st/history-back) + :history-forward #(swap! state st/history-forward)}) + {}))) + +(deftest up-and-down-walk-what-was-sent-and-come-back-to-the-draft + (let [state (atom (-> (st/initial "b") + (st/remember-input "first thing") + (st/remember-input "second thing")))] + (ui/with-screen [s (box state)] + (ui/render-text s 80 3) + (ui/send-char! s "draft") + (ui/send-key! s :arrow-up) + (is (= "second thing" (:input @state))) + (ui/send-key! s :arrow-up) + (is (= "first thing" (:input @state))) + (ui/send-key! s :arrow-down) + (ui/send-key! s :arrow-down) + (is (= "draft" (:input @state)) "past the newest, the line being typed") + (testing "a recalled line is edited from its end" + (ui/send-key! s :arrow-up) + (ui/send-char! s "!") + (is (= "second thing!" (:input @state))))))) + +(deftest what-was-typed-can-be-selected + (let [state (atom (st/set-input (st/initial "b") "select me please"))] + (ui/with-screen [s (box state)] + (let [frame (ui/render-text s 80 3) + y (first (keep-indexed (fn [i l] (when (str/includes? l "select me") i)) + (str/split-lines frame))) + x (str/index-of (nth (str/split-lines frame) y) "select")] + (is (false? (ui/send-mouse! s {:x (+ x 2) :y y})) + "a press in the box is left for the selection to start from") + (is (= "select me" (ui/selection-text s 80 3 [x y (+ x 8) y]))))))) diff --git a/test-tui/samizdat/tui/test_runner.clj b/test-tui/samizdat/tui/test_runner.clj index 7679efc6..47b64c30 100644 --- a/test-tui/samizdat/tui/test_runner.clj +++ b/test-tui/samizdat/tui/test_runner.clj @@ -23,9 +23,10 @@ a compiled C++ shim. The main suite stays buildable with nothing but jolt; everything about the TUI that can be checked as data is over there." (:require [clojure.test :as t] + [samizdat.tui.input-test] [samizdat.tui.mouse-test])) -(def namespaces '[samizdat.tui.mouse-test]) +(def namespaces '[samizdat.tui.input-test samizdat.tui.mouse-test]) (defn run [] (apply t/run-tests namespaces)) diff --git a/test/samizdat/base_test.clj b/test/samizdat/base_test.clj index a8c14c67..9752452c 100644 --- a/test/samizdat/base_test.clj +++ b/test/samizdat/base_test.clj @@ -219,20 +219,21 @@ {:threshold {200 "The success range of a status code. Protocol, as in server.clj." 299 "The other end of that range." - 40000 "How long the client waits for POST /v1/runs. Bounded by - the SERVER's own 30s start budget rather than by - anything a project chooses — a client bound tighter than + 150000 "How long the client waits for POST /v1/runs. Bounded by + the SERVER's own start deadline (gates.edn + :run-start-deadline-ms, 120 s shipped; control-test pins + the ordering) rather than by anything a project chooses — a client bound tighter than the endpoint it calls reports a failure for a run that started normally, which is the bug this number exists to - fix. It has to move with api.control's deref, not with a - policy table. + fix. It has to move with that deadline, not with a + front end's own table. And it could not read one anyway: this is a client of a server that may be on another machine, so the gates.edn it can reach is not the gates.edn the run obeys. Numbers a front end's user should tune live in that front end's own userspace — resources/tui.edn for the TUI." - 1500 "The poll interval. See 40000 on why a client's numbers + 1500 "The poll interval. See 150000 on why a client's numbers are not the server's userspace." 30000 "The poll backoff ceiling, same reasoning." 5000 "How often a front end polls what is not pushed (the run diff --git a/test/samizdat/control_test.clj b/test/samizdat/control_test.clj index f7e251d5..1fc4594b 100644 --- a/test/samizdat/control_test.clj +++ b/test/samizdat/control_test.clj @@ -40,6 +40,7 @@ [samizdat.workflow :as wf] [samizdat.agent.state :as state] [samizdat.agent.resume :as resume] + [samizdat.api.client :as api-client] [samizdat.api.control :as api-control] [samizdat.api.openai :as openai] [samizdat.api.runs :as api-runs] @@ -949,3 +950,99 @@ (is (= ["B1"] (mapv :id (:branches (resume/resume! {:conn c :config {} :llm-adapter :a :llm-config {} :run-id rid}))))))))) + +(deftest a-run-on-an-endpoint-that-refuses-connections-is-refused-at-the-door + ;; Run 0f4b9b55 started with the local model server down: every branch and + ;; the supervisor spent 6 turns of 3 attempts each on `connection refused` + ;; before the provider-error limit abandoned them (karamazov-rhrf). The + ;; run start asks the endpoint first — the same probe that learns what it + ;; is — and a refusal is a 503 that says what to do, not a run. + (with-db [c] + (let [ran (atom nil)] + (with-redefs [beam/run! (fn [{:keys [on-start llm-config]}] + (reset! ran llm-config) + (let [rid (str (random-uuid))] + (on-start rid) + {:run-id rid :status :completed}))] + (testing "unreachable: refused, and no run" + (with-redefs [llm/with-discovery + (fn [llm] (assoc llm :unreachable "connection refused: 127.0.0.1:8080"))] + (let [r (api-control/start-run! {:conn c :config {:llm {:provider :local + :base-url "http://127.0.0.1:8080/v1"}}} + {:problem "p"})] + (is (= 503 (:status r))) + (is (str/includes? (get-in r [:body :error :message]) "127.0.0.1:8080")) + (is (nil? @ran))))) + (testing "reachable: the run gets what the probe learned, and not the probe's bookkeeping" + (with-redefs [llm/with-discovery (fn [llm] (assoc llm :llama-cpp? true))] + (let [r (api-control/start-run! {:conn c :config {:llm {:provider :local + :base-url "http://127.0.0.1:8080/v1"}}} + {:problem "p"})] + (is (= "running" (get-in r [:body :status]))) + (is (loop [n 0] (cond @ran true (< n 100) (do (Thread/sleep 10) (recur (inc n))) :else false))) + (is (:llama-cpp? @ran)) + (is (not (contains? @ran :unreachable)))))) + (testing "the policy can turn the refusal off" + (reset! ran nil) + (with-redefs [llm/with-discovery + (fn [llm] (assoc llm :unreachable "connection refused: 127.0.0.1:8080")) + gates/threshold (let [t gates/threshold] + (fn [k] (if (= k :endpoint-preflight) false (t k))))] + (let [r (api-control/start-run! {:conn c :config {:llm {:provider :local + :base-url "http://127.0.0.1:8080/v1"}}} + {:problem "p"})] + (is (= "running" (get-in r [:body :status]))) + (is (loop [n 0] (cond @ran true (< n 100) (do (Thread/sleep 10) (recur (inc n))) :else false))) + (is (not (contains? @ran :unreachable)))))))))) + +(deftest a-resume-on-an-endpoint-that-refuses-connections-is-refused-too + (with-db [c] + (let [rid (runs/start-run! c {:problem "p"}) + resumed (atom nil)] + (runs/finish-run! c rid :failed nil) + (with-redefs [resume/resumable? (constantly true) + resume/resume! (fn [m] (reset! resumed m) {:status :completed}) + llm/with-discovery + (fn [llm] (assoc llm :unreachable "connection refused: 127.0.0.1:8080"))] + (let [r (api-control/resume! {:conn c :config {:llm {:provider :local + :base-url "http://127.0.0.1:8080/v1"}}} + rid {})] + (is (= 503 (:status r))) + (is (nil? @resumed)) + (is (nil? (get @api-control/active rid)) "the refused resume claims no slot")))))) + +(deftest a-front-end-waits-longer-for-a-run-than-the-server-does + ;; A client that gives up first reports a failure for a run that started, + ;; and a re-post starts a second one (karamazov-5fyo). The server's wait + ;; went to 120 s and the front ends' stayed at 40. + (is (< (lexicon/policy :run-start-deadline-ms) api-client/start-timeout-ms))) + +(deftest a-project-that-has-not-adopted-the-preflight-still-starts-runs + ;; A project's gates.edn and role map are its own copies, and a key a later + ;; release adds reaches it only when the supervisor adopts the new file. + ;; endless-flight's lacked :endpoint-preflight and the endpoint-unreachable + ;; role, and POST /v1/runs answered 500 over the missing key. + (with-db [c] + (let [ran (atom nil) + cfg {:llm {:provider :local :base-url "http://127.0.0.1:8080/v1"}} + down (fn [llm] (assoc llm :unreachable "connection refused: 127.0.0.1:8080"))] + (with-redefs [beam/run! (fn [{:keys [on-start llm-config]}] + (reset! ran llm-config) + (let [rid (str (random-uuid))] + (on-start rid) + {:run-id rid :status :completed})) + llm/with-discovery down] + (testing "no such policy: the run starts as it did before the key existed" + (with-redefs [gates/threshold (let [t gates/threshold] + (fn [k] (when-not (= k :endpoint-preflight) (t k))))] + (let [r (api-control/start-run! {:conn c :config cfg} {:problem "p"})] + (is (= "running" (get-in r [:body :status])))))) + (testing "the policy but no prose for it: still a 503, saying what the endpoint said" + (with-redefs [samizdat.prompt/render (let [r samizdat.prompt/render] + (fn [role & more] + (if (= role "endpoint-unreachable") + (throw (ex-info "no role endpoint-unreachable" {})) + (apply r role more))))] + (let [r (api-control/start-run! {:conn c :config cfg} {:problem "p"})] + (is (= 503 (:status r))) + (is (str/includes? (get-in r [:body :error :message]) "connection refused: 127.0.0.1:8080"))))))))) diff --git a/test/samizdat/llm_test.clj b/test/samizdat/llm_test.clj index 1638a5ff..4b60164a 100644 --- a/test/samizdat/llm_test.clj +++ b/test/samizdat/llm_test.clj @@ -1855,3 +1855,90 @@ (is (= "ok" (:content (client/chat (registry/adapter-for :local) {:base-url "http://h/v1" :model "m" :features features} [{:role "user" :content "x"}] opts)))))))) + +(deftest only-a-transport-failure-is-retried-as-one + ;; Run 74ddebb8's supervisor logged `transport: Cannot fork inside a + ;; try/finally` 2004 times: an error raised by the harness's own code + ;; inside the call was retried as a network blip, each retry failing the + ;; same way, and the run read it as an unreliable provider + ;; (karamazov-q8dy). A socket failure is an IOException; anything else + ;; is a bug here, and retrying a bug only reproduces it. + (let [a (registry/adapter-for :deepseek)] + (testing "a harness error is fatal, not retried, and not called transport" + (let [calls (atom 0)] + (with-redefs [http/post (fn [& _] + (swap! calls inc) + (throw (ex-info "Cannot fork inside a try/finally" {})))] + (let [e (try (client/chat a {:model "m"} [{:role "user" :content "go"}]) + (catch Exception ex ex))] + (is (= :harness-error (:reason (ex-data e)))) + (is (= 1 @calls)) + (is (not (str/includes? (ex-message e) "transport"))))))) + (testing "a refused connection is still retried" + (let [calls (atom 0)] + (with-redefs [http/post (fn [& _] + (swap! calls inc) + (throw (java.net.ConnectException. "connection refused: h:1"))) + samizdat.cancel/sleep! (fn [_] nil)] + (let [e (try (client/chat a {:model "m" :max-retries 1} + [{:role "user" :content "go"}]) + (catch Exception ex ex))] + (is (= 2 @calls)) + (is (str/includes? (ex-message e) "transport: connection refused")))))))) + +(deftest a-probe-that-gets-no-answer-says-so + ;; The startup probe used to read `connection refused` as `not llama.cpp`, + ;; so a harness started before its model server ran every run without + ;; prefix caching or the fold role the template needs, for the life of the + ;; process (karamazov-k9q3). No answer is not an answer. + (let [cfg {:base-url "http://127.0.0.1:1/v1" :model "m"}] + (with-redefs [http/get (fn [& _] (throw (java.net.ConnectException. + "connection refused: 127.0.0.1:1")))] + (is (= {:unreachable "connection refused: 127.0.0.1:1"} + (client/probe-llama-cpp cfg)))) + (with-redefs [http/get (fn [& _] {:status 404 :body "nope"})] + (is (nil? (client/probe-llama-cpp cfg)) "an answer that is not llama.cpp stays nil")))) + +(deftest discovery-remembers-answers-and-never-a-failure + (client/forget-discoveries!) + (let [probes (atom 0) + up? (atom false) + cfg {:base-url "http://127.0.0.1:8080/v1" :model "local-model" :features #{:stream}}] + (with-redefs [client/probe-llama-cpp (fn [_] + (swap! probes inc) + (if @up? + {:llama-cpp? true :total-slots 4 :model-id "Bonsai"} + {:unreachable "connection refused: 127.0.0.1:8080"})) + client/probe-fold-role (fn [_] "user")] + (testing "down: the llm is unchanged but for the reason, and nothing is kept" + (let [llm (client/with-discovery cfg)] + (is (= "connection refused: 127.0.0.1:8080" (:unreachable llm))) + (is (not (:llama-cpp? llm))) + (is (nil? (:fold-role llm))))) + (testing "up later: the next ask probes again and gets the facts" + (reset! up? true) + (let [llm (client/with-discovery cfg)] + (is (nil? (:unreachable llm))) + (is (:llama-cpp? llm)) + (is (= "Bonsai" (:model-id llm))) + (is (= "user" (:fold-role llm))) + (is (contains? (:features llm) :stream) "declared features kept") + (is (< 1 (count (:features llm))) "llama.cpp features added"))) + (testing "an answer is remembered per endpoint" + (let [n @probes] + (client/with-discovery cfg) + (is (= n @probes))))) + (testing "a hosted endpoint that is not llama.cpp is asked once and never for a fold role" + (client/forget-discoveries!) + (let [asked-fold (atom 0) n (atom 0) + hosted {:base-url "https://api.example.com/v1" :model "x"}] + (with-redefs [client/probe-llama-cpp (fn [_] (swap! n inc) nil) + client/probe-fold-role (fn [_] (swap! asked-fold inc) "system")] + (is (= hosted (client/with-discovery hosted))) + (client/with-discovery hosted) + (is (= 1 @n)) + (is (zero? @asked-fold))))) + (testing "an endpoint with no url is not probed" + (with-redefs [client/probe-llama-cpp (fn [_] (throw (ex-info "probed" {})))] + (is (= {:provider :local} (client/with-discovery {:provider :local}))))) + (client/forget-discoveries!))) diff --git a/test/samizdat/oversight_test.clj b/test/samizdat/oversight_test.clj index c34e53eb..224568d5 100644 --- a/test/samizdat/oversight_test.clj +++ b/test/samizdat/oversight_test.clj @@ -833,3 +833,11 @@ (assoc ctx :run-id rid2) {:oversight/idle 30 :oversight/unmet 2 :oversight/turns [] :oversight/firings []})) (is (= {:turn 1 :max-turns 40} @seen)))))) + +(deftest the-measurement-in-a-notice-reads-as-words-not-edn + ;; Run 0f4b9b55's notice said `Measured over this session: {:turns 1, + ;; :retried 10}` — a map printed at whoever reads the agent log + ;; (karamazov-8cih). + (is (= "turns 1, retried 10, call failed 2" + (ov/evidence-text (array-map :turns 1 :retried 10 :call-failed 2)))) + (is (= "" (ov/evidence-text nil)))) diff --git a/test/samizdat/tui_commands_test.clj b/test/samizdat/tui_commands_test.clj index 6093dfe8..055c524d 100644 --- a/test/samizdat/tui_commands_test.clj +++ b/test/samizdat/tui_commands_test.clj @@ -87,3 +87,15 @@ (is (= "two" (:input (-> s st/history-back st/history-back st/history-forward)))) (is (= "" (:input (-> s st/history-back st/history-forward))) "past the newest, an empty line") (is (= ["one" "two"] (:history (st/remember-input s "two"))) "a repeat is not stored twice"))) + +(deftest walking-the-history-keeps-the-line-being-typed + ;; Up from a half-typed line, then back down past the newest, is the line + ;; again — as a shell keeps it — not an empty box. + (let [s (-> (st/initial "b") (st/remember-input "one") (st/set-input "half"))] + (is (= "one" (:input (st/history-back s)))) + (is (= "half" (:input (-> s st/history-back st/history-forward)))) + (is (nil? (:history-draft (-> s st/history-back st/history-forward)))) + (testing "sending drops the draft" + (is (nil? (:history-draft (-> s st/history-back (st/remember-input "one")))))) + (testing "down with nothing recalled is nothing" + (is (= s (st/history-forward s)))))) diff --git a/test/samizdat/tui_notify_test.clj b/test/samizdat/tui_notify_test.clj index 9aba4c06..4a110d4e 100644 --- a/test/samizdat/tui_notify_test.clj +++ b/test/samizdat/tui_notify_test.clj @@ -59,3 +59,38 @@ (deftest the-shipped-settings-turn-them-on (is (= #{"question" "run-finished"} (set (:on (:notifications (layout/template))))))) + +(deftest the-terminal-raises-it-when-it-can + ;; osascript's `display notification` belongs to Script Editor: it showed as + ;; a script, and clicking it opened Script Editor. A notification the + ;; terminal raises is the terminal's, and clicking it goes to the tab. + (let [n {:title "samizdat · proj" :body "run done: fix it"}] + (is (= "\u001b]777;notify;samizdat · proj;run done: fix it\u0007" + (notify/escape {"TERM_PROGRAM" "ghostty"} n))) + (is (= "\u001b]777;notify;samizdat · proj;run done: fix it\u0007" + (notify/escape {"TERM_PROGRAM" "WezTerm"} n))) + (is (= "\u001b]9;samizdat · proj: run done: fix it\u0007" + (notify/escape {"TERM_PROGRAM" "iTerm.app"} n))) + (is (= "\u001b]99;;samizdat · proj: run done: fix it\u001b\\" + (notify/escape {"TERM" "xterm-kitty"} n))) + (testing "tmux keeps the sequence to itself, and an unknown terminal may not know it" + (is (nil? (notify/escape {"TERM_PROGRAM" "tmux" "TMUX" "/tmp/x"} n))) + (is (nil? (notify/escape {"TERM_PROGRAM" "ghostty" "TMUX" "/tmp/x"} n))) + (is (nil? (notify/escape {"TERM_PROGRAM" "Apple_Terminal"} n)))) + (testing "the text cannot end the sequence or split the title from the body" + (is (= "\u001b]777;notify;a,b;line one line two x\u0007" + (notify/escape {"TERM_PROGRAM" "ghostty"} + {:title "a;b" :body "line one\nline two \u0007x\u001b"})))))) + +(deftest a-configured-command-still-wins-then-the-terminal-then-the-platform + (let [n {:title "t" :body "b"} + ran (atom nil) wrote (atom nil) + go (fn [settings env os] + (reset! ran nil) (reset! wrote nil) + (notify/raise! settings n {:env env :os os + :write #(reset! wrote %) + :run #(reset! ran %)}) + [@ran @wrote])] + (is (= [["say" "b"] nil] (go {:command ["say" "{body}"]} {"TERM_PROGRAM" "ghostty"} "Mac OS X"))) + (is (= [nil "\u001b]777;notify;t;b\u0007"] (go {} {"TERM_PROGRAM" "ghostty"} "Mac OS X"))) + (is (= "osascript" (first (first (go {} {"TERM_PROGRAM" "Apple_Terminal"} "Mac OS X"))))))) diff --git a/test/samizdat/tui_widgets_test.clj b/test/samizdat/tui_widgets_test.clj index aae5f47a..c8ca51f3 100644 --- a/test/samizdat/tui_widgets_test.clj +++ b/test/samizdat/tui_widgets_test.clj @@ -797,3 +797,15 @@ {:settings cmds :input "/zz x"} {}))))) (testing "and nothing at all while typing a directive" (is (= [:empty] (render :widget/command-hints {:settings cmds :input "fix it"} {}))))) + +(deftest up-and-down-at-the-edges-of-the-box-walk-the-history + ;; The box says when Up leaves its top row or Down its bottom one — only it + ;; knows which row the cursor is on — and those are the history's, the way + ;; a shell's prompt has them. Inside a longer entry they still move rows. + (let [hit (atom []) + state {:on {:history-back #(swap! hit conj :back) + :history-forward #(swap! hit conj :forward)}} + inp (first (nodes-of :input (render :widget/input state {})))] + ((:on-up-edge (props-of inp))) + ((:on-down-edge (props-of inp))) + (is (= [:back :forward] @hit)))) diff --git a/tui/samizdat/tui/core.clj b/tui/samizdat/tui/core.clj index b1be06d5..77f26a0a 100644 --- a/tui/samizdat/tui/core.clj +++ b/tui/samizdat/tui/core.clj @@ -97,7 +97,8 @@ OFF THE UI THREAD, and that is not optional: the endpoint does not answer when the run row is written — beam/run! opens every branch first — so a start legitimately takes tens of seconds, which is why the client allows - it 40. A UI that stopped redrawing for that long is the frozen-but-alive + it longer than the server's own deadline (api.client/start-timeout-ms). A + UI that stopped redrawing for that long is the frozen-but-alive failure this project keeps finding." [text] (let [{:keys [base]} @state] @@ -295,7 +296,9 @@ :resume resume! :reply (fn [kind id] (swap! state st/start-reply kind id)) :toggle-option #(swap! state st/toggle-option %) - :scroll (fn [pane view] (swap! state st/scrolled pane view))}) + :scroll (fn [pane view] (swap! state st/scrolled pane view)) + :history-back #(swap! state st/history-back) + :history-forward #(swap! state st/history-forward)}) ;; --- the feeds ---------------------------------------------------------------- ;; @@ -370,7 +373,7 @@ ;; A moment a person who looked away wants to hear about. (let [settings (:notifications (layout/current))] (when-let [n (notify/for-event @state e settings)] - (notify/notify! settings n))))) + (notify/notify! settings n ui/write-raw!))))) (defonce ^:private workers (atom nil)) @@ -525,6 +528,16 @@ :else false))) +(defn- on-select + "A mouse drag selected text — in the compose box, the conversation, any + pane: put it on the clipboard. Through the terminal (OSC 52), since the + terminal is the one thing between here and the clipboard in every setup, + ssh included; one that refuses the sequence leaves Shift/Option-drag, the + terminal's own selection, as it always was." + [text] + (ui/copy! text) + (swap! state st/note-notice (str "copied " (count text) " characters"))) + (defn run-ui! "Draw the TUI against the server at `base` until the user quits. Blocks." [base] @@ -533,7 +546,7 @@ (try ;; Mouse on: the folds in the conversation are ftxui collapsibles and ;; clicking one is how they open. - (ui/run root :mode :fullscreen :mouse true :on-event on-event) + (ui/run root :mode :fullscreen :mouse true :on-event on-event :on-select on-select) (finally (stop-polling!)))) (defn -main [& args] diff --git a/tui/samizdat/tui/notify.clj b/tui/samizdat/tui/notify.clj index ce2d93d4..2d3d742c 100644 --- a/tui/samizdat/tui/notify.clj +++ b/tui/samizdat/tui/notify.clj @@ -24,10 +24,12 @@ Which moments, and how to raise one, are tui.edn `:notifications`: `:on` names the moments (\"question\", \"run-finished\"), and `:command`, when set, is the program to run with {title} and {body} filled in. Unset, the - platform's own: osascript on macOS, notify-send elsewhere. + TERMINAL raises it when it knows how (`escape`) — then the notification is + the terminal's, and clicking it goes to the tab. osascript's belonged to + Script Editor: it showed as a script and a click opened Script Editor. + Past that, the platform's own: osascript on macOS, notify-send elsewhere. - Pure, bar `notify!`, which runs the command and never lets a failure - reach the UI." + Pure, bar `notify!`, which does it and never lets a failure reach the UI." (:require [clojure.string :as str] [jolt.process :as proc])) @@ -77,11 +79,58 @@ :else nil)) +(defn- clean + "`s` fit to ride inside an escape sequence: a line break is a space and any + other control character — BEL or ESC would end the sequence — is gone." + [s] + (-> (str s) + (str/replace #"[\n\r\t]" " ") + (str/replace #"[\x00-\x1f\x7f]" ""))) + +(defn escape + "The sequence that has the terminal named by `env` (a map of environment + variables) raise `n` itself, or nil when it would not be understood. + Ghostty and WezTerm take OSC 777 with a title, iTerm2 OSC 9, kitty OSC 99. + Under tmux nothing: it keeps OSC sequences to itself unless configured to + pass them through, and a notification that silently never arrives is worse + than the platform's." + [env {:keys [title body]}] + (let [program (str (get env "TERM_PROGRAM")) + term (str (get env "TERM")) + title (clean title) + body (clean body) + joined (str title ": " body)] + (cond + (not (str/blank? (get env "TMUX"))) nil + (#{"ghostty" "WezTerm"} program) + (str "\u001b]777;notify;" (str/replace title ";" ",") ";" body "\u0007") + (= "iTerm.app" program) (str "\u001b]9;" joined "\u0007") + (str/includes? term "kitty") (str "\u001b]99;;" joined "\u001b\\") + :else nil))) + +(defn raise! + "Raise `n` by the first way that applies: the configured command, the + terminal's own sequence (`write` sends it), the platform's command (`run` + runs an argv). The effects are passed in so the choice is testable." + [settings n {:keys [env os write run]}] + (let [configured (:command settings) + esc (when (empty? configured) (escape env n))] + (if esc + (write esc) + (when-let [argv (command os configured n)] (run argv))) + nil)) + (defn notify! "Raise `n`, off the caller's thread. Best effort: a notifier that is not - installed or fails costs the notification, nothing else." - [settings n] - (when-let [argv (command (System/getProperty "os.name") (:command settings) n)] - (future - (try (deref (proc/process argv {})) (catch Throwable _ nil))) - nil)) + installed or fails costs the notification, nothing else. `write` sends an + escape sequence to the terminal (the toolkit's, which puts it between + frames)." + [settings n write] + (future + (try + (raise! settings n {:env (into {} (System/getenv)) + :os (System/getProperty "os.name") + :write write + :run #(deref (proc/process % {}))}) + (catch Throwable _ nil))) + nil) diff --git a/tui/samizdat/tui/state.clj b/tui/samizdat/tui/state.clj index d00f9652..02a24835 100644 --- a/tui/samizdat/tui/state.clj +++ b/tui/samizdat/tui/state.clj @@ -40,7 +40,7 @@ that called them, which no test could see because each half was correct on its own." #{:decide :answer :toggle :select-run :select-branch :input :submit :start - :abort :resume :reply :toggle-option :scroll}) + :abort :resume :reply :toggle-option :scroll :history-back :history-forward}) (def max-trace "How many steps the UI holds. The server's ring is bounded and so is this: @@ -79,8 +79,9 @@ ;; What this TUI printed — command output, /help — drawn in the ;; conversation as the harness's voice. Local: nothing the server holds. :local-notes [] - ;; What was sent from the compose box, oldest first, and where Ctrl+P / - ;; Ctrl+N have walked to in it (nil when not walking). + ;; What was sent from the compose box, oldest first, and where Up / Down + ;; (or Ctrl+P / Ctrl+N) have walked to in it (nil when not walking); the + ;; line being typed when the walk began is :history-draft. :history [] :history-at nil ;; The model and effort a /model or /effort with no run on screen set for @@ -558,11 +559,11 @@ (def ^:private history-cap 500) (defn remember-input - "Keep what was sent, for Ctrl+P. A repeat of the last line is not kept + "Keep what was sent, for Up / Ctrl+P. A repeat of the last line is not kept twice." [s text] (let [t (str/trim (str text))] - (cond-> (assoc s :history-at nil) + (cond-> (-> s (assoc :history-at nil) (dissoc :history-draft)) (and (seq t) (not= t (peek (:history s)))) (update :history (fn [h] (let [h (conj (vec h) t)] (if (> (count h) history-cap) @@ -570,20 +571,25 @@ h))))))) (defn history-back - "Ctrl+P: the line before the one on show." + "Up on the box's top row, or Ctrl+P: the line before the one on show. The + line being typed when the walk starts is kept, for coming back down to." [s] (let [h (:history s)] (if (empty? h) s (let [i (max 0 (dec (or (:history-at s) (count h))))] - (assoc s :history-at i :input (nth h i)))))) + (cond-> (assoc s :history-at i :input (nth h i)) + (nil? (:history-at s)) (assoc :history-draft (:input s))))))) (defn history-forward - "Ctrl+N: the line after; past the newest, an empty line." + "Down on the box's bottom row, or Ctrl+N: the line after; past the newest, + the line that was being typed." [s] (if-let [i (:history-at s)] (let [j (inc i)] (if (< j (count (:history s))) (assoc s :history-at j :input (nth (:history s) j)) - (assoc s :history-at nil :input ""))) + (-> s + (assoc :history-at nil :input (or (:history-draft s) "")) + (dissoc :history-draft)))) s)) diff --git a/tui/samizdat/tui/widgets.clj b/tui/samizdat/tui/widgets.clj index a3c741ef..be53b546 100644 --- a/tui/samizdat/tui/widgets.clj +++ b/tui/samizdat/tui/widgets.clj @@ -744,7 +744,12 @@ "the problem to work on — Enter starts a run, /help for commands" "a directive for the run — Enter sends, /help for commands")) :on-change (fn [s] (when-let [f (get-in state [:on :input])] (f s))) - :on-enter on-enter}] + :on-enter on-enter + ;; Up past the top row, Down past the bottom one: the + ;; history, as at a shell prompt. Only the box knows + ;; which row its cursor is on, so it says when. + :on-up-edge (fn [] (when-let [f (get-in state [:on :history-back])] (f))) + :on-down-edge (fn [] (when-let [f (get-in state [:on :history-forward])] (f)))}] [:button {:label "start" :style :ascii :on-click (fn [] (when-let [f (get-in state [:on :start])] (f (or (:input state) ""))))}]