Add stdin content

Author: slimslenderslacks

docs/content/tools/docs/gordon.md

@@ -23,6 +23,12 @@ volumes:
     external: false
 ```
 
+{{< callout type="info" >}}
+
+`mcp/docker` uses the local docker engine to run containers. 
+
+{{< /callout >}}
+
 ## debugging
 
 We suggest using `docker ai --debug` if you are trying to debug some of your tools while using the `docker ai` cli.

prompts/lorax/speculative.md

@@ -149,6 +149,6 @@ tools:
 
 Make a cloned repo available to the sandbox.  The host repo is '/Users/slim/vonwig/altaservice' and it should be named atlas
 
-# prompt
+# prompt test lorax
 
 Clone the sandbox named atlas. We will get back the id of the new sandbox and we should remember that.

src/docker.clj

@@ -8,11 +8,10 @@
    [clojure.string :as string]
    [creds]
    jsonrpc
-   [jsonrpc.logger :as logger]
    logging
    schema)
   (:import
-   [java.net URLEncoder UnixDomainSocketAddress]
+   [java.net UnixDomainSocketAddress]
    [java.nio ByteBuffer]
    [java.nio.channels SocketChannel]
    [java.util Arrays Base64]))
@@ -36,7 +35,10 @@
   (curl/post
    (format "http://localhost/images/create?fromImage=%s" image)
    (merge
-    {:raw-args ["--unix-socket" "/var/run/docker.sock"]
+     {:raw-args ["--unix-socket" (let [f (fs/file "/var/run/docker.raw.sock")] 
+                                   (if (.exists f)  
+                                     "/var/run/docker.raw.sock"
+                                     "/var/run/docker.sock"))]
      :throw false}
     (when (or creds identity-token)
       {:headers {"X-Registry-Auth"
@@ -440,7 +442,7 @@
   "run container with stdin read from a file"
   [m]
   (let [x (docker/function-call-with-stdin
-           (assoc m :content (slurp (-> m :stdin :file))))]
+            (assoc m :content (or (-> m :stdin :content)  (slurp (-> m :stdin :file)))))]
     (async/<!! (async/thread
                  (Thread/sleep 10)
                  (docker/finish-call x)))))
@@ -451,7 +453,7 @@
   [m]
   ;; (schema/validate :schema/container-definition)
   (cond 
-    (-> m :stdin :file)
+    (-> m :stdin)
     (run-with-stdin-content m)
     (true? (:background m))
     (run-background-function m)

src/git.clj

@@ -101,15 +101,15 @@
        (partition-by (comp :ref-hash :ref))
        (map first)))
 
-(defn refresh-cache 
+(defn refresh-cache
   " pure side-effect - clone or pull the cache"
   [coll]
   (doseq [m coll]
-    (if (fs/exists? (-> m :ref :dir))
-      (pull (:ref m))
-      (clone (:ref m)))
-    (when (not (= 0 (:exit-code m)))
-      (jsonrpc/notify :error {:content (str m)}))))
+    (let [c (if (fs/exists? (-> m :ref :dir))
+              (pull (:ref m))
+              (clone (:ref m)))]
+      (when (not (= 0 (:exit-code c)))
+        (jsonrpc/notify :error {:content (str c)})))))
 
 (defn cached-prompt-file [{{:keys [dir path]} :ref :as m}]
   (if path

src/jsonrpc/db.clj

@@ -9,11 +9,13 @@
 
 (def db* (atom {}))
 
-(defn get-prompt-data [{:keys [register] :as opts}]
+(defn get-prompt-data 
+  "register is a coll of prompt file ref maps"
+  [{:keys [register] :as opts}]
   (->> register
-       (map (fn [{:keys [cached-path]}]
+       (map (fn [{:keys [cached-path ref-string]}]
               (let [m (prompts/get-prompts (assoc opts :prompts cached-path))]
-                [(or (-> m :metadata :name) ref) m])))
+                [(or (-> m :metadata :name) ref-string) m])))
        (into {})))
 
 (defn extract-resources [m]
@@ -56,13 +58,16 @@
        refs - coll of [type ref] type is static or dynamic"
   [refs]
   (if (seq refs)
+    ;; turn static/dynamic refs into maps of type, ref-string, and parsed ref with cache dir
     (let [git-map-coll (->> refs
                             (map (fn [[t ref]] {:type t :ref-string ref :ref (git/parse-github-ref ref)}))
                             (map (fn [m] (assoc-in m [:ref :ref-hash] (git/hashch (:ref m)))))
                             (map (fn [m] (assoc-in m [:ref :dir] (git/cache-dir (:ref m))))))]
+      ;; refresh cache (side effect)
       (-> git-map-coll
           git/collect-unique-cache-dirs
           git/refresh-cache)
+      ;; updated git map with cached-path
       (let [typed-colls
             (->> git-map-coll
                  (map git/cached-prompt-file)

src/jsonrpc/server.clj

@@ -96,13 +96,10 @@
                 :total 0
                 :hasMore false}})
 
-(defn entry->prompt-listing [k v message]
-  (let [{:keys [description arguments]} (:metadata v)]
+(defn entry->prompt-listing [_ v message]
+  (let [{:keys [arguments]} (:metadata v)]
     (merge
-     {:name (if (:title message)
-              (str k ":" (:title message))
-              k)
-      :description (or (:description message) description "missing description")}
+     (select-keys message [:name :description])
      (when arguments
        {:arguments arguments}))))
 
@@ -118,8 +115,15 @@
 
 (defmethod lsp.server/receive-request "prompts/get" [_ {:keys [db*]} {:keys [name arguments]}]
   (logger/info "prompts/get " name)
-  (let [{:keys [prompt-function metadata]} (-> @db* :mcp.prompts/registry (get name))]
-    {:description (or (:description metadata) name)
+  (let [{:keys [prompt-function description] :as m}
+        (get
+          (->> @db*
+               :mcp.prompts/registry
+               vals
+               (mapcat :mcp/prompt-registry)
+               (into {}))
+          name)]
+    {:description description
      :messages (prompt-function (or arguments {}))}))
 
 (defmethod lsp.server/receive-request "resources/list" [_ {:keys [db*]} _]

src/markdown.clj

@@ -75,6 +75,9 @@
 (defn section? [node]
   (and (list? node) (= "section" (first node))))
 
+(defn fenced-code-block? [node]
+  (and (list? node) (= "fenced_code_block" (first node))))
+
 (defn description-section? [content node]
   (when-let [atx-header-node (first (filter #(= "atx_heading" (first %)) node))]
     (= "description"  (string/trim (from-range (-> atx-header-node (nth 3) (nth 1)) content)))))
@@ -117,14 +120,25 @@
 
 (def heading-1-loc->top-level-section-node (comp zip/node zip/up zip/up))
 
-(defn extract-prompts-with-descriptions [content ast]
+(defn extract-prompts-with-descriptions [content metadata ast]
   (->>
    (iterate zip/next (zip/seq-zip ast))
    (take-while (complement zip/end?))
    (filter heading-1-section?)
    (map heading-1-loc->top-level-section-node)
    (filter (partial prompt-section? content))
-   (map (partial h1-prompt-content content))))
+   (map (partial h1-prompt-content content))
+   (map (fn [m] (-> m
+                    (assoc :name (cond
+                                   (and (:title m) (:name metadata)) (str (:name metadata) ":" (:title m))
+                                   (:title m) (:title m)
+                                   (:name metadata) (:name metadata)
+                                   ;; TODO fix this
+                                   :else "missing name")
+                           :description (or
+                                         (:description m)
+                                         (:description metadata)
+                                         "missing description")))))))
 
 (defn extract-prompts [content ast]
   (->>
@@ -174,6 +188,28 @@
       (println ex)
       nil)))
 
+(defn extract-first-yaml-code-block [content ast]
+  (try
+    (when-let [loc (when-let [first-section
+                              (->>
+                               (iterate zip/right (zip/down (zip/seq-zip ast)))
+                               (some (fn [loc] (when (section? (zip/node loc)) loc))))]
+                     (when-let [first-code-block
+                                (->>
+                                  (iterate zip/right (zip/down first-section))
+                                  (some (fn [loc] (when (fenced-code-block? (zip/node loc)) loc))))]
+                       first-code-block))]
+      (->
+       (from-range (-> loc zip/node (nth 5) (nth 1)) content)
+       (clj-yaml/parse-string)))
+    (catch Throwable ex
+      (println ex)
+      nil)))
+
+(comment
+  (let [content (slurp "prompts/examples/github_issues.md")]
+    (extract-first-yaml-code-block content (parse-markdown content))))
+
 (defn parse-markdown
   "use the custom sexp representation"
   [content]
@@ -189,15 +225,17 @@
   "parse out the h1 prompt sections and the metadata"
   [content]
   (let [content (str content "\n# END\n\n")
-        ast (parse-markdown content)]
+        ast (parse-markdown content)
+        metadata (or
+                  (extract-metadata content ast)
+                  (extract-first-comment content ast)
+                  (extract-first-yaml-code-block content ast)
+                  {})]
     {:messages
      (->> ast
-          (extract-prompts-with-descriptions content)
+          (extract-prompts-with-descriptions content metadata)
           (into []))
-     :metadata  (or
-                 (extract-metadata content ast)
-                 (extract-first-comment content ast)
-                 {})}))
+     :metadata  metadata}))
 
 ;; ---------- future ---------
 

src/prompts.clj

@@ -175,17 +175,6 @@
           prompt-content
           (markdown-parser/parse-prompts prompt-content)
 
-          ;; directory based prompts
-          (fs/directory? prompts)
-          {:messages
-           (->> (fs/list-dir prompts)
-                (filter (name-matches prompt-file-pattern))
-                (sort-by fs/file-name)
-                (map (fn [f] {:role (let [[_ role] (re-find prompt-file-pattern (fs/file-name f))] role)
-                              :content (slurp (fs/file f))}))
-                (into []))
-           :metadata (:metadata (markdown-parser/parse-prompts (slurp (metadata-file prompts))))}
-
           ;; file based prompts
           :else
           (markdown-parser/parse-prompts (slurp prompts)))
@@ -201,11 +190,20 @@
                      (moustache-render prompts (merge (facts m user platform host-dir) arguments) message)))]
     ((schema/validate :schema/prompts-file)
      (-> prompt-data
-         ((fn [m] (assoc m :prompt-function (fn [arguments]
-                                              (->> (:messages m)
-                                                   (map (comp ->message (partial renderer arguments)))
-                                                   (into []))))))
-         (update :messages #(map (partial renderer {}) %))
+         (assoc :mcp/prompt-registry
+                (->> (:messages prompt-data)
+                     (map (fn [{:keys [name] :as v}]
+                            [name (assoc
+                                   (select-keys v [:description])
+                                   :prompt-function
+                                   (fn [arguments]
+                                     [((comp ->message (partial renderer arguments))
+                                       (select-keys v [:role :content]))]))]))
+                     (into {})))
+         (update :messages (fn [messages]
+                             (->> messages
+                                  (map (partial renderer {}))
+                                  (map #(dissoc % :name :description :title)))))
          (update :metadata dissoc :functions :tools :extractors)
          (assoc :functions (->> (or (:tools metadata) (:functions metadata)) (mapcat function-definition)))))))
 

src/tools.clj

@@ -81,7 +81,10 @@
                                                       (-> definition :container :workdir)
                                                       (:workdir defaults))]
                                          {:workdir (first (interpolate arg-context wd))}))
-                                (-> definition :stdin :file) (update-in [:stdin :file] (fn [s] (first (interpolate arg-context s)))))]
+
+                                (-> definition :stdin :file) (update-in [:stdin :file] (fn [s] (first (interpolate arg-context s))))
+                                
+                                (-> definition :stdin :content) (update-in [:stdin :content] (fn [s] (first (interpolate arg-context s)))))]
             (jsonrpc/notify
              :message
              {:debug (format "function call %s"
@@ -109,7 +112,8 @@
 
           (fail (format "bad container definition %s" definition)))
         (catch Throwable t
-          (fail (format "system failure %s" t)))))
+          (fail (format "system failure %s" t))
+          (fail (with-out-str (.printStackTrace t))))))
     (fail "no function found")))
 
 (defn call-function

test/jsonrpc/db_t.clj

@@ -7,33 +7,47 @@
    [lsp4clj.server :as server]))
 
 (def correct-refs
-  [[:dynamic
-    "github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/hello_world.md"]
-   [:dynamic
-    "github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/mcp-sqlite.md"]
-   [:dynamic
-    "github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/curl.md"]
-   [:dynamic
-    "github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/ffmpeg.md"]
-   [:dynamic
-    "github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/explain_dockerfile.md"]
-   [:dynamic
-    "github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/qrencode.md"]])
+  [ [:dynamic
+  "github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/hello_world.md"]
+ [:dynamic
+  "github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/curl.md"]
+ [:dynamic
+  "github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/qrencode.md"]
+ [:dynamic
+  "github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/mcp-sqlite.md"]
+ [:dynamic
+  "github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/explain_dockerfile.md"]
+ [:dynamic
+  "github:docker/labs-ai-tools-for-devs?ref=main&path=prompts/examples/ffmpeg.md"]
+ [:dynamic
+  "github:docker/labs-ai-tools-for-devs?path=prompts/examples/mcp-memory.md"]
+ [:dynamic
+  "github:docker/labs-ai-tools-for-devs?path=prompts/lorax/speculative.md"]])
 
 (t/deftest registry-ref-tests
   (t/testing "parse-registry"
     (t/is (= correct-refs
              (db/registry-refs "test/registry.yaml")))))
 
-(let []
-  (db/add-refs
+(comment
+  (do
+    (db/add-refs
       (concat
-       (->> []
-            (map (fn [ref] [:static ref])))
-         ;; register dynamic prompts
-       (when (fs/exists? (fs/file "test/registry.yaml"))
-         (db/registry-refs "test/registry.yaml"))))
-  (server/receive-request "prompts/list" {:db* db*} {}))
+        (->> []
+             (map (fn [ref] [:static ref])))
+        ;; register dynamic prompts
+        (when (fs/exists? (fs/file "test/registry.yaml"))
+          (db/registry-refs "test/registry.yaml"))))
+    (->> @db/db*
+         :mcp.prompts/registry
+         vals
+         (mapcat :mcp/prompt-registry))
+    (get-in (deref db/db*) [:mcp.prompts/registry "curl"])
+    (server/receive-request "prompts/list" {:db* db/db*} {})
+    (server/receive-request 
+      "prompts/get" 
+      {:db* db/db*} 
+      {:name "curl:fetch gists" :arguments {:user "slimslender"}})))
 
 (comment
   (db/add-refs