ajet/tbd
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

scope tools by page
CI / Test + coverage (push) Successful in 3m34s
Details

Browse Source
This commit is contained in:
Adam Jeniski
2026-09-21 14:01:34 -09:00
parent a53f0c3621
commit bf38f7b1be
37 changed files with 1894 additions and 359 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ui/shadow-cljs.edn
+3 -2
View File
@@ -1,6 +1,7 @@
;; The UI compiles straight into the server's resources dir, so the server picks it up from
;; the classpath (see `tbd.core`, which serves `resources/public` at `/js`).
{:source-paths ["src" "test"]
;; the classpath (see `tbd.core`, which serves `resources/public` at `/js`). ../shared holds the
;; .cljc the UI and the server both read (the prompts an LLM is given, tbd.agent.prompt).
{:source-paths ["src" "test" "../shared"]
:dependencies
[[reagent "2.0.1"]
ui/src/tbd/ui/db.cljs
+6 -1
View File
@@ -3,7 +3,7 @@
(def default-db
{;; The page being shown (see tbd.ui.pages); it follows the URL's fragment.
:page :games
:page :tic-tac-toe
:calc {:x "" :y ""
;; {:status :idle}
;; {:status :loading}
@@ -35,15 +35,20 @@
;; one such call.
;; :size is what the panel was dragged to, in px: its :width and the :height of the conversation
;; in it (the rest of the panel is the same at any size).
;; :tools-expanded? is whether the tool calls and results show whole (wrapped) or, as they do by
;; default, each cut to one line ending in "…" when it doesn't fit.
;; The other two are for a reply that is still coming or being answered: :pending-calls are the
;; calls it has asked for so far, :tool-calls-used how many calls this turn has made.
;; :thinking-at is when (ms since the epoch) the last piece of the model's reasoning came, or nil.
:chat {:open? false
:size {:width 320 :height 256}
:tools-expanded? false
:input ""
:messages []
:status :idle
:error nil
:pending-calls nil
:thinking-at nil
:tool-calls-used 0}
;; Tic-tac-toe, entirely client side: the board (see tbd.ui.tictactoe) and whose turn it is.
:ttt {:board tictactoe/new-board
ui/src/tbd/ui/events.cljs
+48 -13
View File
@@ -74,6 +74,12 @@
(fn [cofx _]
(assoc cofx :hash js/location.hash)))
;; Coeffect: the time now, in ms since the epoch.
(rf/reg-cofx
::now
(fn [cofx _]
(assoc cofx :now (js/Date.now))))
;; Effect: show the page the URL names whenever it changes (a link was followed, or Back and
;; Forward were pressed). Only one listener is ever installed, however often this runs.
(defonce ^:private hash-listener (atom nil))
@@ -173,7 +179,7 @@
(defn- reset-chat
"An empty conversation, in a panel that is as open (or closed), and as big, as it was."
[db]
(assoc db :chat (merge (:chat db/default-db) (select-keys (:chat db) [:open? :size]))))
(assoc db :chat (merge (:chat db/default-db) (select-keys (:chat db) [:open? :size :tools-expanded?]))))
(rf/reg-event-db
::logout-response
@@ -315,6 +321,25 @@
[messages]
(drop-while #(= "tool" (:role %)) (take-last max-sent-messages messages)))
(def ^:private stale-result
"What the LLM is sent in place of a result from before the user's last message."
"(out of date: this was read on an earlier turn and the page may have changed since. Call the tool again for the current state.)")
(defn- without-stale-results
"`messages` with the content of the tool results from before the user's last message replaced by
`stale-result`. A result is a snapshot of the page when the tool ran, and the user can change the
page between messages, by hand or on another page; a model that is still shown the old snapshot
goes by it, even when told it is wrong. What it did stays (its calls, its own words), only what
it read goes. The results of this turn stay: a chain of calls goes on from the ones before
(list, then act on an id)."
[messages]
(let [last-user (or (last (keep-indexed (fn [i {:keys [role]}] (when (= "user" role) i)) messages)) 0)]
(into [] (map-indexed (fn [i message]
(cond-> message
(and (< i last-user) (= "tool" (:role message)))
(assoc :content stale-result))))
messages)))
;; The effect that sends the conversation: it goes with the page being shown (`page`, its id, for
;; the LLM to know where the user is) and the tools that page offers the LLM. Both are read from
;; the db every time, so a conversation that moves between pages (the LLM's own `navigate`, say)
@@ -322,7 +347,7 @@
(defn- chat-request [db messages]
(let [tools (model-context/definitions (:page db))]
{:uri "/api/chat" :method "POST"
:body (cond-> {:messages (mapv wire-message (recent messages))
:body (cond-> {:messages (mapv wire-message (without-stale-results (recent messages)))
:page (name (:page db))}
(seq tools) (assoc :tools tools))
:on-event [::chat-event]
@@ -340,6 +365,12 @@
(fn [db [_ width height]]
(assoc-in db [:chat :size] {:width width :height height})))
;; Whether the tool calls and results show whole, or each cut to one line.
(rf/reg-event-db
::chat-toggle-tools
(fn [db _]
(update-in db [:chat :tools-expanded?] not)))
(rf/reg-event-db
::chat-set-input
(fn [db [_ input]]
@@ -417,7 +448,7 @@
[db]
(let [{:keys [pending-calls tool-calls-used]} (:chat db)
used (+ (or tool-calls-used 0) (count pending-calls))
db (assoc-in db [:chat :pending-calls] nil)]
db (update db :chat assoc :pending-calls nil :thinking-at nil)]
(cond
(empty? pending-calls)
{:db (assoc-in db [:chat :status] :idle)}
@@ -444,21 +475,25 @@
;; One event of the reply, as the server sends them (see tbd.chat.routes): {:thinking "..."} for
;; the next piece of the model's reasoning (which is not kept: the user only sees that the model
;; is thinking), {:content "..."} for the next piece of the reply (the first starts the
;; is thinking, and for as long as pieces keep coming, which :thinking-at, the time the last one
;; came, is for), {:content "..."} for the next piece of the reply (the first starts the
;; assistant's message, the rest are added to it; one event can have both), {:tool-calls [{:id
;; :name :arguments}]} when it asks for tools to be called, and last {:done true} or {:error "..."}.
;; Events nobody is waiting for (the conversation was reset since) are dropped.
(rf/reg-event-fx
::chat-event
(fn [{:keys [db]} [_ {:keys [content tool-calls done error]}]]
(cond
(not= :loading (get-in db [:chat :status])) {:db db}
(text? content) {:db (append-to-reply db content)}
tool-calls {:db (assoc-in db [:chat :pending-calls] (mapv #(select-keys % [:id :name :arguments])
tool-calls))}
done (finish-reply db)
error {:db (chat-failed db error)}
:else {:db db})))
[(rf/inject-cofx ::now)]
(fn [{:keys [db now]} [_ {:keys [thinking content tool-calls done error]}]]
(let [loading? (= :loading (get-in db [:chat :status]))
db (cond-> db (and loading? (text? thinking)) (assoc-in [:chat :thinking-at] now))]
(cond
(not loading?) {:db db}
(text? content) {:db (append-to-reply db content)}
tool-calls {:db (assoc-in db [:chat :pending-calls] (mapv #(select-keys % [:id :name :arguments])
tool-calls))}
done (finish-reply db)
error {:db (chat-failed db error)}
:else {:db db}))))
(defn- call-all
"A promise of the results of `calls`, in order, as {:id :name :content :error?}. One after the
ui/src/tbd/ui/model_context.cljs
+1 -1
View File
@@ -14,7 +14,7 @@
A tool is {:name :description :input-schema :handler :pages}: `handler` takes its arguments as a
map and returns a value or a promise of one. A string is the result as it is, any other data
becomes JSON, and throwing (or rejecting) is an error result the agent can read. `pages` is the
set of pages (see tbd.ui.pages) the tool is offered on, so the LLM on the games page is not
set of pages (see tbd.ui.pages) the tool is offered on, so the LLM on the tic-tac-toe page is not
handed the todos' tools; a tool without it is offered on every page. What is offered follows the
page being shown: `definitions` and `call!` both take it, and a tool that is not offered on it
can neither be listed nor called."
ui/src/tbd/ui/pages.cljs
+2 -1
View File
@@ -6,7 +6,8 @@
(def pages
"The pages in the order of the tabs: {:id :title :login?}. :login? pages are only offered
(and only show anything) to someone who is logged in."
[{:id :games :title "Games"}
[{:id :tic-tac-toe :title "Tic-tac-toe"}
{:id :calculator :title "Calculator"}
{:id :todos :title "Todos" :login? true}
{:id :ai-setup :title "AI setup"}])
ui/src/tbd/ui/views.cljs
+52 -17
View File
@@ -1,5 +1,6 @@
(ns tbd.ui.views
(:require [clojure.string :as str]
[reagent.core :as r]
[re-frame.core :as rf]
[tbd.ui.events :as events]
[tbd.ui.pages :as pages]
@@ -188,13 +189,17 @@
(defn- chat-tool-line
"A tool the assistant calls, or what came of it, apart from what is said, and in smaller print.
All of it shows, wrapped: the conversation scrolls, so it needn't be cut short."
[text {:keys [error?]}]
[:div {:data-tool true
:style {:align-self "flex-start" :max-width "85%"
:white-space "pre-wrap" :overflow-wrap "anywhere"
:font-family "monospace" :font-size "12px"
:color (if error? "crimson" "#777")}}
One line, ending in \"…\" where it doesn't fit, unless `expanded?`: then all of it shows, wrapped."
[expanded? text {:keys [error?]}]
[:div (cond-> {:data-tool true
:style (merge {:align-self "flex-start" :max-width "85%" :flex-shrink 0
:overflow-wrap "anywhere"
:font-family "monospace" :font-size "12px"
:color (if error? "crimson" "#777")}
(if expanded?
{:white-space "pre-wrap"}
{:white-space "nowrap" :overflow "hidden" :text-overflow "ellipsis"}))}
(not expanded?) (assoc :title text))
text])
(defn- call-text [{:keys [name arguments]}]
@@ -206,13 +211,18 @@
(defn- chat-message
"What was said, as a bubble, and the tool calls the assistant made with it, and their results,
as lines between the bubbles."
[{:keys [role content tool-calls] :as message}]
[tools-expanded? {:keys [role content tool-calls] :as message}]
(if (= "tool" role)
[chat-tool-line (result-text message) message]
[chat-tool-line tools-expanded? (result-text message) message]
[:<>
(when-not (str/blank? content) [chat-bubble message])
(for [call tool-calls]
^{:key (:id call)} [chat-tool-line (call-text call) nil])]))
^{:key (:id call)} [chat-tool-line tools-expanded? (call-text call) nil])]))
(defn- tool-use?
"Whether the conversation has any tool call or result."
[messages]
(some #(or (= "tool" (:role %)) (seq (:tool-calls %))) messages))
(def ^:private chat-min-width 260)
(def ^:private chat-min-height 96)
@@ -227,16 +237,37 @@
(defn- at-end? [el]
(<= (- (.-scrollHeight el) (.-scrollTop el) (.-clientHeight el)) stuck-slack))
(def ^:private thinking-live-ms
"How recently (ms) a piece of the model's reasoning must have come for it to count as still
coming in."
250)
(def ^:private thinking-frame-ms 250)
(def ^:private thinking-tick-ms 100)
(defn- thinking-line
"\"Thinking…\" which, while pieces of the model's reasoning are still coming in (the last, at
`thinking-at`, was less than `thinking-live-ms` ago), cycles through one to three dots."
[thinking-at]
(r/with-let [clock (r/atom (js/Date.now))
timer (js/setInterval #(reset! clock (js/Date.now)) thinking-tick-ms)]
(let [now @clock
live? (and thinking-at (< (- now thinking-at) thinking-live-ms))]
[:div {:role "status" :style {:color "#777"}}
(if live?
(str "Thinking" (apply str (repeat (inc (mod (quot now thinking-frame-ms) 3)) ".")))
"Thinking…")])
(finally (js/clearInterval timer))))
(defn- chat-log
"The conversation, which follows its end (as the pieces of a reply come in) for as long as it is
scrolled to it. Scroll up to read back and it stays where it is, until you send a message or
scroll down to the end again (a message sent is among the ones that came since the last render,
which may also hold the first of the reply). \"Thinking…\" shows from the sending until the reply's first piece;
what the model reasons is not shown."
which may also hold the first of the reply). \"Thinking…\" shows from the sending until the reply's first piece
(animated while the model's reasoning is coming in); what the model reasons is not shown."
[_chat _size]
(let [stuck? (atom true)
seen (atom 0)]
(fn [{:keys [messages status]} {:keys [height]}]
(fn [{:keys [messages status thinking-at tools-expanded?]} {:keys [height]}]
[:div {:role "log" :aria-live "polite"
:ref (fn [el]
(when el
@@ -252,9 +283,9 @@
(if (and (empty? messages) (not= :loading status))
[:p {:style {:color "#777" :margin 0}} "Ask me anything."]
(for [[i message] (map-indexed vector messages)]
^{:key i} [chat-message message]))
^{:key i} [chat-message tools-expanded? message]))
(when (and (= :loading status) (not= "assistant" (:role (peek messages))))
[:div {:role "status" :style {:color "#777"}} "Thinking…"])])))
[thinking-line thinking-at])])))
(defn- chat-form [{:keys [input status]}]
(let [loading? (= :loading status)]
@@ -313,7 +344,7 @@
:cursor "nesw-resize" :touch-action "none"
:background "linear-gradient(225deg, #bbb 0 2px, transparent 2px 5px, #bbb 5px 7px, transparent 7px)"}}])
(defn- chat-panel [{:keys [messages status size] :as chat} user]
(defn- chat-panel [{:keys [messages status size tools-expanded?] :as chat} user]
[:div {:role "dialog" :aria-label "Chat"
:style {:position "absolute" :bottom "40px" :left 0 :box-sizing "border-box"
:width (str (:width size) "px")
@@ -322,6 +353,9 @@
:box-shadow "0 5px 15px rgba(0,0,0,0.1)"}}
[:div {:style {:display "flex" :align-items "center" :gap "0.5rem"}}
[:strong {:style {:flex 1}} "Chat"]
(when (tool-use? messages)
[link-button {:on-click #(rf/dispatch [::events/chat-toggle-tools])}
(if tools-expanded? "Collapse tool use" "Expand tool use")])
(when (and (seq messages) (not= :loading status))
[link-button {:on-click #(rf/dispatch [::events/chat-clear])} "Clear"])
[:button {:type "button" :aria-label "Close chat"
@@ -350,7 +384,8 @@
(defn- current-page [page user]
(case page
:games [:<> [tic-tac-toe] [calculator]]
:tic-tac-toe [tic-tac-toe]
:calculator [calculator]
:todos (if (= :logged-in (:status user)) [todos] [login-prompt user])
:ai-setup [:<> [mcp-setup] [browser-tools]]))
ui/src/tbd/ui/webmcp.cljs
+215 -66
View File
@@ -7,6 +7,12 @@
the form, press a button, tick a box) by dispatching the same re-frame events the views do, so
everything shows on screen, and reads what the page shows from the app-db.
Besides the tools, the page registers prompts and resources (`prompts`, `resources`), which is
what an MCP client lists next to the tools (Claude Code shows the prompts as slash commands and
the resources as @-mentions). They are the same instructions the page's own chatbot is given
(tbd.agent.prompt, shared with the server), so Claude or Codex is told to act rather than offer,
to chain calls and to play tic-tac-toe by the turn, and can read what page is open.
The same tools are registered with tbd.ui.model-context (by tbd.ui.core), which is how the page's
own chatbot offers them to its LLM and calls them, the ones of the page being shown (see
`tools`): this ns says what the tools are, and has the WebMCP way of offering them all to an
@@ -19,6 +25,7 @@
[clojure.string :as str]
[re-frame.core :as rf]
[re-frame.db :as rf-db]
[tbd.agent.prompt :as prompt]
[tbd.ui.events :as events]
[tbd.ui.model-context :as model-context]
[tbd.ui.pages :as pages]
@@ -106,13 +113,41 @@
(first (filter #(= id (:id %)) items)))
(defn- find-todo! [items id]
(or (find-todo items id) (fail! "todo not found")))
(or (find-todo items id) (fail! (str "todo not found: " id))))
;; --- Argument checks (the page can't trust that the agent honours the schema) ---
(defn- check-id! [id]
(when-not (and (number? id) (js/Number.isInteger id))
(fail! "invalid arguments: id must be an integer")))
(when-not (and (string? id) (seq id))
(fail! "invalid arguments: id must be a todo's id, the UUID list_todos gives")))
(defn- check-todos!
"Checks the `todos` argument of a todo tool, which takes its work as a list (one call for a
whole batch, not one call per todo): a non-empty list of maps that `check-item!` accepts."
[todos check-item!]
(when-not (and (sequential? todos) (seq todos) (every? map? todos))
(fail! "invalid arguments: todos must be a non-empty list of objects"))
(run! check-item! todos))
(defn- in-order
"A promise of the vector of `(f item)` (a promise) for each of `items`, run one at a time: a
request finishes before the next starts, so a failure is one item's. When one fails after
others were done, the error says how many were."
[f items]
(let [total (count items)]
(reduce (fn [so-far item]
(.then so-far
(fn [results]
(-> (js/Promise.resolve item)
(.then f)
(.then #(conj results %))
(.catch (fn [e]
(fail! (if (seq results)
(str (.-message e) " (the first " (count results) " of "
total " were done)")
(.-message e)))))))))
(js/Promise.resolve [])
items)))
;; --- The tools ---
@@ -149,7 +184,7 @@
(fail! "invalid arguments: x and y must be numbers"))
(when (= :loading (get-in (db) [:calc :result :status]))
(fail! "an addition is already in progress"))
(show! :games)
(show! :calculator)
(rf/dispatch-sync [::events/set-operand :x (str x)])
(rf/dispatch-sync [::events/set-operand :y (str y)])
(rf/dispatch-sync [::events/add])
@@ -163,53 +198,76 @@
(defn- list-todos [_]
(logged-in-todos))
(defn- get-todo [{:keys [id]}]
(check-id! id)
(defn- get-todo
"Reads todos by id, all of them or none."
[{:keys [todos]}]
(check-todos! todos #(check-id! (:id %)))
(-> (logged-in-todos)
(.then #(find-todo! % id))))
(.then (fn [items] (mapv #(find-todo! items (:id %)) todos)))))
(defn- create-todo
"Types the title into the new-todo field and presses Add."
(defn- create-one
"Types the title into the new-todo field and presses Add. A promise of the todo that was created."
[{:keys [title]}]
(when-not (and (string? title) (seq title))
(fail! "invalid arguments: title must be a non-empty string"))
(-> (logged-in-todos)
(.then (fn [_]
(show! :todos)
(rf/dispatch-sync [::events/set-new-title title])
;; The field is emptied when the todo was added; a failure leaves it as it is.
(change-todos [::events/add-todo] #(= "" (get-in % [:todos :new-title])) "the new todo")))
(show! :todos)
(rf/dispatch-sync [::events/set-new-title title])
;; The field is emptied when the todo was added; a failure leaves it as it is.
(-> (change-todos [::events/add-todo] #(= "" (get-in % [:todos :new-title])) "the new todo")
(.then #(last (get-in % [:todos :items])))))
(defn- set-todo-done
"Ticks or unticks a todo's checkbox."
(defn- create-todo
"Adds todos, one after the other: a promise of the todos that were created."
[{:keys [todos]}]
(check-todos! todos (fn [{:keys [title]}]
(when-not (and (string? title) (seq title))
(fail! "invalid arguments: title must be a non-empty string"))))
(-> (logged-in-todos)
(.then (fn [_] (in-order create-one todos)))))
(defn- set-one-done
"Ticks or unticks one todo's checkbox, unless it is already so (no request then). A promise of
the todo as the page shows it."
[{:keys [id done]}]
(check-id! id)
(when-not (boolean? done)
(fail! "invalid arguments: done must be true or false"))
(let [todo (find-todo! (get-in (db) [:todos :items]) id)]
(if (= done (boolean (:done todo)))
(js/Promise.resolve todo)
(-> (change-todos [::events/set-done id done]
#(= done (boolean (:done (find-todo (get-in % [:todos :items]) id))))
"the todo")
(.then #(find-todo (get-in % [:todos :items]) id))))))
(defn- set-todo-done
"Ticks or unticks the checkboxes of several todos. Every change is checked before the first is
made. A promise of the todos as they are then."
[{:keys [todos]}]
(check-todos! todos (fn [{:keys [id done]}]
(check-id! id)
(when-not (boolean? done)
(fail! "invalid arguments: done must be true or false"))))
(-> (logged-in-todos)
(.then (fn [items]
(let [todo (find-todo! items id)]
(show! :todos)
(if (= done (boolean (:done todo)))
todo
(-> (change-todos [::events/set-done id done]
#(= done (boolean (:done (find-todo (get-in % [:todos :items]) id))))
"the todo")
(.then #(find-todo (get-in % [:todos :items]) id)))))))))
(run! #(find-todo! items (:id %)) todos)
(show! :todos)
(in-order set-one-done todos)))))
(defn- delete-one
"Presses a todo's Delete button. A promise of its id."
[id]
(-> (change-todos [::events/delete-todo id]
#(nil? (find-todo (get-in % [:todos :items]) id))
"the todo to go")
(.then (fn [_] id))))
(defn- delete-todo
"Presses a todo's Delete button."
[{:keys [id]}]
(check-id! id)
(-> (logged-in-todos)
(.then (fn [items]
(find-todo! items id)
(show! :todos)
(change-todos [::events/delete-todo id]
#(nil? (find-todo (get-in % [:todos :items]) id))
"the todo to go")))
(.then (fn [_] "deleted"))))
"Presses the Delete button of several todos. Every id is looked up before the first is deleted."
[{:keys [todos]}]
(check-todos! todos #(check-id! (:id %)))
(let [ids (distinct (map :id todos))]
(-> (logged-in-todos)
(.then (fn [items]
(run! #(find-todo! items %) ids)
(show! :todos)
(in-order delete-one ids)))
(.then (fn [deleted] {:deleted deleted})))))
;; Tic-tac-toe is moves taken in turns: X, then O, on the same board. A person plays on the same
;; board, so a move names the side it is for, and is refused when it is not that side's turn: an
@@ -245,21 +303,29 @@
(fail! (str "it is " (name turn) "'s turn, not " player "'s: wait for the other side to move")))
(when (board cell)
(fail! (str "cell " cell " is taken")))
(show! :games)
(show! :tic-tac-toe)
(rf/dispatch-sync [::events/ttt-move cell])
(tic-tac-toe-state)))
(defn- new-tic-tac-toe-game
"Presses New game."
[_]
(show! :games)
(show! :tic-tac-toe)
(rf/dispatch-sync [::events/ttt-reset])
(tic-tac-toe-state))
(defn- object-schema [properties required]
{:type "object" :properties properties :required required})
(def ^:private todo-id {:type "integer" :description "The todo's id"})
(def ^:private todo-id {:type "string" :description "The todo's id, a UUID as list_todos gives it"})
(defn- todos-schema
"The `todos` argument of the todo tools: a list of objects, one per todo the call is about, so
that a batch is one call."
[description properties required]
(object-schema {:todos {:type "array" :minItems 1 :description description
:items (object-schema properties required)}}
["todos"]))
(def tools
"The tools, as {:name :description :input-schema :handler :pages}. `pages` is where the page's
@@ -286,12 +352,12 @@
["page"])
:handler navigate}
{:name "get_calculator" :pages #{:games}
{:name "get_calculator" :pages #{:calculator}
:description (str "What the calculator form on this page holds (JSON): the x and y in its fields, and "
"the result it is showing (status idle, loading, ok with the sum, or error with the message)")
:input-schema (object-schema {} []) :handler get-calculator}
{:name "add" :pages #{:games}
{:name "add" :pages #{:calculator}
:description (str "Adds two numbers: types them into the calculator form, presses Add, and returns the sum "
"the page shows (JSON). Only for arithmetic, not for adding items to a list")
:input-schema (object-schema {:x {:type "number" :description "The first number"}
@@ -305,30 +371,38 @@
:input-schema (object-schema {} []) :handler list-todos}
{:name "get_todo" :pages #{:todos}
:description "Gets one of the todos this page shows, by id (JSON)"
:input-schema (object-schema {:id todo-id} ["id"]) :handler get-todo}
:description (str "Gets todos this page shows, by id (JSON list). Takes a list: to read several, make ONE call "
"with all of them")
:input-schema (todos-schema "The todos to get, one per todo" {:id todo-id} ["id"])
:handler get-todo}
{:name "create_todo" :pages #{:todos}
:description "Types a title into the new-todo field, presses Add, and returns the todo that was created (JSON)"
:input-schema (object-schema {:title {:type "string" :minLength 1 :maxLength 200
:description "What needs doing"}}
["title"])
:description (str "Adds todos: types each title into the new-todo field and presses Add, and returns the todos "
"that were created (JSON list). Takes a list: to add several, make ONE call with all of them, "
"never one call per todo")
:input-schema (todos-schema "The todos to add, one per todo"
{:title {:type "string" :minLength 1 :maxLength 200 :description "What needs doing"}}
["title"])
:handler create-todo}
{:name "set_todo_done" :pages #{:todos}
:description "Ticks or unticks a todo's checkbox and returns the todo (JSON)"
:input-schema (object-schema {:id todo-id
:done {:type "boolean" :description "true to tick it off, false to untick it"}}
["id" "done"])
:description (str "Ticks or unticks the checkboxes of todos, and returns those todos (JSON list). Takes a list: "
"to change several, make ONE call with all of them, never one call per todo")
:input-schema (todos-schema "The changes to make, one per todo"
{:id todo-id
:done {:type "boolean" :description "true to tick it off, false to untick it"}}
["id" "done"])
:handler set-todo-done}
{:name "delete_todo" :pages #{:todos}
:description (str "Deletes a todo for good, by pressing its Delete button. Find the id with list_todos first; "
"never guess one, and never delete a todo the user did not clearly point at")
:input-schema (object-schema {:id todo-id} ["id"])
:description (str "Deletes todos for good, by pressing their Delete buttons, and returns the ids that were "
"deleted (JSON). Find the ids with list_todos first; never guess one, and never delete a "
"todo the user did not clearly point at. Takes a list: to delete several, make ONE call "
"with all of them")
:input-schema (todos-schema "The todos to delete, one per todo" {:id todo-id} ["id"])
:handler delete-todo}
{:name "get_tic_tac_toe" :pages #{:games}
{:name "get_tic_tac_toe" :pages #{:tic-tac-toe}
:description (str "The tic-tac-toe game on this page (JSON): board (9 cells, row by row, cell 0 the top left "
"and cell 8 the bottom right; null when empty, else \"x\" or \"o\"), turn (whose move it "
"is, \"x\" or \"o\": X goes first, and they alternate) and status (in_progress, won or draw; "
@@ -336,7 +410,7 @@
"before you move, and only move for your own side")
:input-schema (object-schema {} []) :handler get-tic-tac-toe}
{:name "move_tic_tac_toe" :pages #{:games}
{:name "move_tic_tac_toe" :pages #{:tic-tac-toe}
:description (str "Presses a cell of the tic-tac-toe board as `player`, your side, and returns the game as "
"get_tic_tac_toe does (including whose turn is next). Fails, and changes nothing, if it "
"is not your side's turn (the other side is the person's: wait for them to move), the "
@@ -349,10 +423,55 @@
["cell" "player"])
:handler move-tic-tac-toe}
{:name "new_tic_tac_toe_game" :pages #{:games}
{:name "new_tic_tac_toe_game" :pages #{:tic-tac-toe}
:description "Presses New game: clears the tic-tac-toe board, X to move (JSON, as get_tic_tac_toe)"
:input-schema (object-schema {} []) :handler new-tic-tac-toe-game}])
;; --- Prompts and resources ---
(def prompts
"The prompts an MCP client can start from, as {:name :description :arguments :handler}: `handler`
takes the arguments the client gave (strings, or nothing) and returns the prompt's text.
`arguments` is [{:name :description :required}], as MCP's `prompts/list`."
[{:name "drive_the_app"
:description (str "How to work this app's page: act in the same turn instead of offering, chain the "
"tools, report in a sentence. Optionally hands over what you want done")
:arguments [{:name "task" :required false
:description "What you want done in the app, e.g. \"add a todo to buy milk\""}]
:handler (fn [{:keys [task]}] (prompt/task task))}
{:name "play_tic_tac_toe"
:description "Plays tic-tac-toe with you on the page: moves only on its own side's turn, one move at a time"
:arguments [{:name "side" :required false
:description "The side the agent plays, \"x\" or \"o\" (default o: you play X and start)"}]
:handler (fn [{:keys [side]}] (prompt/tic-tac-toe side))}])
(defn- page-state
"A promise of what the page is showing: the open page, the pages and who is logged in."
[]
(-> (known-user)
(.then (fn [{:keys [status login message]}]
{:page (name (:page (db)))
:pages (mapv (fn [{:keys [id title login?]}]
(cond-> {:id (name id) :title title} login? (assoc :needs-login true)))
pages/pages)
:user (case status
:logged-in {:logged-in true :login login}
:anonymous {:logged-in false}
:error {:error message})}))))
(def resources
"The resources an MCP client can read, as {:name :description :uri :mime-type :provide}:
`provide` returns the text, or a promise of it."
[{:name "app_guide" :uri "webmcp://app/guide" :mime-type "text/markdown"
:description (str "Read this first: what the page's tools are for and how to use them (act, don't "
"offer; chain the calls; report briefly)")
:provide (fn [] prompt/guide)}
{:name "app_state" :uri "webmcp://app/state" :mime-type "application/json"
:description "Which page is open now, the pages of the app, and whether anyone is logged in (JSON)"
:provide (fn [] (-> (page-state) (.then #(js/JSON.stringify (clj->js %) nil 2))))}])
;; --- Registering them with WebMCP ---
(defn- text-result [text error?]
@@ -380,11 +499,41 @@
(js-invoke mcp "registerTool" name description (clj->js input-schema) (execute handler)))
mcp)
(defn- prompt-result
"MCP's `prompts/get` result: the prompt's text as the user's first message."
[description text]
#js {"description" description
"messages" #js [#js {"role" "user" "content" #js {"type" "text" "text" text}}]})
(defn register-prompts!
"Registers `prompts` on `mcp`: `registerPrompt(name, description, arguments, execute)`. Safe to
call again, like `register-tools!`."
[mcp]
(doseq [{:keys [name description arguments handler]} prompts]
(js-invoke mcp "registerPrompt" name description (clj->js arguments)
(fn [args] (prompt-result description (handler (js->clj args :keywordize-keys true))))))
mcp)
(defn register-resources!
"Registers `resources` on `mcp`: `registerResource(name, description, {uri, mimeType}, provide)`,
where `provide(uri)` gives MCP's `resources/read` result. Safe to call again."
[mcp]
(doseq [{:keys [name description uri mime-type provide]} resources]
(js-invoke mcp "registerResource" name description #js {"uri" uri "mimeType" mime-type}
(fn [requested]
(-> (js/Promise.resolve (provide))
(.then (fn [text]
#js {"contents" #js [#js {"uri" requested "mimeType" mime-type "text" text}]}))))))
mcp)
(defonce ^:private widget (atom nil))
(defn register!
"Offers `tools` to the agent through WebMCP. The first call creates the WebMCP widget (the small
square in the corner of the page, where the user pastes the token from their MCP client), later
ones only register the tools again. Returns the WebMCP instance."
"Offers `tools`, `prompts` and `resources` to the agent through WebMCP. The first call creates
the WebMCP widget (the small square in the corner of the page, where the user pastes the token
from their MCP client), later ones only register them again. Returns the WebMCP instance."
[]
(register-tools! (or @widget (reset! widget (WebMCP.)))))
(-> (or @widget (reset! widget (WebMCP.)))
register-tools!
register-prompts!
register-resources!))
ui/test/tbd/ui/events_test.cljs
+78 -22
View File
@@ -1,5 +1,6 @@
(ns tbd.ui.events-test
(:require [cljs.test :refer [deftest is testing async use-fixtures]]
[clojure.string :as str]
[re-frame.core :as rf]
[re-frame.db :as rf-db]
[tbd.ui.db :as db]
@@ -62,8 +63,8 @@
(reset! effects [])
(dispatch! [::events/initialize]))
(def ^:private todo-1 {:id 1 :owner-id 7 :title "buy milk" :done false :created-at 1 :updated-at 1})
(def ^:private todo-2 {:id 2 :owner-id 7 :title "walk dog" :done false :created-at 2 :updated-at 2})
(def ^:private todo-1 {:id (tu/todo-uuid 1) :owner-id 7 :title "buy milk" :done false :created-at 1 :updated-at 1})
(def ^:private todo-2 {:id (tu/todo-uuid 2) :owner-id 7 :title "walk dog" :done false :created-at 2 :updated-at 2})
(defn- logged-in!
"The page is up, alice is logged in and her todos (`items`) are shown."
@@ -94,7 +95,7 @@
(dispatch! [::events/hash-changed "#/todos"])
(is (= :todos (:page (app-db))))
(dispatch! [::events/hash-changed "#/nowhere"])
(is (= :games (:page (app-db))) "an unknown address shows the first page")
(is (= :tic-tac-toe (:page (app-db))) "an unknown address shows the first page")
(is (= [] (requests)) "changing the page asks the server for nothing"))
(deftest navigate-test
@@ -237,27 +238,27 @@
(deftest set-done-test
(logged-in! [todo-1 todo-2])
(dispatch! [::events/set-done 2 true])
(is (= {:uri "/api/todos/2" :method "PATCH" :body {:done true} :on-response [::events/todo-changed]}
(dispatch! [::events/set-done (:id todo-2) true])
(is (= {:uri (str "/api/todos/" (:id todo-2)) :method "PATCH" :body {:done true} :on-response [::events/todo-changed]}
(last-request)))
(testing "the todo is replaced by what the server made of it, in place"
(answer! 200 (assoc todo-2 :done true :updated-at 5))
(is (= [todo-1 (assoc todo-2 :done true :updated-at 5)] (get-in (app-db) [:todos :items]))))
(testing "a failure keeps the list and shows why"
(dispatch! [::events/set-done 1 true])
(dispatch! [::events/set-done (:id todo-1) true])
(answer! 404 {:error "todo not found"})
(is (= "todo not found" (get-in (app-db) [:todos :error])))
(is (false? (:done (first (get-in (app-db) [:todos :items])))))))
(deftest delete-todo-test
(logged-in! [todo-1 todo-2])
(dispatch! [::events/delete-todo 1])
(is (= {:uri "/api/todos/1" :method "DELETE" :on-response [::events/todo-deleted 1]} (last-request)))
(dispatch! [::events/delete-todo (:id todo-1)])
(is (= {:uri (str "/api/todos/" (:id todo-1)) :method "DELETE" :on-response [::events/todo-deleted (:id todo-1)]} (last-request)))
(testing "it goes from the list"
(answer! 200 {:deleted true})
(is (= [todo-2] (get-in (app-db) [:todos :items]))))
(testing "a failure keeps the list and shows why"
(dispatch! [::events/delete-todo 2])
(dispatch! [::events/delete-todo (:id todo-2)])
(answer! 500 {:error "Boom"})
(is (= [todo-2] (get-in (app-db) [:todos :items])))
(is (= "Boom" (get-in (app-db) [:todos :error])))))
@@ -265,8 +266,8 @@
(deftest expired-session-test
(testing "a 401 to any change falls back to the logged-out view"
(doseq [[event] [[[::events/add-todo]]
[[::events/set-done 1 true]]
[[::events/delete-todo 1]]]]
[[::events/set-done (:id todo-1) true]]
[[::events/delete-todo (:id todo-1)]]]]
(logged-in! [todo-1])
(dispatch! event)
(answer! 401 {:error "not logged in"})
@@ -308,7 +309,7 @@
(testing "the trimmed message joins the conversation and goes to the server, for a stream back"
(is (= [::events/fetch-stream
{:uri "/api/chat" :method "POST"
:body {:messages [{:role "user" :content "hello there"}] :page "games"}
:body {:messages [{:role "user" :content "hello there"}] :page "tic-tac-toe"}
:on-event [::events/chat-event]
:on-response [::events/chat-response]}]
(last @effects)))
@@ -364,6 +365,24 @@
{:role "user" :content "again"}]
(get-in (last-request) [:body :messages])))))
(deftest chat-thinking-time-test
;; The view animates "Thinking" while pieces of the reasoning are still coming in: the time of
;; the last one is what it goes by.
(logged-in! [])
(is (nil? (:thinking-at (chat))))
(say! "hello")
(is (nil? (:thinking-at (chat))) "nothing has been thought yet")
(event! {:thinking "Let me "})
(let [at (:thinking-at (chat))]
(is (number? at))
(event! {:content "Hi"})
(is (= at (:thinking-at (chat))) "only reasoning moves it"))
(event! {:thinking ""})
(event! {:done true})
(is (nil? (:thinking-at (chat))) "the reply is over")
(event! {:thinking "late"})
(is (nil? (:thinking-at (chat))) "reasoning nobody waits for is dropped"))
(deftest chat-thinking-and-text-in-one-event-test
(logged-in! [])
(say! "hello")
@@ -469,6 +488,19 @@
(dispatch! [::events/chat-clear])
(is (= (assoc (:chat db/default-db) :open? true) (chat)) "starts over, and the panel stays as it was"))
(deftest chat-toggle-tools-test
(logged-in! [])
(is (false? (:tools-expanded? (chat))) "tool use is collapsed to a line each by default")
(dispatch! [::events/chat-toggle-tools])
(is (true? (:tools-expanded? (chat))))
(testing "the choice stays when the conversation starts over"
(say! "hello")
(reply! "Hi!")
(dispatch! [::events/chat-clear])
(is (true? (:tools-expanded? (chat)))))
(dispatch! [::events/chat-toggle-tools])
(is (false? (:tools-expanded? (chat)))))
(deftest chat-resize-test
(logged-in! [])
(is (= {:width 320 :height 256} (:size (chat))) "the size it starts with")
@@ -544,7 +576,7 @@
(logged-in! [])
(testing "the page the user is on goes along with the conversation"
(say! "hi")
(is (= "games" (:page (:body (last-request))))))
(is (= "tic-tac-toe" (:page (:body (last-request))))))
(testing "and follows them, or the LLM itself, to the next page"
(reply! "hello")
(dispatch! [::events/navigate :ai-setup])
@@ -564,13 +596,13 @@
(deftest chat-offers-the-tools-of-the-page-test
(logged-in! [])
(model-context/register! [{:name "ping" :description "Pings" :input-schema add-schema :handler identity}
{:name "add" :pages #{:games} :description "Adds" :input-schema add-schema :handler identity}
{:name "add" :pages #{:tic-tac-toe} :description "Adds" :input-schema add-schema :handler identity}
{:name "list_todos" :pages #{:todos} :description "Lists" :input-schema add-schema
:handler identity}])
(let [offered (fn [] (map :name (:tools (:body (last-request)))))]
(testing "on a page, its tools and those of every page are offered"
(say! "hi")
(is (= :games (:page (app-db))))
(is (= :tic-tac-toe (:page (app-db))))
(is (= ["ping" "add"] (offered))))
(testing "the tools follow the page the user is on when the message is sent"
(reply! "hello")
@@ -585,14 +617,14 @@
(deftest chat-tool-calls-go-by-the-page-test
(logged-in! [])
(model-context/register! [{:name "add" :pages #{:games} :description "Adds" :input-schema add-schema :handler identity}])
(model-context/register! [{:name "add" :pages #{:tic-tac-toe} :description "Adds" :input-schema add-schema :handler identity}])
(dispatch! [::events/navigate :todos])
(say! "1+2?")
(asks! (call "c1" "add" "{}"))
(testing "the calls are made on the tools of the page the user is on, not those of the first page"
(is (= [:todos] (map :page (tool-calls-asked)))))
(testing "the follow-up request follows the page too: the user may have gone elsewhere meanwhile"
(dispatch! [::events/navigate :games])
(dispatch! [::events/navigate :tic-tac-toe])
(ran! ["c1" "add" "tool not available on this page: add" true])
(is (= ["add"] (map :name (:tools (:body (last-request))))))))
@@ -612,7 +644,7 @@
:tool-calls [(call "c1" "add" "{\"x\":1,\"y\":2}")]}]
(:messages (chat))))
(is (= :loading (:status (chat))) "the LLM still has to answer")
(is (= [{:page :games :calls [(call "c1" "add" "{\"x\":1,\"y\":2}")] :on-results [::events/chat-tool-results]}]
(is (= [{:page :tic-tac-toe :calls [(call "c1" "add" "{\"x\":1,\"y\":2}")] :on-results [::events/chat-tool-results]}]
(tool-calls-asked)))
(is (= 1 (count (requests))) "nothing is sent while the tools run"))
(testing "another message can't be sent meanwhile"
@@ -745,6 +777,30 @@
(select-keys (chat) [:messages :input :status :error :pending-calls])))
(is (= [] (tool-calls-asked)))))
(deftest chat-sends-results-of-earlier-turns-as-out-of-date-test
(logged-in! [])
(swap! rf-db/app-db assoc-in [:chat :messages]
[{:role "user" :content "play"}
{:role "assistant" :content "" :tool-calls [(call "old" "get_tic_tac_toe" "{}")]}
{:role "tool" :tool-call-id "old" :name "get_tic_tac_toe" :content "{\"turn\":\"x\"}" :error? false}
{:role "assistant" :content "Your move."}])
(say! "that's wrong, it's my turn")
(testing "a result from before the user's last message is no longer sent, its call and reply are"
(let [sent (get-in (last-request) [:body :messages])]
(is (= ["user" "assistant" "tool" "assistant" "user"] (map :role sent)))
(is (= "old" (:tool-call-id (nth sent 2))))
(is (str/includes? (:content (nth sent 2)) "out of date"))
(is (not (str/includes? (:content (nth sent 2)) "\"turn\"")) "what it read is gone")
(is (= "Your move." (:content (nth sent 3))))))
(testing "the conversation the user sees keeps the result"
(is (= "{\"turn\":\"x\"}" (:content (nth (:messages (chat)) 2)))))
(testing "the results of the turn going on are sent as they are, for the chain to continue"
(asks! (call "new" "get_tic_tac_toe" "{}"))
(ran! ["new" "get_tic_tac_toe" "{\"turn\":\"o\"}" false])
(let [sent (get-in (last-request) [:body :messages])]
(is (str/includes? (:content (nth sent 2)) "out of date"))
(is (= "{\"turn\":\"o\"}" (:content (last sent)))))))
(deftest chat-sends-no-orphaned-result-test
(logged-in! [])
;; The oldest message is the one that asked for the call whose result comes next, and it is what
@@ -765,7 +821,7 @@
answer (atom nil)]
(rf/reg-event-fx ::ran (fn [_ [_ results]] (@answer results) {}))
(model-context/register!
[{:name "games-only" :pages #{:games} :description "d" :input-schema add-schema :handler (fn [_] "played")}
[{:name "tic-tac-toe-only" :pages #{:tic-tac-toe} :description "d" :input-schema add-schema :handler (fn [_] "played")}
{:name "anywhere" :description "d" :input-schema add-schema :handler (fn [_] "ok")}])
(async done
(tu/finish
@@ -773,15 +829,15 @@
#(js/Promise. (fn [resolve]
(reset! answer resolve)
(call-tools-fx {:page :todos
:calls [(call "1" "games-only" "{}") (call "2" "anywhere" "{}")]
:calls [(call "1" "tic-tac-toe-only" "{}") (call "2" "anywhere" "{}")]
:on-results [::ran]})))
(fn [results]
(is (= [["tool not available on this page: games-only (it is offered on the games page)" true]
(is (= [["tool not available on this page: tic-tac-toe-only (it is offered on the tic-tac-toe page)" true]
["ok" false]]
(map (juxt :content (comp boolean :error?)) results))))
#(js/Promise. (fn [resolve]
(reset! answer resolve)
(call-tools-fx {:page :games :calls [(call "1" "games-only" "{}")] :on-results [::ran]})))
(call-tools-fx {:page :tic-tac-toe :calls [(call "1" "tic-tac-toe-only" "{}")] :on-results [::ran]})))
(fn [results] (is (= ["played"] (map :content results)))))
done))))
ui/test/tbd/ui/model_context_test.cljs
+18 -18
View File
@@ -14,50 +14,50 @@
(deftest definitions-test
(testing "nothing registered, nothing offered"
(is (= [] (model-context/definitions :games))))
(is (= [] (model-context/definitions :tic-tac-toe))))
(testing "what the LLM is told is MCP's tools/list, in the order of registration, without the handlers"
(model-context/register! [(tool "b" identity) (tool "a" identity)])
(is (= [{:name "b" :description "b tool" :inputSchema schema}
{:name "a" :description "a tool" :inputSchema schema}]
(model-context/definitions :games))))
(model-context/definitions :tic-tac-toe))))
(testing "a tool without a description has none"
(model-context/clear!)
(model-context/register! [(tool "a" identity :description nil)])
(is (= [{:name "a" :inputSchema schema}] (model-context/definitions :games)))))
(is (= [{:name "a" :inputSchema schema}] (model-context/definitions :tic-tac-toe)))))
(deftest register-test
(testing "registering a name again replaces the tool, so it is safe on hot reload"
(model-context/register! [(tool "a" identity) (tool "b" identity)])
(model-context/register! [(tool "a" identity :description "new") (tool "b" identity)])
(is (= [["a" "new"] ["b" "b tool"]] (map (juxt :name :description) (model-context/definitions :games)))))
(is (= [["a" "new"] ["b" "b tool"]] (map (juxt :name :description) (model-context/definitions :tic-tac-toe)))))
(testing "tools of other names stay"
(model-context/register! [(tool "c" identity)])
(is (= ["a" "b" "c"] (map :name (model-context/definitions :games)))))
(is (= ["a" "b" "c"] (map :name (model-context/definitions :tic-tac-toe)))))
(testing "clear! takes them all"
(model-context/clear!)
(is (= [] (model-context/definitions :games)))))
(is (= [] (model-context/definitions :tic-tac-toe)))))
(deftest pages-test
(model-context/register! [(tool "everywhere" identity)
(tool "games-only" identity :pages #{:games})
(tool "tic-tac-toe-only" identity :pages #{:tic-tac-toe})
(tool "todos-only" identity :pages #{:todos})
(tool "both" identity :pages #{:games :todos})])
(tool "both" identity :pages #{:tic-tac-toe :todos})])
(testing "a tool without pages is offered on every page, the others only on theirs"
(is (= ["everywhere" "games-only" "both"] (map :name (model-context/definitions :games))))
(is (= ["everywhere" "tic-tac-toe-only" "both"] (map :name (model-context/definitions :tic-tac-toe))))
(is (= ["everywhere" "todos-only" "both"] (map :name (model-context/definitions :todos))))
(is (= ["everywhere"] (map :name (model-context/definitions :ai-setup)))))
(testing "the pages are not part of what the LLM is told"
(is (= #{:name :description :inputSchema} (set (mapcat keys (model-context/definitions :games))))))
(is (= #{:name :description :inputSchema} (set (mapcat keys (model-context/definitions :tic-tac-toe))))))
(testing "a page that is not known, or none, is offered the tools of no page"
(is (= ["everywhere"] (map :name (model-context/definitions nil)))))
(testing "registering a tool again replaces its pages too"
(model-context/register! [(tool "games-only" identity :pages #{:todos})])
(is (= ["everywhere" "both"] (map :name (model-context/definitions :games))))))
(model-context/register! [(tool "tic-tac-toe-only" identity :pages #{:todos})])
(is (= ["everywhere" "both"] (map :name (model-context/definitions :tic-tac-toe))))))
(defn- called
"A promise of the result of calling `tool-name` on the JSON text `arguments`."
[tool-name arguments]
(model-context/call! :games tool-name arguments))
(model-context/call! :tic-tac-toe tool-name arguments))
(deftest call-test
(let [seen (atom nil)]
@@ -104,22 +104,22 @@
(deftest call-pages-test
(let [ran (atom [])]
(model-context/register! [(tool "games-only" (fn [_] (swap! ran conj :games-only) "played") :pages #{:games})
(model-context/register! [(tool "tic-tac-toe-only" (fn [_] (swap! ran conj :tic-tac-toe-only) "played") :pages #{:tic-tac-toe})
(tool "everywhere" (fn [_] (swap! ran conj :everywhere) "ran"))])
(async done
(tu/finish
(tu/steps
#(model-context/call! :games "games-only" "{}")
#(model-context/call! :tic-tac-toe "tic-tac-toe-only" "{}")
(fn [r] (is (= {:text "played" :error? false} r) "on its page, a tool is called"))
#(model-context/call! :todos "everywhere" "{}")
(fn [r] (is (= {:text "ran" :error? false} r) "a tool of no page is called on any"))
#(model-context/call! :todos "games-only" "{}")
#(model-context/call! :todos "tic-tac-toe-only" "{}")
(fn [r]
(testing "a tool of another page is refused, and the LLM is told where it is offered"
(is (= {:text "tool not available on this page: games-only (it is offered on the games page)"
(is (= {:text "tool not available on this page: tic-tac-toe-only (it is offered on the tic-tac-toe page)"
:error? true}
r))))
(fn [_] (is (= [:games-only :everywhere] @ran) "and never run")))
(fn [_] (is (= [:tic-tac-toe-only :everywhere] @ran) "and never run")))
done))))
(deftest call-failures-test
ui/test/tbd/ui/pages_test.cljs
+4 -4
View File
@@ -3,7 +3,7 @@
[tbd.ui.pages :as pages]))
(deftest page->hash-test
(is (= "#/games" (pages/page->hash :games)))
(is (= "#/tic-tac-toe" (pages/page->hash :tic-tac-toe)))
(is (= "#/ai-setup" (pages/page->hash :ai-setup))))
(deftest hash->page-test
@@ -17,10 +17,10 @@
(testing "what follows the page's name is ignored"
(is (= :todos (pages/hash->page "#/todos/1?a=b"))))
(testing "no page, or an unknown one, is the first page"
(is (= :games pages/default-page))
(is (= :tic-tac-toe pages/default-page))
(doseq [hash [nil "" "#" "#/" "#/nowhere" "#/Todos"]]
(is (= :games (pages/hash->page hash)) (pr-str hash)))))
(is (= :tic-tac-toe (pages/hash->page hash)) (pr-str hash)))))
(deftest pages-test
(is (= [:games :todos :ai-setup] (mapv :id pages/pages)) "the order of the tabs")
(is (= [:tic-tac-toe :calculator :todos :ai-setup] (mapv :id pages/pages)) "the order of the tabs")
(is (= [:todos] (mapv :id (filter :login? pages/pages)))))
ui/test/tbd/ui/subs_test.cljs
+3 -3
View File
@@ -23,7 +23,7 @@
(deftest plain-subs-test
(testing "a new page"
(is (= "" (sub [::subs/operand :x])))
(is (= :games (sub [::subs/page])))
(is (= :tic-tac-toe (sub [::subs/page])))
(is (= {:status :idle} (sub [::subs/result])))
(is (= {:status :unknown} (sub [::subs/user])))
(is (= (:todos db/default-db) (sub [::subs/todos])))
@@ -33,13 +33,13 @@
(db! assoc-in [:calc :x] "4")
(db! assoc-in [:calc :result] {:status :ok :x "4" :y "1" :sum 5})
(db! assoc :user {:status :logged-in :login "alice"})
(db! assoc-in [:todos :items] [{:id 1 :title "a"}])
(db! assoc-in [:todos :items] [{:id "a1" :title "a"}])
(db! assoc-in [:mcp :copied?] true)
(is (= :todos (sub [::subs/page])))
(is (= "4" (sub [::subs/operand :x])))
(is (= 5 (:sum (sub [::subs/result]))))
(is (= "alice" (:login (sub [::subs/user]))))
(is (= [{:id 1 :title "a"}] (:items (sub [::subs/todos]))))
(is (= [{:id "a1" :title "a"}] (:items (sub [::subs/todos]))))
(is (true? (sub [::subs/mcp-copied?])))))
(deftest ttt-game-test
ui/test/tbd/ui/test_util.cljs
+8 -2
View File
@@ -31,6 +31,12 @@
come first served (a conversation that goes back and forth, as when the LLM uses tools)."
(atom nil))
(defn todo-uuid
"The id the fake server gives its `n`th todo: a UUID, as the real server's are, but one a test
can write down."
[n]
(str "00000000-0000-4000-8000-" (.padStart (str n) 12 "0")))
(defn- respond [status body]
{:status status :body (pr-str body)})
@@ -48,7 +54,7 @@
(defn- route [method uri body]
(let [{:keys [user todos]} @server
todo-id (some->> (re-find #"^/api/todos/(\d+)$" uri) second js/parseInt)]
todo-id (some->> (re-find #"^/api/todos/([0-9a-f-]{36})$" uri) second)]
(cond
(= "/auth/me" uri) (if user (respond 200 user) (respond 401 {:error "not logged in"}))
(and (= "POST" method) (= "/auth/logout" uri)) (do (swap! server assoc :user nil)
@@ -73,7 +79,7 @@
(and (= "GET" method) (= "/api/todos" uri)) (respond 200 {:todos todos})
(and (= "POST" method) (= "/api/todos" uri))
(if (seq (.trim (:title body)))
(let [todo {:id (:next-id @server) :owner-id 7 :title (:title body) :done false
(let [todo {:id (todo-uuid (:next-id @server)) :owner-id 7 :title (:title body) :done false
:created-at 1 :updated-at 1}]
(swap! server #(-> % (update :todos conj todo) (update :next-id inc)))
(respond 201 todo))
ui/test/tbd/ui/views_test.cljs
+88 -28
View File
@@ -52,8 +52,8 @@
#(tu/eventually todos-section)
#(tu/eventually (fn [] (or (q "ul li") (= "Nothing to do." (text "section > p")))))))
(def ^:private todo-1 {:id 1 :owner-id 7 :title "buy milk" :done false :created-at 1 :updated-at 1})
(def ^:private todo-2 {:id 2 :owner-id 7 :title "walk dog" :done true :created-at 2 :updated-at 2})
(def ^:private todo-1 {:id (tu/todo-uuid 1) :owner-id 7 :title "buy milk" :done false :created-at 1 :updated-at 1})
(def ^:private todo-2 {:id (tu/todo-uuid 2) :owner-id 7 :title "walk dog" :done true :created-at 2 :updated-at 2})
;; --- The page as a visitor sees it ---
@@ -68,8 +68,8 @@
(is (= ["API docs" "swagger.json" "Log in"] (nav-links)))
(is (= "/auth/login" (.getAttribute (q "a[href=\"/auth/login\"]") "href")))
(is (nil? (todos-section)) "no todos without a login")
(is (= ["Games" "AI setup"] (tab-titles)) "no Todos tab without a login")
(is (= ["Tic-tac-toe" "Calculator"] (mapv #(.-textContent %) (q-all "h2"))) "the first page is Games")))
(is (= ["Tic-tac-toe" "Calculator" "AI setup"] (tab-titles)) "no Todos tab without a login")
(is (= ["Tic-tac-toe"] (mapv #(.-textContent %) (q-all "h2"))) "the first page is tic-tac-toe")))
done)))
(deftest login-state-error-test
@@ -92,7 +92,7 @@
(async done
(tu/finish
(steps
open-page!
#(open-page! :calculator)
#(tu/eventually (fn [] (q "input[name=x]")))
(fn []
(is (nil? (q "form [role=alert]")))
@@ -203,7 +203,7 @@
(tu/eventually (fn [] (= ["walk dog"] (todo-titles)))))
(fn [_]
(is (= ["walk dog"] (todo-titles)))
(is (= [2] (mapv :id (:todos @tu/server))))
(is (= [(:id todo-2)] (mapv :id (:todos @tu/server))))
(click! (tu/by-label "Delete walk dog"))
(tu/eventually (fn [] (= "Nothing to do." (text "section > p")))))
(fn [emptied]
@@ -403,11 +403,18 @@
open-page!
#(tu/eventually (fn [] (q "nav a")))
(fn []
(is (= "Games" (current-tab)) "it starts on the first tab")
(is (= "#/games" (.getAttribute (q "nav a") "href")))
(is (= "Tic-tac-toe" (current-tab)) "it starts on the first tab")
(is (= "#/tic-tac-toe" (.getAttribute (q "nav a") "href")))
(is (some? (q "[role=status]")) "the game is on the page")
(is (nil? (q "input[name=x]")) "and the calculator is not: it has a page of its own")
(is (nil? (q "details")) "nothing is folded away")
(click! (second (q-all "nav a"))))
#(tu/eventually (fn [] (= "Calculator" (current-tab))))
(fn []
(is (= "#/calculator" js/location.hash))
(is (nil? (q "[role=status]")) "the game is gone")
(is (some? (q "input[name=x]")) "the calculator is on the page")
(click! (last (q-all "nav a"))))
#(tu/eventually (fn [] (= "AI setup" (current-tab))))
(fn []
(is (= "#/ai-setup" js/location.hash) "a page has an address of its own")
@@ -415,8 +422,8 @@
(is (= ["Add this MCP server to Claude Code" "Browser tools (WebMCP)"]
(mapv #(.-textContent %) (q-all "h2"))))
;; Back.
(set! js/location.hash "#/games"))
#(tu/eventually (fn [] (= "Games" (current-tab))))
(set! js/location.hash "#/tic-tac-toe"))
#(tu/eventually (fn [] (= "Tic-tac-toe" (current-tab))))
(fn [shown]
(is shown "following the address (Back, Forward, a typed one) shows that page")
(is (some? (q "[role=status]")))))
@@ -431,7 +438,7 @@
(fn []
(is (= "AI setup" (current-tab)) "a page can be opened by its address")
(set! js/location.hash "#/nowhere"))
#(tu/eventually (fn [] (= "Games" (current-tab))))
#(tu/eventually (fn [] (= "Tic-tac-toe" (current-tab))))
(fn [shown]
(is shown "an address that names no page shows the first one")))
done)))
@@ -442,13 +449,13 @@
(steps
#(log-in-page! [])
(fn []
(is (= ["Games" "Todos" "AI setup"] (tab-titles)))
(is (= ["Tic-tac-toe" "Calculator" "Todos" "AI setup"] (tab-titles)))
(is (= "Todos" (current-tab)))
(click! (q "nav a"))
(tu/eventually (fn [] (= "Games" (current-tab)))))
(tu/eventually (fn [] (= "Tic-tac-toe" (current-tab)))))
(fn [_]
(is (nil? (todos-section)) "the todos are on their own page")
(click! (second (q-all "nav a"))))
(click! (nth (q-all "nav a") 2)))
#(tu/eventually (fn [] (todos-section)))
(fn [shown]
(is shown "and back")))
@@ -462,7 +469,7 @@
#(open-page! :todos)
#(tu/eventually (fn [] (some #{"Log in"} (nav-links))))
(fn []
(is (= ["Games" "AI setup"] (tab-titles)))
(is (= ["Tic-tac-toe" "Calculator" "AI setup"] (tab-titles)))
(is (nil? (todos-section)))
(is (= "Todos" (text "section h2")))
(is (= "Log in" (text "section p a")))
@@ -483,6 +490,16 @@
[]
(mapv #(.-textContent %) (q-all "[role=log] > div[data-tool]")))
(defn- tool-toggle-buttons []
(filterv #(re-find #"tool use$" (.-textContent %)) (q-all "[role=dialog] button")))
(defn- tool-toggle [] (first (tool-toggle-buttons)))
(defn- tool-toggle-labels
"The label of the button that expands or collapses the tool use, if the panel has one."
[]
(mapv #(.-textContent %) (tool-toggle-buttons)))
(deftest chat-widget-test
;; A green square in the bottom left corner, opposite WebMCP's blue one; it opens the panel.
(async done
@@ -624,7 +641,8 @@
(resume-stream!))
#(tu/eventually (fn [] (:resume @tu/server)))
(fn [_]
(is (= "Thinking…" (text "[role=status]")) "still thinking while the model reasons")
(is (re-matches #"Thinking(\.{1,3}|…)" (text "[role=status]"))
"still thinking while the model reasons")
(is (not (str/includes? (panel-text) "Let me think.")) "and what it reasons is not shown")
(is (= ["hi"] (chat-messages)) "it hasn't said anything")
(is (true? (.-readOnly (q "input[name=message]"))) "and it isn't over")
@@ -643,6 +661,32 @@
(is (nil? (q "[role=dialog] [role=alert]")))))
done)))
(deftest chat-thinking-animation-test
;; While pieces of the reasoning are coming in "Thinking" has one to three dots; once they stop
;; (for a moment) it is "Thinking…" again.
(async done
(swap! tu/server assoc :chat-script [:pause
{:thinking "Let me "} {:thinking "think."} :pause
{:content "Hi"} {:done true}])
(tu/finish
(tu/steps
#(log-in-page! [])
(fn [] (click! (q "button[aria-label=Chat]")))
#(send-chat! "hi")
#(tu/eventually (fn [] (and (:resume @tu/server) (q "[role=status]"))))
(fn [_]
(is (= "Thinking…" (text "[role=status]")) "not animated before any reasoning came")
(resume-stream!))
#(tu/eventually (fn [] (re-matches #"Thinking\.{1,3}" (text "[role=status]"))))
(fn [frame]
(is (some? frame) "animated while the reasoning is coming in"))
#(tu/eventually (fn [] (= "Thinking…" (text "[role=status]"))))
(fn [_]
(is (= "Thinking…" (text "[role=status]")) "the reasoning stopped coming")
(resume-stream!))
#(tu/eventually (fn [] (nil? (q "[role=status]")))))
done)))
(deftest chat-reasoning-is-never-shown-test
;; Neither while it comes nor in the finished conversation, in any element of the panel.
(async done
@@ -777,15 +821,15 @@
(tu/finish
(-> (tu/steps
#(log-in-page! [])
;; The calculator's tools are offered on the games page.
(fn [] (rf/dispatch-sync [::events/navigate :games]))
;; The calculator's tools are offered on the calculator page.
(fn [] (rf/dispatch-sync [::events/navigate :calculator]))
(fn [] (click! (q "button[aria-label=Chat]")))
#(send-chat! "what is 2 + 3? use the calculator")
#(tu/eventually (fn [] (= ["what is 2 + 3? use the calculator" "I'll add them." "2 + 3 is 5."]
(chat-messages))))
(fn [_]
(testing "the LLM was told about the tools of the page it was on (the games), not all of them"
(is (= (set (map :name (filter #(contains? (or (:pages %) #{:games}) :games) webmcp/tools)))
(testing "the LLM was told about the tools of the page it was on (the calculator), not all of them"
(is (= (set (map :name (filter #(contains? (or (:pages %) #{:calculator}) :calculator) webmcp/tools)))
(set (map :name (:tools (first (:chat-requests @tu/server))))))))
(testing "the page made the call, as a user would: the calculator holds what was typed and its sum"
(is (= {:x "2" :y "3" :result {:status :ok :x "2" :y "3" :sum 5}}
@@ -793,12 +837,13 @@
(testing "the call and its result show in the conversation, between what was said"
(is (= ["Calling add {\"x\":2,\"y\":3}…" "add → {\"x\":2,\"y\":3,\"sum\":5}"]
(chat-tool-lines)))
(testing "the lines are shown whole: wrapped, not cut off"
(testing "each is one line, cut off with an ellipsis where it doesn't fit, until expanded"
(is (= ["Expand tool use"] (tool-toggle-labels)))
(doseq [line (q-all "[data-tool]")]
(is (= "pre-wrap" (.. line -style -whiteSpace)))
(is (= "" (.. line -style -textOverflow)))
(is (not= "hidden" (.. line -style -overflow)))
(is (nil? (.getAttribute line "title")) "no tooltip: there is nothing hidden")))
(is (= "nowrap" (.. line -style -whiteSpace)))
(is (= "ellipsis" (.. line -style -textOverflow)))
(is (= "hidden" (.. line -style -overflow)))
(is (= (.-textContent line) (.getAttribute line "title")) "the whole of it is in the tooltip")))
(is (= ["user" "assistant" "tool" "assistant"] (map :role (:messages (:chat @rf-db/app-db))))))
(testing "the second request took the result to the LLM"
(is (= [{:role "user" :content "what is 2 + 3? use the calculator"}
@@ -807,7 +852,22 @@
{:role "tool" :tool-call-id "call_1" :content "{\"x\":2,\"y\":3,\"sum\":5}"}]
(:messages (second (:chat-requests @tu/server))))))
(testing "and it is over: the panel takes messages again"
(is (false? (.-readOnly (q "input[name=message]")))))))
(is (false? (.-readOnly (q "input[name=message]")))))
(click! (tool-toggle)))
#(tu/eventually (fn [] (= ["Collapse tool use"] (tool-toggle-labels))))
(fn [_]
(testing "expanded, the lines are shown whole: wrapped, not cut off"
(doseq [line (q-all "[data-tool]")]
(is (= "pre-wrap" (.. line -style -whiteSpace)))
(is (= "" (.. line -style -textOverflow)))
(is (not= "hidden" (.. line -style -overflow)))
(is (nil? (.getAttribute line "title")) "no tooltip: there is nothing hidden"))
(is (= ["Calling add {\"x\":2,\"y\":3}…" "add → {\"x\":2,\"y\":3,\"sum\":5}"]
(chat-tool-lines))))
(click! (tool-toggle)))
#(tu/eventually (fn [] (= ["Expand tool use"] (tool-toggle-labels))))
(fn [_]
(is (= "nowrap" (.. (q "[data-tool]") -style -whiteSpace)) "collapsed again")))
(.finally model-context/clear!))
done)))
@@ -823,8 +883,8 @@
(tu/finish
(-> (tu/steps
#(log-in-page! [])
;; The calculator's tools are offered on the games page.
(fn [] (rf/dispatch-sync [::events/navigate :games]))
;; The calculator's tools are offered on the calculator page.
(fn [] (rf/dispatch-sync [::events/navigate :calculator]))
(fn [] (click! (q "button[aria-label=Chat]")))
#(send-chat! "add two and three")
#(tu/eventually (fn [] (= ["add two and three" "Sorry, that didn't work."] (chat-messages))))
ui/test/tbd/ui/webmcp_test.cljs
+238 -38
View File
@@ -1,7 +1,9 @@
(ns tbd.ui.webmcp-test
(:require [cljs.test :refer [deftest is testing async use-fixtures]]
[clojure.string :as str]
[re-frame.core :as rf]
[re-frame.db :as rf-db]
[tbd.agent.prompt :as prompt]
[tbd.ui.events :as events]
[tbd.ui.test-util :as tu]
[tbd.ui.webmcp :as webmcp]))
@@ -12,17 +14,37 @@
"What the page registered with WebMCP: name -> {:description :input-schema :execute}."
(atom {}))
(def ^:private registered-prompts
"What the page registered as prompts: name -> {:description :arguments :execute}."
(atom {}))
(def ^:private registered-resources
"What the page registered as resources: name -> {:description :options :provide}."
(atom {}))
(def ^:private fake-mcp
"A WebMCP instance, as far as the page uses it: registerTool(name, description, schema, execute)."
"A WebMCP instance, as far as the page uses it: registerTool(name, description, schema, execute),
registerPrompt(name, description, arguments, execute) and registerResource(name, description,
options, provide)."
#js {:registerTool (fn [name description input-schema execute]
(swap! registered assoc name {:description description
:input-schema input-schema
:execute execute}))})
:execute execute}))
:registerPrompt (fn [name description arguments execute]
(swap! registered-prompts assoc name {:description description
:arguments arguments
:execute execute}))
:registerResource (fn [name description options provide]
(swap! registered-resources assoc name {:description description
:options options
:provide provide}))})
(use-fixtures :each
tu/url-fixture
{:before (fn []
(reset! registered {})
(reset! registered-prompts {})
(reset! registered-resources {})
((:before tu/fake-server-fixture)))
:after (:after tu/fake-server-fixture)})
@@ -59,7 +81,8 @@
(is (fn? execute) tool-name))
(testing "what the tools need, as the agent sees it"
(is (= ["x" "y"] (vec (.. ^js (:input-schema (get @registered "add")) -required))))
(is (= ["id" "done"] (vec (.. ^js (:input-schema (get @registered "set_todo_done")) -required))))))
(is (= ["todos"] (vec (.. ^js (:input-schema (get @registered "set_todo_done")) -required))))
(is (= ["id" "done"] (vec (.. ^js (:input-schema (get @registered "set_todo_done")) -properties -todos -items -required))))))
(deftest registering-again-replaces-the-tools
(webmcp/register-tools! fake-mcp)
@@ -142,7 +165,7 @@
(.then (fn [r]
(is (:error? r))
(is (re-find #"not logged in" (:text r)))
(call "create_todo" {:title "buy milk"})))
(call "create_todo" {:todos [{:title "buy milk"}]})))
(.then (fn [r]
(is (:error? r))
(is (empty? (:todos @tu/server)) "nothing was sent")
@@ -154,7 +177,7 @@
(deftest tools-open-the-page-they-act-on
(tu/log-in!)
(swap! tu/server assoc :todos [{:id 1 :owner-id 7 :title "old" :done false :created-at 1 :updated-at 1}]
(swap! tu/server assoc :todos [{:id (tu/todo-uuid 1) :owner-id 7 :title "old" :done false :created-at 1 :updated-at 1}]
:next-id 2)
(open-page!)
(async done
@@ -166,31 +189,104 @@
(is (= :ai-setup (page)) "reading changes nothing")
(call "move_tic_tac_toe" {:cell 4 :player "x"})))
(.then (fn [_]
(is (= :games (page)))
(is (= :tic-tac-toe (page)))
(rf/dispatch-sync [::events/navigate :ai-setup])
(call "new_tic_tac_toe_game" {})))
(.then (fn [_]
(is (= :games (page)))
(is (= :tic-tac-toe (page)))
(rf/dispatch-sync [::events/navigate :ai-setup])
(call "add" {:x 1 :y 2})))
(.then (fn [_]
(is (= :games (page)) "the calculator is on the games page")
(is (= :calculator (page)) "the calculator is on its own page")
(call "list_todos" {})))
(.then (fn [_]
(is (= :games (page)))
(call "create_todo" {:title "buy milk"})))
(is (= :calculator (page)))
(call "create_todo" {:todos [{:title "buy milk"}]})))
(.then (fn [_]
(is (= :todos (page)))
(rf/dispatch-sync [::events/navigate :games])
(call "set_todo_done" {:id 1 :done true})))
(rf/dispatch-sync [::events/navigate :tic-tac-toe])
(call "set_todo_done" {:todos [{:id (tu/todo-uuid 1) :done true}]})))
(.then (fn [_]
(is (= :todos (page)))
(rf/dispatch-sync [::events/navigate :games])
(call "delete_todo" {:id 1})))
(rf/dispatch-sync [::events/navigate :tic-tac-toe])
(call "delete_todo" {:todos [{:id (tu/todo-uuid 1)}]})))
(.then (fn [_]
(is (= :todos (page)))
(done))))))
(deftest set-todo-done-in-bulk
(tu/log-in!)
(swap! tu/server assoc :todos (mapv #(hash-map :id (tu/todo-uuid %) :owner-id 7 :title (str "todo-" %)
:done true :created-at 1 :updated-at 1)
(range 1 4))
:next-id 4)
(open-page!)
(async done
(-> (call "whoami" {})
(.then (fn [_] (call "set_todo_done" {:todos (mapv #(hash-map :id (tu/todo-uuid %) :done false) (range 1 4))})))
(.then (fn [r]
(is (false? (:error? r)))
(is (= ["todo-1" "todo-2" "todo-3"] (map :title (json (:text r)))))
(is (= [false false false] (map :done (json (:text r)))))
(is (= [false false false] (map :done (get-in @rf-db/app-db [:todos :items]))))
(is (= :todos (page)))
;; A bad entry, or an unknown todo, refuses the whole batch before anything changes.
(call "set_todo_done" {:todos [{:id (tu/todo-uuid 1) :done true} {:id (tu/todo-uuid 99) :done true}]})))
(.then (fn [r]
(is (= {:text (str "todo not found: " (tu/todo-uuid 99)) :error? true} r))
(is (= [false false false] (map :done (get-in @rf-db/app-db [:todos :items]))))
(call "set_todo_done" {:todos [{:id (tu/todo-uuid 1) :done true} {:id (tu/todo-uuid 2) :done "yes"}]})))
(.then (fn [r]
(is (:error? r))
(is (= [false false false] (map :done (get-in @rf-db/app-db [:todos :items]))))
(call "set_todo_done" {:todos []})))
(.then (fn [r]
(is (:error? r) "an empty list is refused")
(call "set_todo_done" {:id (tu/todo-uuid 1) :done true})))
(.then (fn [r]
(is (:error? r) "the old one-todo arguments are refused")
(done))))))
(deftest create-get-and-delete-todos-in-bulk
(tu/log-in!)
(open-page!)
(async done
(-> (call "whoami" {})
(.then (fn [_] (call "create_todo" {:todos [{:title "milk"} {:title "eggs"} {:title "bread"}]})))
(.then (fn [r]
(is (false? (:error? r)))
(is (= ["milk" "eggs" "bread"] (map :title (json (:text r)))) "in the order given")
(is (= ["milk" "eggs" "bread"] (map :title (get-in @rf-db/app-db [:todos :items]))))
(is (= :todos (page)))
(call "get_todo" {:todos [{:id (tu/todo-uuid 3)} {:id (tu/todo-uuid 1)}]})))
(.then (fn [r]
(is (= ["bread" "milk"] (map :title (json (:text r)))))
;; A blank title refuses the batch before the first todo is added.
(call "create_todo" {:todos [{:title "jam"} {:title ""}]})))
(.then (fn [r]
(is (:error? r))
(is (= 3 (count (:todos @tu/server))) "nothing was sent")
(call "delete_todo" {:todos [{:id (tu/todo-uuid 1)} {:id (tu/todo-uuid 99)}]})))
(.then (fn [r]
(is (= {:text (str "todo not found: " (tu/todo-uuid 99)) :error? true} r))
(is (= 3 (count (get-in @rf-db/app-db [:todos :items]))) "an unknown id deletes nothing")
(call "delete_todo" {:todos [{:id (tu/todo-uuid 1)} {:id (tu/todo-uuid 1)} {:id (tu/todo-uuid 2)}]})))
(.then (fn [r]
(is (false? (:error? r)))
(is (= {:deleted [(tu/todo-uuid 1) (tu/todo-uuid 2)]} (json (:text r))) "a repeated id is deleted once")
(is (= ["bread"] (map :title (get-in @rf-db/app-db [:todos :items]))))
(is (= ["bread"] (map :title (:todos @tu/server))))
;; The server refuses a blank title, which the page only sees after the first was added.
(call "create_todo" {:todos [{:title "jam"} {:title " "} {:title "tea"}]})))
(.then (fn [r]
(is (:error? r))
(is (re-find #"\(the first 1 of 3 were done\)$" (:text r)))
(is (= ["bread" "jam"] (map :title (get-in @rf-db/app-db [:todos :items]))))
(call "delete_todo" {:id (tu/todo-uuid 3)})))
(.then (fn [r]
(is (:error? r) "the one-todo arguments are refused")
(done))))))
(deftest navigate
(open-page!)
(async done
@@ -200,14 +296,14 @@
(is (= {:text "{\"page\":\"ai-setup\",\"title\":\"AI setup\"}" :error? false} r))
(is (= :ai-setup (page)) "the page is shown, as after a click on its tab")
(is (= "#/ai-setup" js/location.hash) "and the URL follows")
(call "navigate" {:page "games"})))
(call "navigate" {:page "tic-tac-toe"})))
(.then (fn [r]
(is (false? (:error? r)))
(is (= :games (page)))
(is (= :tic-tac-toe (page)))
(call "navigate" {:page "nowhere"})))
(.then (fn [r]
(is (:error? r))
(is (re-find #"page must be one of games, todos, ai-setup" (:text r)))
(is (re-find #"page must be one of tic-tac-toe, calculator, todos, ai-setup" (:text r)))
(call "navigate" {:page "ai-setup"})))
(.then (fn [_]
(call "navigate" {:page 5})))
@@ -227,7 +323,7 @@
(.then (fn [r]
(is (:error? r) "the tab isn't there for someone who is not logged in")
(is (re-find #"not logged in" (:text r)))
(is (= :games (page)))
(is (= :tic-tac-toe (page)))
(done))))))
(deftest navigate-to-the-todos-when-logged-in
@@ -245,15 +341,15 @@
(open-page!)
(async done
(-> (page-loaded)
(.then (fn [_] (call "create_todo" {:title "buy milk"})))
(.then (fn [_] (call "create_todo" {:todos [{:title "buy milk"}]})))
(.then (fn [r]
(is (:error? r) "not logged in")
(is (= :games (page)) "so there is no todos page to go to")
(is (= :tic-tac-toe (page)) "so there is no todos page to go to")
(done))))))
(deftest todos
(tu/log-in!)
(swap! tu/server assoc :todos [{:id 1 :owner-id 7 :title "old" :done false :created-at 1 :updated-at 1}]
(swap! tu/server assoc :todos [{:id (tu/todo-uuid 1) :owner-id 7 :title "old" :done false :created-at 1 :updated-at 1}]
:next-id 2)
(open-page!)
(async done
@@ -263,39 +359,40 @@
(call "list_todos" {})))
(.then (fn [r]
(is (= ["old"] (map :title (json (:text r)))))
(call "get_todo" {:id 1})))
(call "get_todo" {:todos [{:id (tu/todo-uuid 1)}]})))
(.then (fn [r]
(is (= "old" (:title (json (:text r)))))
(call "get_todo" {:id 99})))
(is (= ["old"] (map :title (json (:text r)))))
(call "get_todo" {:todos [{:id (tu/todo-uuid 99)}]})))
(.then (fn [r]
(is (= {:text "todo not found" :error? true} r))
(call "create_todo" {:title "buy milk"})))
(is (= {:text (str "todo not found: " (tu/todo-uuid 99)) :error? true} r))
(call "create_todo" {:todos [{:title "buy milk"}]})))
(.then (fn [r]
(is (false? (:error? r)))
(is (= {:id 2 :title "buy milk" :done false} (select-keys (json (:text r)) [:id :title :done])))
(is (= [{:id (tu/todo-uuid 2) :title "buy milk" :done false}]
(map #(select-keys % [:id :title :done]) (json (:text r)))))
;; The page shows it, and the field is empty again.
(is (= ["old" "buy milk"] (map :title (get-in @rf-db/app-db [:todos :items]))))
(is (= "" (get-in @rf-db/app-db [:todos :new-title])))
(call "set_todo_done" {:id 2 :done true})))
(call "set_todo_done" {:todos [{:id (tu/todo-uuid 2) :done true}]})))
(.then (fn [r]
(is (true? (:done (json (:text r)))))
(is (= [true] (map :done (json (:text r)))))
(is (true? (:done (last (get-in @rf-db/app-db [:todos :items])))))
;; Already ticked: nothing to do, and no request.
(swap! tu/server assoc :todos [])
(call "set_todo_done" {:id 2 :done true})))
(call "set_todo_done" {:todos [{:id (tu/todo-uuid 2) :done true}]})))
(.then (fn [r]
(is (true? (:done (json (:text r)))))
(call "set_todo_done" {:id 2 :done "yes"})))
(is (= [true] (map :done (json (:text r)))))
(call "set_todo_done" {:todos [{:id (tu/todo-uuid 2) :done "yes"}]})))
(.then (fn [r]
(is (:error? r))
(call "delete_todo" {:id 1})))
(call "delete_todo" {:todos [{:id (tu/todo-uuid 1)}]})))
(.then (fn [r]
(is (= {:text "deleted" :error? false} r))
(is (= {:text (str "{\"deleted\":[\"" (tu/todo-uuid 1) "\"]}") :error? false} r))
(is (= ["buy milk"] (map :title (get-in @rf-db/app-db [:todos :items]))))
(call "delete_todo" {:id 1})))
(call "delete_todo" {:todos [{:id (tu/todo-uuid 1)}]})))
(.then (fn [r]
(is (= {:text "todo not found" :error? true} r))
(call "get_todo" {:id 1.5})))
(is (= {:text (str "todo not found: " (tu/todo-uuid 1)) :error? true} r))
(call "get_todo" {:todos [{:id 42}]})))
(.then (fn [r]
(is (:error? r))
(done))))))
@@ -304,7 +401,7 @@
(tu/log-in!)
(open-page!)
(async done
(-> (call "create_todo" {:title " "})
(-> (call "create_todo" {:todos [{:title " "}]})
(.then (fn [r]
(is (:error? r))
(is (re-find #"Invalid body" (:text r)))
@@ -367,3 +464,106 @@
(.then (fn [r]
(is (= {:board (vec (repeat 9 nil)) :status "in_progress" :turn "x"} (json (:text r))))
(done))))))
;; --- Prompts and resources ---
(defn- prompt-text
"What the prompt `prompt-name` gives, on `args` (a map, or nil for none), as a client gets it:
{:description :role :type :text} of its one message."
[prompt-name args]
(let [^js result ((:execute (get @registered-prompts prompt-name)) (when args (clj->js args)))
^js message (.. result -messages (at 0))]
{:description (.-description result)
:role (.-role message)
:type (.. message -content -type)
:text (.. message -content -text)}))
(defn- resource-contents
"A promise of what the resource `resource-name` gives for `uri`, as {:uri :mime-type :text} of
its one piece of content."
[resource-name uri]
(-> ((:provide (get @registered-resources resource-name)) uri)
(.then (fn [^js result]
(let [^js content (.. result -contents (at 0))]
{:uri (.-uri content) :mime-type (.-mimeType content) :text (.-text content)})))))
(deftest registers-the-prompts
(is (identical? fake-mcp (webmcp/register-prompts! fake-mcp)))
(is (= (set (map :name webmcp/prompts)) (set (keys @registered-prompts))))
(doseq [[prompt-name {:keys [description arguments execute]}] @registered-prompts]
(is (and (string? description) (seq description)) prompt-name)
(is (fn? execute) prompt-name)
(doseq [^js argument arguments]
(is (and (string? (.-name argument)) (string? (.-description argument))) prompt-name)
(is (false? (.-required argument)) "an agent can start any of them with no arguments")))
(webmcp/register-prompts! fake-mcp)
(is (= (count webmcp/prompts) (count @registered-prompts)) "registering again replaces them"))
(deftest drive-the-app-prompt-is-the-shared-instructions
(webmcp/register-prompts! fake-mcp)
(let [{:keys [role type text description]} (prompt-text "drive_the_app" {:task "add a todo to buy milk"})]
(is (= "user" role))
(is (= "text" type))
(is (seq description))
(testing "it is the guide the chatbot's prompt is written alongside, then the request"
(is (str/starts-with? text prompt/guide))
(is (str/ends-with? text "The user's request: add a todo to buy milk"))
(is (re-find #"Act, don't offer" text))))
(testing "without a task it has the agent ask what is wanted; a client may send no arguments at all"
(doseq [args [nil {} {:task ""}]]
(is (re-find #"Ask the user what they want" (:text (prompt-text "drive_the_app" args)))))))
(deftest every-tool-the-prompts-name-exists
(let [tool-names (set (map :name webmcp/tools))]
(doseq [text [prompt/guide (prompt/tic-tac-toe "o") (prompt/task nil)]
tool-name (re-seq #"\b(?:get|move|new|list|set|create|delete)_[a-z_]+|\badd\{" text)]
(is (contains? tool-names (str/replace tool-name "{" "")) (str tool-name)))))
(deftest tic-tac-toe-prompt
(webmcp/register-prompts! fake-mcp)
(testing "the side is the one asked for, and O by default"
(is (re-find #"as X\." (:text (prompt-text "play_tic_tac_toe" {:side "x"}))))
(is (re-find #"as O\." (:text (prompt-text "play_tic_tac_toe" {:side "o"}))))
(is (re-find #"as O\." (:text (prompt-text "play_tic_tac_toe" nil))))
(is (re-find #"as O\." (:text (prompt-text "play_tic_tac_toe" {:side "z"})))))
(testing "it says to move on the agent's own turn only"
(is (re-find #"never move for the other side" (:text (prompt-text "play_tic_tac_toe" nil))))))
(deftest registers-the-resources
(is (identical? fake-mcp (webmcp/register-resources! fake-mcp)))
(is (= (set (map :name webmcp/resources)) (set (keys @registered-resources))))
(doseq [[resource-name {:keys [description options provide]}] @registered-resources]
(is (and (string? description) (seq description)) resource-name)
(is (str/starts-with? (.-uri ^js options) "webmcp://app/") resource-name)
(is (string? (.-mimeType ^js options)) resource-name)
(is (fn? provide) resource-name))
(is (= (count webmcp/resources)
(count (set (map #(.-uri ^js (:options %)) (vals @registered-resources)))))
"each has an address of its own"))
(deftest the-guide-resource
(webmcp/register-resources! fake-mcp)
(async done
(-> (resource-contents "app_guide" "webmcp://app/guide")
(.then (fn [contents]
(is (= {:uri "webmcp://app/guide" :mime-type "text/markdown" :text prompt/guide} contents))
(done))))))
(deftest the-state-resource
(open-page!)
(webmcp/register-resources! fake-mcp)
(async done
(-> (resource-contents "app_state" "webmcp://app/state")
(.then (fn [{:keys [uri mime-type text]}]
(is (= "webmcp://app/state" uri))
(is (= "application/json" mime-type))
(let [state (json text)]
(is (= "tic-tac-toe" (:page state)) "the page the app opens on")
(is (= ["tic-tac-toe" "calculator" "todos" "ai-setup"] (map :id (:pages state))))
(is (= [false false true false] (map #(boolean (:needs-login %)) (:pages state))))
(is (= {:logged-in false} (:user state)) "the fake server has no one logged in"))
(call "navigate" {:page "calculator"})))
(.then (fn [_] (resource-contents "app_state" "webmcp://app/state")))
(.then (fn [{:keys [text]}]
(is (= "calculator" (:page (json text))) "it follows the page that is open")
(done))))))