Add resource registrations

Author: slimslenderslacks

dev/catalog.clj

@@ -0,0 +1,34 @@
+(ns catalog
+  (:require
+   [clj-yaml.core :as yaml]
+   git
+   [medley.core :as medley]
+   prompts))
+
+(defn f->prompt [f]
+  (prompts/get-prompts {:prompts f}))
+
+(defn tile-metadata [m]
+  {:tools (-> m :functions)
+   :prompts (count (:messages m))
+   :resources (or (:resources m) {})})
+
+(defn extra-metadata [vals]
+  (->> vals
+       (map :ref)
+       (map git/prompt-file)
+       (map f->prompt)
+       (map tile-metadata)))
+
+(spit "catalog.updated.yaml"
+      (yaml/generate-string 
+        (let [catalog (yaml/parse-string (slurp "prompts/catalog.yaml"))]
+          (medley/deep-merge
+            catalog
+            {:registry
+             (->> (apply interleave ((juxt keys (comp extra-metadata vals)) (seq (:registry catalog))))
+                  (partition 2)
+                  (map #(into [] %))
+                  (into {})
+                  )}))))
+

prompts/catalog.yaml

@@ -73,7 +73,13 @@ registry:
           command: [-c, 'echo ''{{insight|safe}}'' >> /thread/insights.txt']
           volumes: ['mcp-test:/mcp']
     prompts: 1
-    resources: {}
+    resources:
+    - name: Business Insights Memo
+      description: A living document of discovered business insights
+      uri: memo://insights
+      mimeType: text/plain
+      matches: resource:///thread/insights.txt
+      default: {text: No business insights have been discovered yet.}
   curl:
     description: Demonstration of curl tool (use curl to fetch GitHub gists for a user)
     ref: github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/curl.md

src/graph.clj

@@ -48,7 +48,7 @@
   (let [[chunk-handler sample] (providers (llm-provider (or (:model metadata) model)))
         [c h] (chunk-handler)
         request (merge
-                 (dissoc metadata :agent :host-dir :workdir :prompt-format :description :name :parameter-values :arguments) ; TODO should we just select relevant keys instead of removing bad ones
+                 (dissoc metadata :agent :host-dir :workdir :prompt-format :description :name :parameter-values :arguments :resources) ; TODO should we just select relevant keys instead of removing bad ones
                  {:messages messages
                   :level level}
                  (when (seq functions) {:tools functions})

src/jsonrpc/db.clj

@@ -5,6 +5,8 @@
    [jsonrpc.logger :as logger]
    prompts))
 
+(set! *warn-on-reflection* true)
+
 (def db* (atom {}))
 
 (defn get-prompt-data [{:keys [register] :as opts}]
@@ -14,16 +16,29 @@
                 [(or (-> m :metadata :name) ref) m])))
        (into {})))
 
+(defn extract-resources [m]
+  (->> (vals m)
+       (map (comp :resources :metadata))
+       (filter identity)
+       (map (fn [{:keys [uri] :as entry}]
+              [uri (merge
+                    entry
+                    (when (and (not (contains? entry :text)) (-> entry :default :text))
+                      {:text (-> entry :default :text)}))]))
+       (into {})))
+
 (defn add-static-prompts [db m]
   (-> db
       (update :mcp.prompts/registry (fnil merge {}) m)
-      (assoc :mcp.prompts/static m)))
+      (assoc :mcp.prompts/static m)
+      (update :mcp.prompts/resources (fnil merge {}) (extract-resources m))))
 
 (defn add-dynamic-prompts [db m]
   (logger/info "dynamic keys" (keys (:mcp.prompts/registry db)))
   (logger/info "static keys" (keys (:mcp.prompts/static db)))
   (-> db
-      (assoc :mcp.prompts/registry (merge m (:mcp.prompts/static db)))))
+      (assoc :mcp.prompts/registry (merge m (:mcp.prompts/static db)))
+      (update :mcp.prompts/resources (fnil merge {}) (extract-resources m))))
 
 (defn update-dynamic [coll]
   (swap! db* add-dynamic-prompts (get-prompt-data {:register coll})))
@@ -61,11 +76,12 @@
             (logger/info "unknown type " (first coll))))))
     ;; if registry.yaml is empty
     (swap! db* (fn [db] (-> db
-                            (update 
-                              :mcp.prompts/registry 
-                              (constantly (or (:mcp.prompts/static db) {}))))))))
+                            (update
+                             :mcp.prompts/registry
+                             (constantly (or (:mcp.prompts/static db) {})))))))
+  (logger/info "resources are " (:mcp.prompts/resources @db*)))
 
-(defn registry-refs 
+(defn registry-refs
   "parse refs from the registry.yaml file - these are dynamic"
   [f]
   (->>

src/jsonrpc/server.clj

@@ -3,7 +3,6 @@
   (:require
    [babashka.fs :as fs]
    [cheshire.core :as json]
-   [clj-yaml.core :as yaml]
    [clojure.core :as c]
    [clojure.core.async :as async]
    [clojure.pprint :as pprint]
@@ -19,6 +18,7 @@
    [lsp4clj.io-chan :as io-chan]
    [lsp4clj.io-server :refer [stdio-server]]
    [lsp4clj.server :as lsp.server]
+   [medley.core :as medley]
    [promesa.core :as p]
    shutdown
    state
@@ -118,13 +118,22 @@
     {:description (or (:description metadata) name)
      :messages (prompt-function (or arguments {}))}))
 
-(defmethod lsp.server/receive-request "resources/list" [_ _ _]
+(defmethod lsp.server/receive-request "resources/list" [_ {:keys [db*]} _]
   (logger/info "resources/list")
-  {:resources []})
-
-(defmethod lsp.server/receive-request "resources/read" [_ _ params]
+  (let [resources
+        {:resources (or (->> (:mcp.prompts/resources @db*)
+                             (vals)
+                             (map #(select-keys % [:uri :name :description :mimeType])))
+                        [])}]
+    (logger/info resources)
+    resources))
+
+(defmethod lsp.server/receive-request "resources/read" [_ {:keys [db*]} params]
   (logger/info "resouces/read" params)
-  {:contents []})
+  {:contents (concat
+              []
+              (when-let [m (get-in @db* [:mcp.prompts/resources (:uri params)])]
+                [(select-keys m [:uri :mimeType :text :blob])]))})
 
 (defmethod lsp.server/receive-request "resources/templates/list" [_ _ _]
   (logger/info "resources/templates/list")
@@ -149,11 +158,54 @@
                                 (assoc :inputSchema (or (-> m :function :parameters) {:type "object" :properties {}})))))
                (into []))})
 
+(defn resource-uri [db-resources uri]
+  ((->> db-resources
+        vals
+        (map (fn [{:keys [uri matches]}] [matches uri]))
+        (into {})) uri))
+
+(defn update-matched-resources
+  "check if any collected-resources match the db ones and update them"
+  [db-resources collected-resources]
+  (let [matched (->> collected-resources
+                     (filter (comp (into #{} (->> db-resources (vals) (map :matches))) :uri :resource)))]
+    (medley/deep-merge
+     db-resources
+     (->> matched
+          (map (fn [{{:keys [uri text]} :resource}] [(resource-uri db-resources uri) {:text text}]))
+          (into {})))))
+
+(comment
+  (update-matched-resources
+   {"memo://insights" {:uri "memo://insights" :text "No Business Insights" :matches "resource:///thread/insights.txt"}}
+   [{:resource {:uri "resource:///thread/insights.txt" :text "updated"}}]))
+
+(defn update-resources
+  "update the resource list in the db
+     params - resources coll of mcp resources extracted from last tool call"
+  [{:keys [db* producer]} resources]
+  (when (seq resources)
+    (swap! db* update :mcp.prompts/resources update-matched-resources resources)
+    (producer/publish-resource-list-changed producer {})))
+
+(comment
+  (def hey
+    (atom
+     {:mcp.prompts/resources
+      {"memo://insights"
+       {:uri "memo://insights"
+        :text "No Business Insights"
+        :matches "resource:///thread/insights.txt"}}}))
+  (update-resources
+   {:db* hey
+    :producer (reify producer/IProducer (publish-resource-list-changed [_ _] (println "called")))}
+   [{:resource {:uri "resource:///thread/insights.txt" :text "updated"}}]))
+
 (defn mcp-tool-calls
   " params
-      db* - uses mcp.prompts/registry and host-dir
-      params - tools/call mcp params"
-  [db* params]
+  db* - uses mcp.prompts/registry and host-dir
+  params - tools/call mcp params"
+  [{:keys [db*] :as components} params]
   (volumes/with-volume
     (fn [thread-id]
       (concat
@@ -171,13 +223,13 @@
                 (async/<!!)
                 (map :content)
                 (apply str))}]
-       (volumes/pick-up-mcp-resources thread-id)))))
+       (volumes/pick-up-mcp-resources thread-id (partial update-resources components))))))
 
-(defmethod lsp.server/receive-request "tools/call" [_ {:keys [db*]} params]
+(defmethod lsp.server/receive-request "tools/call" [_ components params]
   (logger/info "tools/call")
   (logger/info "with params" params)
   (lsp.server/discarding-stdout
-   (let [content (mcp-tool-calls db* params)]
+   (let [content (mcp-tool-calls components params)]
      (logger/info "content " (with-out-str (pprint/pprint content)))
      ;; TODO with mcp, tool-calls with errors can be explicit
      {:content content
@@ -316,12 +368,12 @@
      (swap! db* merge {:log-path log-path} (dissoc opts :in))
      ;; register static prompts
      (db/add-refs
-       (concat
-         (->> (:register opts)
-              (map (fn [ref] [:static ref])))
+      (concat
+       (->> (:register opts)
+            (map (fn [ref] [:static ref])))
          ;; register dynamic prompts
-         (when (fs/exists? (fs/file registry))
-           (db/registry-refs registry))))
+       (when (fs/exists? (fs/file registry))
+         (db/registry-refs registry))))
      ;; watch dynamic prompts in background
      (async/thread
        (let [{x :container}

src/volumes.clj

@@ -25,9 +25,10 @@
    {:uri "resource://example"
     :mimeType "text/plain"
     :text "Resource Content"}})
+
 (defn pick-up-mcp-resources
   " returns a coll of mcp resources picked up for a thread"
-  [thread-id]
+  [thread-id callback]
   (try
     (-> (docker/run-container
           {:image "vonwig/bb:latest"
@@ -36,7 +37,8 @@
                        {:directory "/thread"} keyword)
                      (script/read-script-at-compile-time "src/volumes/collect.clj")]})
         :pty-output
-        (json/parse-string keyword))
+        (json/parse-string keyword)
+        ((fn [resources] (callback resources) resources)))
     (catch Throwable t
       (logger/error t "error collecting mcp resources")
       {})))