Improve tool calling to avoid stop LLM loop if any exception happens.

Author: ericdallo

CHANGELOG.md

@@ -3,6 +3,7 @@
 ## Unreleased
 
 - Avoid crash MCP start if doesn't support some capabilities.
+- Improve tool calling to avoid stop LLM loop if any exception happens.
 
 ## 0.17.0
 

src/eca/features/chat.clj

@@ -1,9 +1,9 @@
 (ns eca.features.chat
   (:require
-   [babashka.fs :as fs]
    [cheshire.core :as json]
    [clojure.set :as set]
    [clojure.string :as string]
+   [eca.features.context :as f.context]
    [eca.features.index :as f.index]
    [eca.features.prompt :as f.prompt]
    [eca.features.rules :as f.rules]
@@ -18,29 +18,6 @@
 
 (def ^:private logger-tag "[CHAT]")
 
-(defn ^:private raw-contexts->refined [contexts db]
-  (mapcat (fn [{:keys [type path lines-range uri]}]
-            (case (name type)
-              "file" [{:type :file
-                       :path path
-                       :partial (boolean lines-range)
-                       :content (llm-api/refine-file-context path lines-range)}]
-              "directory" (->> (fs/glob path "**")
-                               (remove fs/directory?)
-                               (map (fn [path]
-                                      (let [filename (str (fs/canonicalize path))]
-                                        {:type :file
-                                         :path filename
-                                         :content (llm-api/refine-file-context filename nil)}))))
-              "repoMap" [{:type :repoMap}]
-              "mcpResource" (mapv
-                             (fn [{:keys [text]}]
-                               {:type :mcpResource
-                                :uri uri
-                                :content text})
-                             (:contents (f.mcp/get-resource! uri db)))))
-          contexts))
-
 (defn default-model [db config]
   (llm-api/default-model db config))
 
@@ -144,7 +121,7 @@
   (let [db @db*
         manual-approval? (get-in config [:toolCall :manualApproval] false)
         rules (f.rules/all config (:workspace-folders db))
-        refined-contexts (raw-contexts->refined contexts db)
+        refined-contexts (f.context/raw-contexts->refined contexts db)
         repo-map* (delay (f.index/repo-map db {:as-string? true}))
         instructions (f.prompt/build-instructions refined-contexts rules repo-map* (or behavior (:chat-default-behavior db)) config)
         past-messages (get-in db [:chats chat-id :messages] [])
@@ -292,8 +269,12 @@
    {:keys [db*] :as chat-ctx}]
   (let [{:keys [arguments]} (first (filter #(= prompt (:name %)) (f.mcp/all-prompts @db*)))
         args-vals (zipmap (map :name arguments) args)
-        {:keys [messages]} (f.mcp/get-prompt! prompt args-vals @db*)]
-    (prompt-messages! messages false chat-ctx)))
+        {:keys [messages error-message]} (f.prompt/get-prompt! prompt args-vals @db*)]
+    (if error-message
+      (send-content! chat-ctx :system
+                     {:type :text
+                      :text error-message})
+      (prompt-messages! messages false chat-ctx))))
 
 (defn ^:private handle-command! [{:keys [command]} {:keys [chat-id db* model] :as chat-ctx}]
   (let [db @db*]
@@ -355,38 +336,13 @@
 (defn tool-call-reject [{:keys [chat-id tool-call-id]} db*]
   (deliver (get-in @db* [:chats chat-id :tool-calls tool-call-id :approved?*]) false))
 
-(defn ^:private contexts-for [root-filename query config]
-  (let [all-files (fs/glob root-filename (str "**" (or query "") "**"))
-        allowed-files (f.index/filter-allowed all-files root-filename config)]
-    allowed-files))
-
 (defn query-context
   [{:keys [query contexts chat-id]}
    db*
    config]
-  (let [all-subfiles-and-dirs (into []
-                                    (comp
-                                     (map :uri)
-                                     (map shared/uri->filename)
-                                     (mapcat #(contexts-for % query config))
-                                     (take 200) ;; for performance, user can always make query specific for better results.
-                                     (map (fn [file-or-dir]
-                                            {:type (if (fs/directory? file-or-dir)
-                                                     :directory
-                                                     :file)
-                                             :path (str (fs/canonicalize file-or-dir))})))
-                                    (:workspace-folders @db*))
-        root-dirs (mapv (fn [{:keys [uri]}] {:type :directory
-                                             :path (shared/uri->filename uri)})
-                        (:workspace-folders @db*))
-        mcp-resources (mapv #(assoc % :type :mcpResource) (f.mcp/all-resources @db*))
-        all-contexts (concat [{:type :repoMap}]
-                             root-dirs
-                             all-subfiles-and-dirs
-                             mcp-resources)]
-    {:chat-id chat-id
-     :contexts (set/difference (set all-contexts)
-                               (set contexts))}))
+  {:chat-id chat-id
+   :contexts (set/difference (set (f.context/all-contexts query db* config))
+                             (set contexts))})
 
 (defn query-commands
   [{:keys [query chat-id]}

src/eca/features/context.clj

@@ -0,0 +1,66 @@
+(ns eca.features.context
+  (:require
+   [babashka.fs :as fs]
+   [eca.features.index :as f.index]
+   [eca.features.tools.mcp :as f.mcp]
+   [eca.llm-api :as llm-api]
+   [eca.logger :as logger]
+   [eca.shared :as shared]))
+
+(set! *warn-on-reflection* true)
+
+(def ^:private logger-tag "[CONTEXT]")
+
+(defn raw-contexts->refined [contexts db]
+  (mapcat (fn [{:keys [type path lines-range uri]}]
+            (case (name type)
+              "file" [{:type :file
+                       :path path
+                       :partial (boolean lines-range)
+                       :content (llm-api/refine-file-context path lines-range)}]
+              "directory" (->> (fs/glob path "**")
+                               (remove fs/directory?)
+                               (map (fn [path]
+                                      (let [filename (str (fs/canonicalize path))]
+                                        {:type :file
+                                         :path filename
+                                         :content (llm-api/refine-file-context filename nil)}))))
+              "repoMap" [{:type :repoMap}]
+              "mcpResource" (try
+                              (mapv
+                               (fn [{:keys [text]}]
+                                 {:type :mcpResource
+                                  :uri uri
+                                  :content text})
+                               (:contents (f.mcp/get-resource! uri db)))
+                              (catch Exception e
+                                (logger/warn logger-tag (format "Error getting MCP resource %s: %s" uri (.getMessage e)))
+                                []))))
+          contexts))
+
+(defn ^:private contexts-for [root-filename query config]
+  (let [all-files (fs/glob root-filename (str "**" (or query "") "**"))
+        allowed-files (f.index/filter-allowed all-files root-filename config)]
+    allowed-files))
+
+(defn all-contexts [query config db*]
+  (let [all-subfiles-and-dirs (into []
+                                    (comp
+                                     (map :uri)
+                                     (map shared/uri->filename)
+                                     (mapcat #(contexts-for % query config))
+                                     (take 200) ;; for performance, user can always make query specific for better results.
+                                     (map (fn [file-or-dir]
+                                            {:type (if (fs/directory? file-or-dir)
+                                                     :directory
+                                                     :file)
+                                             :path (str (fs/canonicalize file-or-dir))})))
+                                    (:workspace-folders @db*))
+        root-dirs (mapv (fn [{:keys [uri]}] {:type :directory
+                                             :path (shared/uri->filename uri)})
+                        (:workspace-folders @db*))
+        mcp-resources (mapv #(assoc % :type :mcpResource) (f.mcp/all-resources @db*))]
+    (concat [{:type :repoMap}]
+            root-dirs
+            all-subfiles-and-dirs
+            mcp-resources)))

src/eca/features/prompt.clj

@@ -2,7 +2,15 @@
   (:require
    [clojure.java.io :as io]
    [clojure.string :as string]
-   [eca.shared :refer [multi-str]]))
+   [eca.features.tools.mcp :as f.mcp]
+   [eca.logger :as logger]
+   [eca.shared :refer [multi-str]])
+  (:import
+   [java.util Map]))
+
+(set! *warn-on-reflection* true)
+
+(def ^:private logger-tag "[PROMPT]")
 
 (defn ^:private eca-prompt-template* [] (slurp (io/resource "eca_prompt.txt")))
 
@@ -43,3 +51,13 @@
     ""
     refined-contexts)
    "</contexts>"))
+
+(defn get-prompt! [^String name ^Map arguments db]
+  (logger/info logger-tag (format "Calling prompt '%s' with args '%s'" name arguments))
+  (try
+    (let [result (f.mcp/get-prompt! name arguments db)]
+      (logger/debug logger-tag "Prompt result: " result)
+      result)
+    (catch Exception e
+      (logger/warn logger-tag (format "Error calling prompt %s: %s" name (.getMessage e)))
+      {:error-message (str "Error calling prompt: " (.getMessage e))})))

src/eca/features/tools.clj

@@ -51,9 +51,17 @@
 (defn call-tool! [^String name ^Map arguments db config]
   (logger/info logger-tag (format "Calling tool '%s' with args '%s'" name arguments))
   (let [arguments (update-keys arguments clojure.core/name)]
-    (if-let [native-tool-handler (get-in (native-definitions db config) [name :handler])]
-      (native-tool-handler arguments {:db db :config config})
-      (f.mcp/call-tool! name arguments db))))
+    (try
+      (let [result (if-let [native-tool-handler (get-in (native-definitions db config) [name :handler])]
+                     (native-tool-handler arguments {:db db :config config})
+                     (f.mcp/call-tool! name arguments db))]
+        (logger/debug logger-tag "Tool call result: " result)
+        result)
+      (catch Exception e
+        (logger/warn logger-tag (format "Error calling tool %s: %s" name (.getMessage e)))
+        {:error true
+         :contents [{:type :text
+                     :text (str "Error calling tool: " (.getMessage e))}]}))))
 
 (defn init-servers! [db* messenger config]
   (let [disabled-tools (set (get-in config [:disabledTools] []))

src/eca/features/tools/mcp.clj

@@ -203,17 +203,10 @@
                                 (when (some #(= name (:name %)) tools)
                                   client)))
                         first)
-        result (try
-                 (let [result (.callTool ^McpSyncClient mcp-client
-                                         (McpSchema$CallToolRequest. name arguments))]
-                   {:error (.isError result)
-                    :contents (mapv ->content (.content result))})
-                 (catch Exception e
-                   {:error true
-                    :contents [{:type :text
-                                :text (.getMessage e)}]}))]
-    (logger/debug logger-tag "ToolCall result: " result)
-    result))
+        result (.callTool ^McpSyncClient mcp-client
+                          (McpSchema$CallToolRequest. name arguments))]
+    {:error (.isError result)
+     :contents (mapv ->content (.content result))}))
 
 (defn all-prompts [db]
   (into []
@@ -233,25 +226,21 @@
                                 (when (some #(= name (:name %)) prompts)
                                   client)))
                         first)
-        prompt (.getPrompt ^McpSyncClient mcp-client (McpSchema$GetPromptRequest. name arguments))
-        result {:description (.description prompt)
-                :messages (mapv (fn [^McpSchema$PromptMessage message]
-                                  {:role (string/lower-case (str (.role message)))
-                                   :content [(->content (.content message))]})
-                                (.messages prompt))}]
-    (logger/debug logger-tag "Prompt result:" result)
-    result))
+        prompt (.getPrompt ^McpSyncClient mcp-client (McpSchema$GetPromptRequest. name arguments))]
+    {:description (.description prompt)
+     :messages (mapv (fn [^McpSchema$PromptMessage message]
+                       {:role (string/lower-case (str (.role message)))
+                        :content [(->content (.content message))]})
+                     (.messages prompt))}))
 
 (defn get-resource! [^String uri db]
   (let [mcp-client (->> (vals (:mcp-clients db))
                         (keep (fn [{:keys [client resources]}]
                                 (when (some #(= uri (:uri %)) resources)
                                   client)))
                         first)
-        resource (.readResource ^McpSyncClient mcp-client (McpSchema$ReadResourceRequest. uri))
-        result {:contents (mapv ->resource-content (.contents resource))}]
-    (logger/debug logger-tag "Resource result:" result)
-    result))
+        resource (.readResource ^McpSyncClient mcp-client (McpSchema$ReadResourceRequest. uri))]
+    {:contents (mapv ->resource-content (.contents resource))}))
 
 (defn shutdown! [db*]
   (doseq [[_name {:keys [client]}] (:mcp-clients @db*)]