From 10f4ca654bd2cb0d27373ea5cbb727a8d8dd3e4d Mon Sep 17 00:00:00 2001 From: ajet Date: Mon, 21 Sep 2026 06:20:30 -0900 Subject: [PATCH] set up pages in UI --- README.md | 18 ++-- ui/src/tbd/ui/db.cljs | 6 +- ui/src/tbd/ui/events.cljs | 49 ++++++++++- ui/src/tbd/ui/pages.cljs | 27 ++++++ ui/src/tbd/ui/subs.cljs | 1 + ui/src/tbd/ui/views.cljs | 79 +++++++++++------- ui/src/tbd/ui/webmcp.cljs | 12 +++ ui/test/tbd/ui/core_test.cljs | 3 +- ui/test/tbd/ui/events_test.cljs | 23 +++++ ui/test/tbd/ui/pages_test.cljs | 26 ++++++ ui/test/tbd/ui/subs_test.cljs | 3 + ui/test/tbd/ui/test_util.cljs | 6 ++ ui/test/tbd/ui/views_test.cljs | 144 +++++++++++++++++++++++++------- ui/test/tbd/ui/webmcp_test.cljs | 54 ++++++++++++ 14 files changed, 382 insertions(+), 69 deletions(-) create mode 100644 ui/src/tbd/ui/pages.cljs create mode 100644 ui/test/tbd/ui/pages_test.cljs diff --git a/README.md b/README.md index 8383111..2333503 100644 --- a/README.md +++ b/README.md @@ -209,12 +209,16 @@ restarts), so switch it off when you're done. `ui/` is a [re-frame](https://github.com/day8/re-frame) app (ClojureScript, React 19 via [Reagent](https://reagent-project.github.io/)) built with [shadow-cljs](https://github.com/thheller/shadow-cljs). -It's a small calculator form that calls `GET /api/add` and shows the sum (or the server's -validation error). Below it, once you're logged in, is a todo list (add, tick off, delete) backed by -`/api/todos`; it stays hidden when you're not. At the bottom is a section with the -`claude mcp add ...` command to copy (with this page's own address in it) and the steps to sign in, for -adding the [MCP server](#mcp-server) to Claude Code. A "Log in" / "Log out" link sits in the footer row -next to the API docs links. +It has three pages, as tabs across the top. Each has its own address in the URL's fragment (`/#/games`, +`/#/todos`, `/#/ai-setup`), so the server only ever serves `/`, and a page can be bookmarked or reloaded. + +| Tab | What's on it | +|-----|--------------| +| Games | Tic-tac-toe (two players on one board, all client side), and a small calculator form that calls `GET /api/add` and shows the sum (or the server's validation error) | +| Todos | Your todo list (add, tick off, delete), backed by `/api/todos`. The tab only shows once you're logged in; its address shows a "Log in" prompt otherwise | +| AI setup | The `claude mcp add ...` command to copy (with this page's own address in it) and the steps to sign in, for adding the [MCP server](#mcp-server) to Claude Code; and how to connect an MCP client to the page's own [browser tools](#browser-mcp-tools-webmcp) | + +A "Log in" / "Log out" link sits in the footer row next to the API docs links. shadow-cljs compiles it into `resources/public/js/` (git-ignored). The server serves that directory at `/js`, and serves `resources/public/index.html`, the shell that mounts the app, at `/`. @@ -232,7 +236,7 @@ in another stage of the same Dockerfile (`--target ui-test`), which the server i The page also offers tools of its own to your MCP client (Claude), through [WebMCP](https://webmcp.dev): a small library that adds a widget to the page and lets the page register tools with it. They are the browser-side twin of the [server's MCP tools](#mcp-server): those work on your data on the server, these work *the page*, doing -what you could do with the mouse and keyboard, so you see it happen. They are in `ui/src/tbd/ui/webmcp.cljs`, +what you could do with the mouse and keyboard, so you see it happen. A tool that changes something opens the tab it acts on first (the todo tools open Todos, the game and calculator tools open Games). They are in `ui/src/tbd/ui/webmcp.cljs`, registered with `registerTool` on a `WebMCP` instance (the `@jason.today/webmcp` npm package): | Tool | What it does | diff --git a/ui/src/tbd/ui/db.cljs b/ui/src/tbd/ui/db.cljs index 62f55c4..add6061 100644 --- a/ui/src/tbd/ui/db.cljs +++ b/ui/src/tbd/ui/db.cljs @@ -2,7 +2,9 @@ (:require [tbd.ui.tictactoe :as tictactoe])) (def default-db - {:calc {:x "" :y "" + {;; The page being shown (see tbd.ui.pages); it follows the URL's fragment. + :page :games + :calc {:x "" :y "" ;; {:status :idle} ;; {:status :loading} ;; {:status :ok :x "2" :y "3" :sum 5} @@ -19,7 +21,7 @@ :items [] :new-title "" :error nil} - ;; The "Add this MCP server to Claude Code" section: :copied? is true right after the + ;; The "Add this MCP server to Claude Code" page: :copied? is true right after the ;; command was copied to the clipboard. :mcp {:copied? false} ;; Tic-tac-toe, entirely client side: the board (see tbd.ui.tictactoe) and whose turn it is. diff --git a/ui/src/tbd/ui/events.cljs b/ui/src/tbd/ui/events.cljs index 3d618af..ee0ac3d 100644 --- a/ui/src/tbd/ui/events.cljs +++ b/ui/src/tbd/ui/events.cljs @@ -3,6 +3,7 @@ [clojure.string :as str] [re-frame.core :as rf] [tbd.ui.db :as db] + [tbd.ui.pages :as pages] [tbd.ui.tictactoe :as tictactoe])) ;; Effect: request `uri` (GET unless `method` is given), then dispatch @@ -21,12 +22,54 @@ :body %}))))) (.catch #(rf/dispatch (conj on-response {:ok? false :status nil :body (.-message %)})))))) +;; Coeffect: the URL's fragment, which says which page to start on. +(rf/reg-cofx + ::hash + (fn [cofx _] + (assoc cofx :hash js/location.hash))) + +;; 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)) + +(rf/reg-fx + ::listen-for-hash + (fn [_] + (when-let [old @hash-listener] + (.removeEventListener js/window "hashchange" old)) + (reset! hash-listener #(rf/dispatch [::hash-changed js/location.hash])) + (.addEventListener js/window "hashchange" @hash-listener))) + +;; Effect: put `hash` in the URL, which is how a page gets its own address (and a Back button). +(rf/reg-fx + ::set-hash + (fn [hash] + (set! js/location.hash hash))) + (rf/reg-event-fx ::initialize - (fn [_ _] - {:db db/default-db + [(rf/inject-cofx ::hash)] + (fn [{:keys [hash]} _] + {:db (assoc db/default-db :page (pages/hash->page hash)) + ::listen-for-hash true :dispatch [::load-user]})) +;; --- Pages --- + +;; The URL changed (a link was followed, or Back was pressed): show the page it names. +(rf/reg-event-db + ::hash-changed + (fn [db [_ hash]] + (assoc db :page (pages/hash->page hash)))) + +;; Go to a page without a link, as the browser tools do. The page changes right away; the URL +;; follows, and its change event finds the page already shown. +(rf/reg-event-fx + ::navigate + (fn [{:keys [db]} [_ page]] + {:db (assoc db :page page) + ::set-hash (pages/page->hash page)})) + (rf/reg-event-db ::set-operand (fn [db [_ k value]] @@ -169,7 +212,7 @@ {:db (update-in db [:todos :items] (fn [items] (filterv #(not= id (:id %)) items)))} {:dispatch [::todo-failed resp]}))) -;; --- MCP setup section --- +;; --- MCP setup page --- ;; Effect: put `text` on the clipboard. The Clipboard API only exists on secure origins (https ;; or localhost), so the view doesn't offer the button without it; failures are ignored. diff --git a/ui/src/tbd/ui/pages.cljs b/ui/src/tbd/ui/pages.cljs new file mode 100644 index 0000000..542dce0 --- /dev/null +++ b/ui/src/tbd/ui/pages.cljs @@ -0,0 +1,27 @@ +(ns tbd.ui.pages + "The pages of the app, and how they map to the URL. The server only serves the shell at `/`, + so a page lives in the fragment (`/#/todos`): following a link between pages never asks the + server for anything, and a page can still be bookmarked or reloaded.") + +(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 :todos :title "Todos" :login? true} + {:id :ai-setup :title "AI setup"}]) + +(def default-page (:id (first pages))) + +(def ^:private ids (into #{} (map :id) pages)) + +(defn page->hash + "The fragment that opens `page`: \"#/todos\"." + [page] + (str "#/" (name page))) + +(defn hash->page + "The page a fragment (with or without its leading #) opens; the default page when it is empty + or names no page." + [hash] + (let [id (keyword (second (re-find #"^#?/?([^/?]*)" (or hash ""))))] + (if (contains? ids id) id default-page))) diff --git a/ui/src/tbd/ui/subs.cljs b/ui/src/tbd/ui/subs.cljs index 66b338d..5b9c054 100644 --- a/ui/src/tbd/ui/subs.cljs +++ b/ui/src/tbd/ui/subs.cljs @@ -2,6 +2,7 @@ (:require [re-frame.core :as rf] [tbd.ui.tictactoe :as tictactoe])) +(rf/reg-sub ::page (fn [db _] (:page db))) (rf/reg-sub ::operand (fn [db [_ k]] (get-in db [:calc k]))) (rf/reg-sub ::result (fn [db _] (get-in db [:calc :result]))) (rf/reg-sub ::user (fn [db _] (:user db))) diff --git a/ui/src/tbd/ui/views.cljs b/ui/src/tbd/ui/views.cljs index 60bff8c..16df7c6 100644 --- a/ui/src/tbd/ui/views.cljs +++ b/ui/src/tbd/ui/views.cljs @@ -2,6 +2,7 @@ (:require [clojure.string :as str] [re-frame.core :as rf] [tbd.ui.events :as events] + [tbd.ui.pages :as pages] [tbd.ui.subs :as subs] [tbd.ui.webmcp :as webmcp])) @@ -23,15 +24,17 @@ "Sends GET /api/add?x=..&y=.. on submit and shows the sum the server returns." [] (let [result @(rf/subscribe [::subs/result])] - [:form {:on-submit (fn [e] - (.preventDefault e) - (rf/dispatch [::events/add]))} - [:div {:style {:display "flex" :gap "1rem" :align-items "center"}} - [operand-input :x "x"] - "+" - [operand-input :y "y"] - [:button {:type "submit" :disabled (= :loading (:status result))} "Add"]] - [result-line result]])) + [:section + [:h2 "Calculator"] + [:form {:on-submit (fn [e] + (.preventDefault e) + (rf/dispatch [::events/add]))} + [:div {:style {:display "flex" :gap "1rem" :align-items "center"}} + [operand-input :x "x"] + "+" + [operand-input :y "y"] + [:button {:type "submit" :disabled (= :loading (:status result))} "Add"]] + [result-line result]]])) (defn- todo-item [{:keys [id title done]}] [:li {:style {:display "flex" :gap "0.5rem" :align-items "center" :margin "0.25rem 0"}} @@ -52,7 +55,7 @@ ^{:key (:id todo)} [todo-item todo])])) (defn todos - "Your todos (GET/POST /api/todos, PATCH/DELETE /api/todos/:id). Only shown when logged in." + "Your todos (GET/POST /api/todos, PATCH/DELETE /api/todos/:id)." [] (let [{:keys [new-title error] :as state} @(rf/subscribe [::subs/todos])] [:section @@ -105,20 +108,13 @@ [] (str "claude mcp add --transport http tbd " js/location.origin "/mcp")) -(defn- collapsible - "A section the reader can fold away by its heading (a native
, closed to start with)." - [title & body] - (into [:details {:style {:margin-top "2rem"}} - [:summary {:style {:cursor "pointer"}} - [:h2 {:style {:display "inline"}} title]]] - body)) - (defn mcp-setup "How to add this server to Claude Code: a command to copy, then signing in once." [] (let [command (mcp-command) copied? @(rf/subscribe [::subs/mcp-copied?])] - [collapsible "Add this MCP server to Claude Code" + [:section + [:h2 "Add this MCP server to Claude Code"] [:p "Run this in your terminal:"] [:div {:style {:display "flex" :gap "0.5rem" :align-items "flex-start"}} [:pre {:style {:flex 1 :margin 0 :padding "0.75rem" :overflow-x "auto" @@ -139,7 +135,8 @@ "The page's own tools for a browser agent (WebMCP, see tbd.ui.webmcp): how to connect an MCP client to them. The token is pasted into the WebMCP widget in the corner of the page." [] - [collapsible "Browser tools (WebMCP)" + [:section + [:h2 "Browser tools (WebMCP)"] [:p "This page offers " [:strong (count webmcp/tools)] " tools of its own (the calculator, the todos and the tic-tac-toe game) to " "your MCP client, over " [:a {:href "https://webmcp.dev" :target "_blank" :rel "noreferrer"} "WebMCP"] ", and you see them work on the page. To connect:"] @@ -168,16 +165,42 @@ "Log out"] nil)) +(defn- login-prompt + "What the todos page says to someone who isn't logged in (nothing while we don't know yet)." + [{:keys [status message]}] + (case status + :anonymous [:section + [:h2 "Todos"] + [:p [:a {:href "/auth/login"} "Log in"] " to see your todos."]] + :error [:p {:role "alert" :style {:color "crimson"}} message] + nil)) + +(defn- current-page [page user] + (case page + :games [:<> [tic-tac-toe] [calculator]] + :todos (if (= :logged-in (:status user)) [todos] [login-prompt user]) + :ai-setup [:<> [mcp-setup] [browser-tools]])) + +(defn- tabs + "One link per page, the current one marked. The todos are only offered when logged in." + [current user] + [:nav {:aria-label "Pages" :style {:display "flex" :flex-wrap "wrap" :gap "1rem" + :border-bottom "1px solid GrayText" :padding-bottom "0.5rem"}} + (for [{:keys [id title login?]} pages/pages + :when (or (not login?) (= :logged-in (:status user)))] + ^{:key id} + [:a (cond-> {:href (pages/page->hash id)} + (= id current) (assoc :aria-current "page" :style {:font-weight "bold"})) + title])]) + (defn app [] - (let [user @(rf/subscribe [::subs/user])] + (let [page @(rf/subscribe [::subs/page]) + user @(rf/subscribe [::subs/user])] [:main {:style {:font-family "system-ui, sans-serif" :max-width "40rem" :margin "2rem auto"}} [:h1 "tbd"] - [calculator] - (when (= :logged-in (:status user)) - [todos]) - [tic-tac-toe] - [mcp-setup] - [browser-tools] - [:p [:a {:href "/api-docs"} "API docs"] " · " [:a {:href "/swagger.json"} "swagger.json"] + [tabs page user] + [current-page page user] + [:p {:style {:margin-top "2rem"}} + [:a {:href "/api-docs"} "API docs"] " · " [:a {:href "/swagger.json"} "swagger.json"] (when-let [link (auth-link user)] [:<> " · " link])]])) diff --git a/ui/src/tbd/ui/webmcp.cljs b/ui/src/tbd/ui/webmcp.cljs index 0be9aa1..ac425b8 100644 --- a/ui/src/tbd/ui/webmcp.cljs +++ b/ui/src/tbd/ui/webmcp.cljs @@ -26,6 +26,12 @@ (defn- fail! [message] (throw (js/Error. message))) +(defn- show! + "Opens `page` (see tbd.ui.pages), the way a user would click its tab, so a tool that acts on + the page does it where it can be seen." + [page] + (rf/dispatch-sync [::events/navigate page])) + (defn- settled "A promise of the app-db as soon as `(pred db)` holds (right away if it already does), or a rejection after `timeout-ms`. Requests made by events finish some time after the event is @@ -117,6 +123,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) (rf/dispatch-sync [::events/set-operand :x (str x)]) (rf/dispatch-sync [::events/set-operand :y (str y)]) (rf/dispatch-sync [::events/add]) @@ -142,6 +149,7 @@ (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"))) @@ -156,6 +164,7 @@ (-> (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] @@ -170,6 +179,7 @@ (-> (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"))) @@ -208,12 +218,14 @@ (fail! (str "it is " (name turn) "'s turn, not " player "'s"))) (when (board cell) (fail! (str "cell " cell " is taken"))) + (show! :games) (rf/dispatch-sync [::events/ttt-move cell]) (tic-tac-toe-state))) (defn- new-tic-tac-toe-game "Presses New game." [_] + (show! :games) (rf/dispatch-sync [::events/ttt-reset]) (tic-tac-toe-state)) diff --git a/ui/test/tbd/ui/core_test.cljs b/ui/test/tbd/ui/core_test.cljs index 329137e..f444c19 100644 --- a/ui/test/tbd/ui/core_test.cljs +++ b/ui/test/tbd/ui/core_test.cljs @@ -21,6 +21,7 @@ (use-fixtures :each tu/fake-server-fixture + tu/url-fixture {:before (fn [] (reset! @#'webmcp/widget nil) ;; The widget logs every tool it registers. (Not console.log as a whole: that is @@ -57,7 +58,7 @@ (-> (ping #js {}) (.then (fn [result] (is (= "pong" (.. result -content (at 0) -text)))))))) (fn [] - (tu/shows "it found out who is logged in, and shows the todos" "section h2" "Todos")) + (tu/eventually (fn [] (some #(= "Todos" (.-textContent %)) (tu/q-all "nav a"))))) (fn [] (is (= :logged-in (get-in @rf-db/app-db [:user :status]))) ;; The hot-reload hook redraws and registers the tools again, without starting over. diff --git a/ui/test/tbd/ui/events_test.cljs b/ui/test/tbd/ui/events_test.cljs index 0c0082a..6dae6b6 100644 --- a/ui/test/tbd/ui/events_test.cljs +++ b/ui/test/tbd/ui/events_test.cljs @@ -18,6 +18,7 @@ (fn [value] (swap! effects conj [id value]))) (use-fixtures :each + tu/url-fixture {:before (fn [] (reset! effects []) (reset! queued []))} (tu/stub-effects-fixture {::events/fetch (record ::events/fetch) ::events/copy-to-clipboard (record ::events/copy-to-clipboard) @@ -75,6 +76,28 @@ (testing "it asks who is logged in" (is (= [{:uri "/auth/me" :on-response [::events/user-response]}] (requests))))) +;; --- Pages --- + +(deftest initialize-opens-the-page-in-the-url-test + (set! js/location.hash "#/ai-setup") + (dispatch! [::events/initialize]) + (is (= :ai-setup (:page (app-db))))) + +(deftest hash-changed-test + (start!) + (reset! effects []) + (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 (= [] (requests)) "changing the page asks the server for nothing")) + +(deftest navigate-test + (start!) + (dispatch! [::events/navigate :ai-setup]) + (is (= :ai-setup (:page (app-db))) "the page changes at once") + (is (= "#/ai-setup" js/location.hash) "and gets its address")) + ;; --- Calculator --- (deftest set-operand-test diff --git a/ui/test/tbd/ui/pages_test.cljs b/ui/test/tbd/ui/pages_test.cljs new file mode 100644 index 0000000..75f2c60 --- /dev/null +++ b/ui/test/tbd/ui/pages_test.cljs @@ -0,0 +1,26 @@ +(ns tbd.ui.pages-test + (:require [cljs.test :refer [deftest is testing]] + [tbd.ui.pages :as pages])) + +(deftest page->hash-test + (is (= "#/games" (pages/page->hash :games))) + (is (= "#/ai-setup" (pages/page->hash :ai-setup)))) + +(deftest hash->page-test + (testing "every page has an address that opens it" + (doseq [{:keys [id]} pages/pages] + (is (= id (pages/hash->page (pages/page->hash id)))))) + (testing "with or without the #" + (is (= :todos (pages/hash->page "#/todos"))) + (is (= :todos (pages/hash->page "/todos"))) + (is (= :todos (pages/hash->page "todos")))) + (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)) + (doseq [hash [nil "" "#" "#/" "#/nowhere" "#/Todos"]] + (is (= :games (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 (= [:todos] (mapv :id (filter :login? pages/pages))))) diff --git a/ui/test/tbd/ui/subs_test.cljs b/ui/test/tbd/ui/subs_test.cljs index 1d5141e..3392679 100644 --- a/ui/test/tbd/ui/subs_test.cljs +++ b/ui/test/tbd/ui/subs_test.cljs @@ -23,16 +23,19 @@ (deftest plain-subs-test (testing "a new page" (is (= "" (sub [::subs/operand :x]))) + (is (= :games (sub [::subs/page]))) (is (= {:status :idle} (sub [::subs/result]))) (is (= {:status :unknown} (sub [::subs/user]))) (is (= (:todos db/default-db) (sub [::subs/todos]))) (is (false? (sub [::subs/mcp-copied?])))) (testing "they follow the db" + (db! assoc :page :todos) (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 [: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])))) diff --git a/ui/test/tbd/ui/test_util.cljs b/ui/test/tbd/ui/test_util.cljs index e2fc57a..9dd91d4 100644 --- a/ui/test/tbd/ui/test_util.cljs +++ b/ui/test/tbd/ui/test_util.cljs @@ -76,6 +76,12 @@ :after (fn [] (aset js/globalThis "fetch" real-fetch))}) +(def url-fixture + "Each test starts on the page's own address, with no fragment (the page shown is the first)." + (let [reset-hash! #(set! js/location.hash "")] + {:before reset-hash! + :after reset-hash!})) + (defn log-in! [] (swap! server assoc :user {:login "alice" :id 7})) ;; --- Stubbing re-frame effects --- diff --git a/ui/test/tbd/ui/views_test.cljs b/ui/test/tbd/ui/views_test.cljs index 10ac685..10ffa0f 100644 --- a/ui/test/tbd/ui/views_test.cljs +++ b/ui/test/tbd/ui/views_test.cljs @@ -7,21 +7,29 @@ [re-frame.db :as rf-db] [tbd.ui.db :as db] [tbd.ui.events :as events] + [tbd.ui.pages :as pages] [tbd.ui.test-util :as tu :refer [q q-all text shows steps click! type! submit!]] [tbd.ui.views :as views] [tbd.ui.webmcp :as webmcp])) (use-fixtures :each tu/fake-server-fixture + tu/url-fixture tu/page-fixture ;; The Copy button's 2 seconds are up when the test says so (see mcp-copy-button-test). (tu/stub-effects-fixture {:dispatch-later (fn [_])})) (defn- open-page! - "Starts the app as core/init does, minus the WebMCP widget." - [] - (rf/dispatch-sync [::events/initialize]) - (tu/mount! [views/app])) + "Starts the app as core/init does, minus the WebMCP widget, on the page whose address is + `page` (the first, when there is none)." + ([] (open-page! nil)) + ([page] + (when page (set! js/location.hash (pages/page->hash page))) + (rf/dispatch-sync [::events/initialize]) + (tu/mount! [views/app]))) + +(defn- tab-titles [] + (mapv #(.-textContent %) (q-all "nav a"))) (defn- todos-section "The todos, which are only on the page when someone is logged in." @@ -39,7 +47,7 @@ [todos] (tu/log-in!) (swap! tu/server assoc :todos todos :next-id (inc (count todos))) - (steps open-page! + (steps #(open-page! :todos) #(tu/eventually todos-section) #(tu/eventually (fn [] (or (q "ul li") (= "Nothing to do." (text "section > p"))))))) @@ -59,8 +67,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 (= ["Tic-tac-toe" "Add this MCP server to Claude Code" "Browser tools (WebMCP)"] - (mapv #(.-textContent %) (q-all "h2")))))) + (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"))) done))) (deftest login-state-error-test @@ -206,6 +214,7 @@ (async done (reset! rf-db/app-db (-> db/default-db (assoc :user {:status :logged-in :login "alice"}) + (assoc :page :todos) (assoc-in [:todos :status] :loading))) (tu/finish (steps @@ -308,7 +317,9 @@ (is (empty? (filter #(= "gold" (.. % -style -background)) (q-all "section button[aria-label^=Cell]")))))) done))) -;; --- The setup sections --- +;; --- The AI setup page --- + +(defn- open-ai-setup! [] (open-page! :ai-setup)) (defn- with-clipboard "Runs `f` with navigator.clipboard set to `clipboard`, and takes it away afterwards." @@ -321,16 +332,15 @@ (async done (tu/finish (steps - open-page! - #(tu/eventually (fn [] (q "details"))) + open-ai-setup! + #(tu/eventually (fn [] (q "section pre"))) (fn [] - (let [details (first (q-all "details"))] - (is (nil? (.getAttribute details "open")) "folded away to start with") - (is (= "Add this MCP server to Claude Code" (text "details summary"))) - (is (= "claude mcp add --transport http tbd http://localhost:3000/mcp" (text "details pre code")) + (let [section (first (q-all "section"))] + (is (= "Add this MCP server to Claude Code" (text "section h2"))) + (is (= "claude mcp add --transport http tbd http://localhost:3000/mcp" (text "section pre code")) "the command names the address the page was loaded from") (is (= ["claude" "/mcp" "tbd"] - (mapv #(.-textContent %) (.querySelectorAll details "ol code"))))))) + (mapv #(.-textContent %) (.querySelectorAll section "ol code"))))))) done))) (deftest mcp-no-copy-button-without-clipboard-test @@ -338,10 +348,10 @@ (async done (tu/finish (steps - open-page! - #(tu/eventually (fn [] (q "details"))) + open-ai-setup! + #(tu/eventually (fn [] (q "section pre"))) (fn [] - (is (nil? (q "details pre + button"))))) + (is (nil? (q "section pre + button"))))) done))) (deftest mcp-copy-button-test @@ -352,30 +362,108 @@ #js {:writeText (fn [s] (swap! copied conj s) (js/Promise.resolve))} (fn [] (steps - open-page! - #(tu/eventually (fn [] (q "details pre + button"))) + open-ai-setup! + #(tu/eventually (fn [] (q "section pre + button"))) (fn [] - (is (= "Copy" (text "details pre + button"))) - (click! (q "details pre + button"))) - #(shows "the button says so" "details pre + button" "Copied") + (is (= "Copy" (text "section pre + button"))) + (click! (q "section pre + button"))) + #(shows "the button says so" "section pre + button" "Copied") (fn [] (is (= ["claude mcp add --transport http tbd http://localhost:3000/mcp"] @copied)) ;; The 2 seconds are up. (rf/dispatch-sync [::events/mcp-copied-timeout])) - #(shows "the button is back" "details pre + button" "Copy")))) + #(shows "the button is back" "section pre + button" "Copy")))) done)))) (deftest browser-tools-test (async done (tu/finish (steps - open-page! - #(tu/eventually (fn [] (second (q-all "details")))) + open-ai-setup! + #(tu/eventually (fn [] (second (q-all "section")))) (fn [] - (let [section (second (q-all "details"))] - (is (= "Browser tools (WebMCP)" (.-textContent (.querySelector section "summary")))) + (let [section (second (q-all "section"))] + (is (= "Browser tools (WebMCP)" (.-textContent (.querySelector section "h2")))) (is (= (str (count webmcp/tools)) (.-textContent (.querySelector section "p strong"))) "it counts the tools the page really offers") (is (= "https://webmcp.dev" (.getAttribute (.querySelector section "p a") "href"))) (is (= 4 (.-length (.querySelectorAll section "ol li"))))))) done))) + +;; --- The tabs --- + +(defn- current-tab [] + (some-> (q "nav a[aria-current=page]") .-textContent)) + +(deftest tabs-test + (async done + (tu/finish + (steps + 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 (some? (q "[role=status]")) "the game is on the page") + (is (nil? (q "details")) "nothing is folded away") + (click! (second (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") + (is (nil? (q "[role=status]")) "the game is gone") + (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)))) + (fn [shown] + (is shown "following the address (Back, Forward, a typed one) shows that page") + (is (some? (q "[role=status]"))))) + done))) + +(deftest page-address-test + (async done + (tu/finish + (steps + #(open-page! :ai-setup) + #(tu/eventually (fn [] (q "nav a"))) + (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)))) + (fn [shown] + (is shown "an address that names no page shows the first one"))) + done))) + +(deftest todos-tab-test + (async done + (tu/finish + (steps + #(log-in-page! []) + (fn [] + (is (= ["Games" "Todos" "AI setup"] (tab-titles))) + (is (= "Todos" (current-tab))) + (click! (q "nav a")) + (tu/eventually (fn [] (= "Games" (current-tab))))) + (fn [_] + (is (nil? (todos-section)) "the todos are on their own page") + (click! (second (q-all "nav a")))) + #(tu/eventually (fn [] (todos-section))) + (fn [shown] + (is shown "and back"))) + done))) + +(deftest todos-page-without-login-test + ;; Its address can be opened (a bookmark) without a login: the page says why it is empty. + (async done + (tu/finish + (steps + #(open-page! :todos) + #(tu/eventually (fn [] (some #{"Log in"} (nav-links)))) + (fn [] + (is (= ["Games" "AI setup"] (tab-titles))) + (is (nil? (todos-section))) + (is (= "Todos" (text "section h2"))) + (is (= "Log in" (text "section p a"))) + (is (= "/auth/login" (.getAttribute (q "section p a") "href"))))) + done))) diff --git a/ui/test/tbd/ui/webmcp_test.cljs b/ui/test/tbd/ui/webmcp_test.cljs index 84797a4..4ad07c3 100644 --- a/ui/test/tbd/ui/webmcp_test.cljs +++ b/ui/test/tbd/ui/webmcp_test.cljs @@ -20,6 +20,7 @@ :execute execute}))}) (use-fixtures :each + tu/url-fixture {:before (fn [] (reset! registered {}) ((:before tu/fake-server-fixture))) @@ -147,6 +148,59 @@ (is (empty? (:todos @tu/server)) "nothing was sent") (done)))))) +;; A tool that acts on the page opens the page it acts on, as a click on its tab would. + +(defn- page [] (:page @rf-db/app-db)) + +(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}] + :next-id 2) + (open-page!) + (async done + (-> (page-loaded) + (.then (fn [_] + (rf/dispatch-sync [::events/navigate :ai-setup]) + (call "get_tic_tac_toe" {}))) + (.then (fn [_] + (is (= :ai-setup (page)) "reading changes nothing") + (call "move_tic_tac_toe" {:cell 4}))) + (.then (fn [_] + (is (= :games (page))) + (rf/dispatch-sync [::events/navigate :ai-setup]) + (call "new_tic_tac_toe_game" {}))) + (.then (fn [_] + (is (= :games (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") + (call "list_todos" {}))) + (.then (fn [_] + (is (= :games (page))) + (call "create_todo" {:title "buy milk"}))) + (.then (fn [_] + (is (= :todos (page))) + (rf/dispatch-sync [::events/navigate :games]) + (call "set_todo_done" {:id 1 :done true}))) + (.then (fn [_] + (is (= :todos (page))) + (rf/dispatch-sync [::events/navigate :games]) + (call "delete_todo" {:id 1}))) + (.then (fn [_] + (is (= :todos (page))) + (done)))))) + +(deftest a-tool-that-fails-leaves-the-page-alone + (open-page!) + (async done + (-> (page-loaded) + (.then (fn [_] (call "create_todo" {:title "buy milk"}))) + (.then (fn [r] + (is (:error? r) "not logged in") + (is (= :games (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}]