@lovelace_lol/polymer 0.0.1

package/src/polymer/conversation/effector.cljs

@@ -0,0 +1,130 @@
+(ns polymer.conversation.effector
+  (:require [polymer.conversation.domain :as domain]))
+
+;; The provider effector is the only Conversation code allowed to invoke an
+;; external LLM/backend provider. It receives already-planned request data from
+;; the scheduler and reports plain completion data back to the agency.
+
+(defn provider-call
+  [provider]
+  (cond
+    (fn? provider)
+    {:target nil
+     :respond provider}
+
+    (and provider (fn? (aget provider "respond")))
+    {:target provider
+     :respond (aget provider "respond")}
+
+    :else nil))
+
+(defn thenable?
+  [value]
+  (and value (fn? (aget value "then"))))
+
+(defn cleanup-callback
+  [value]
+  (cond
+    (fn? value)
+    value
+
+    :else
+    (when value
+      (some (fn [method-name]
+              (when-let [method (aget value method-name)]
+                (when (fn? method)
+                  #(.call method value))))
+            ["cancel" "abort" "stop" "dispose"]))))
+
+(defn response-data
+  [response]
+  (cond
+    (string? response) {:text response}
+    (map? response) response
+    response (domain/data-map response)
+    :else {}))
+
+(defn error-message
+  [error]
+  (or (domain/clean-text (when error (aget error "message")))
+      (domain/clean-text (when (string? error) error))
+      (domain/clean-text (str error))
+      "conversation-provider-error"))
+
+(defn create-provider-effector
+  [provider]
+  (let [call (provider-call provider)
+        active (atom {})
+        disposed? (atom false)]
+    (letfn [(active-token? [request-id token]
+              (identical? token (get-in @active [request-id :token])))
+
+            (settle! [request-id token callback value]
+              (when (and (not @disposed?)
+                         (active-token? request-id token))
+                (swap! active dissoc request-id)
+                (callback value)))
+
+            (cancel-entry! [request-id]
+              (when-let [{:keys [cleanup]} (get @active request-id)]
+                (swap! active dissoc request-id)
+                (when cleanup
+                  (try
+                    (cleanup)
+                    (catch :default _
+                      nil)))))
+
+            (remember-cleanup! [request-id token cleanup]
+              (when (and cleanup (active-token? request-id token))
+                (swap! active assoc-in [request-id :cleanup] cleanup)))
+
+            (invoke! [request on-success on-error]
+              (when (and call (not @disposed?))
+                (let [request-id (:requestId request)
+                      token (js-obj)
+                      succeed! #(settle! request-id token on-success
+                                         (response-data %))
+                      fail! #(settle! request-id token on-error
+                                      {:message (error-message %)})
+                      request-js (clj->js (dissoc request
+                                                  :type
+                                                  :agency
+                                                  :targetAgency))]
+                  (cancel-entry! request-id)
+                  (swap! active assoc request-id {:token token
+                                                  :cleanup nil})
+                  (try
+                    (let [result (.call (:respond call)
+                                        (:target call)
+                                        request-js
+                                        succeed!
+                                        fail!)
+                          cleanup (cleanup-callback result)]
+                      (cond
+                        (thenable? result)
+                        (do
+                          (remember-cleanup! request-id token cleanup)
+                          (.then result succeed! fail!))
+
+                        cleanup
+                        (remember-cleanup! request-id token cleanup)
+
+                        (some? result)
+                        (succeed! result)
+
+                        :else nil))
+                    (catch :default error
+                      (fail! error))))))
+
+            (cancel-all! []
+              (doseq [request-id (keys @active)]
+                (cancel-entry! request-id)))]
+      {:available? (boolean call)
+       :invoke invoke!
+       :cancel cancel-entry!
+       :cancel-all cancel-all!
+       :dispose
+       (fn []
+         (when-not @disposed?
+           (cancel-all!)
+           (reset! disposed? true)))})))

package/src/polymer/conversation/planner.cljs

@@ -0,0 +1,178 @@
+(ns polymer.conversation.planner
+  (:require [polymer.conversation.domain :as domain]))
+
+;; Conversation planning stays agency-local. It decides what this agency wants
+;; to do with a transcript, provider result, or interruption, then hands ordered
+;; action data to the scheduler. It never calls a backend, TTS provider, or peer
+;; agency function directly.
+
+(def supported-command-types
+  #{"configure"
+    "start"
+    "stop"
+    "reset"
+    "cancel"
+    "interrupt"
+    "transcript.final"
+    "transcriptFinal"
+    "userUtterance"
+    "agentUtterance"
+    "responseReady"
+    "providerError"
+    "tts.status"})
+
+(defn command-type
+  [command]
+  (:type command))
+
+(defn request-id
+  [prefix now-ms]
+  (str prefix ":" now-ms ":" (rand-int 1000000)))
+
+(defn stale-response?
+  [command state]
+  (or (:interrupted state)
+      (nil? (:pendingResponse state))
+      (and (:turnId command)
+           (not= (:turnId command) (:turnId state)))
+      (and (:requestId command)
+           (not= (:requestId command)
+                 (:requestId (:pendingResponse state))))))
+
+(defn failure-step
+  [command]
+  (cond
+    (not (contains? supported-command-types (command-type command)))
+    {:op "fail"
+     :reason "unsupported-command"
+     :commandType (command-type command)}
+
+    (and (#{"transcript.final" "transcriptFinal" "userUtterance"} (command-type command))
+         (not (domain/user-text command)))
+    {:op "fail"
+     :reason "missing-user-text"
+     :commandType (command-type command)}
+
+    (and (#{"agentUtterance" "responseReady"} (command-type command))
+         (not (domain/agent-text command)))
+    {:op "fail"
+     :reason "missing-agent-text"
+     :commandType (command-type command)}))
+
+(defn transcript-steps
+  [command state now-ms]
+  (let [text (domain/user-text command)
+        source (or (:source command) "transcription")
+        pending-request-id (get-in state [:pendingResponse :requestId])
+        response-text (domain/clean-text (or (:responseText command) (:agentText command)))
+        response-request {:requestId (request-id "conversation:response" now-ms)
+                          :text text
+                          :source source
+                          :turnId (:turnId state)
+                          :history (:history state)
+                          :requestedAt now-ms}]
+    (cond-> [{:op "record-user-utterance"
+              :text text
+              :source source}
+             {:op "emit-user-utterance"
+              :text text
+              :source source}]
+      (and (get-in state [:config :autoRespond])
+           pending-request-id)
+      (conj {:op "cancel-provider"
+             :requestId pending-request-id
+             :reason "superseded"})
+
+      (get-in state [:config :autoRespond])
+      (conj {:op "request-response"
+             :request response-request}
+            {:op "invoke-provider"
+             :request response-request})
+
+      response-text
+      (conj {:op "record-agent-utterance"
+             :text response-text
+             :source "response"}
+            {:op "request-tts"
+             :text response-text
+             :source "response"
+             :requestId (request-id "conversation:tts" now-ms)}))))
+
+(defn agent-utterance-steps
+  [command state now-ms]
+  (let [text (domain/agent-text command)]
+    (if (and (= "responseReady" (:type command))
+             (stale-response? command state))
+      [{:op "ignore-stale-response"
+        :reason "stale-response"
+        :requestId (:requestId command)
+        :turnId (:turnId command)}]
+      [{:op "record-agent-utterance"
+        :text text
+        :source (or (:source command) "conversation")}
+       {:op "request-tts"
+        :text text
+        :source (or (:source command) "conversation")
+        :requestId (request-id "conversation:tts" now-ms)}])))
+
+(defn provider-error-steps
+  [command state]
+  (if (stale-response? command state)
+    [{:op "ignore-stale-response"
+      :reason "stale-provider-error"
+      :requestId (:requestId command)
+      :turnId (:turnId command)}]
+    [{:op "record-provider-error"
+      :requestId (:requestId command)
+      :turnId (:turnId command)
+      :message (or (:message command) "conversation-provider-error")}
+     {:op "publish-provider-error"
+      :requestId (:requestId command)
+      :turnId (:turnId command)
+      :message (or (:message command) "conversation-provider-error")}]))
+
+(defn command-steps
+  [command state now-ms]
+  (if-let [failure (failure-step command)]
+    [failure]
+    (case (command-type command)
+      "configure" [{:op "apply-config"}
+                   {:op "publish-status" :status (:status state)}]
+      "start" [{:op "start-session"}
+               {:op "publish-status" :status "listening"}]
+      "stop" [{:op "cancel-provider"
+               :requestId (get-in state [:pendingResponse :requestId])
+               :reason (or (:reason command) "stopped")}
+              {:op "stop-session" :reason (or (:reason command) "stopped")}
+              {:op "publish-status" :status "idle"}]
+      "reset" [{:op "cancel-provider"
+                :requestId (get-in state [:pendingResponse :requestId])
+                :reason "reset"}
+               {:op "reset-state"}
+               {:op "publish-status" :status "idle"}]
+      ("cancel" "interrupt") [{:op "cancel-provider"
+                               :requestId (get-in state [:pendingResponse :requestId])
+                               :reason (or (:reason command) (command-type command))}
+                              {:op "cancel-turn"
+                               :reason (or (:reason command) (command-type command))}
+                              {:op "publish-cancel"
+                               :reason (or (:reason command) (command-type command))}
+                              {:op "publish-status" :status "interrupted"}]
+      ("transcript.final" "transcriptFinal" "userUtterance")
+      (transcript-steps command state now-ms)
+      ("agentUtterance" "responseReady")
+      (agent-utterance-steps command state now-ms)
+      "providerError"
+      (provider-error-steps command state)
+      "tts.status" [{:op "record-tts-status"
+                     :status (:status command)}
+                    {:op "publish-status" :status (:status command)}])))
+
+(defn plan-command
+  [command state now-ms]
+  (let [steps (command-steps command state now-ms)]
+    {:agency "conversation"
+     :commandType (command-type command)
+     :createdAt now-ms
+     :ok (not= "fail" (:op (first steps)))
+     :steps steps}))

package/src/polymer/conversation/scheduler.cljs

@@ -0,0 +1,202 @@
+(ns polymer.conversation.scheduler
+  (:require [polymer.conversation.state :as state]))
+
+;; The Conversation scheduler is the ordered work boundary for the agency. This
+;; first slice executes immediately, but it still records every planned step in
+;; a queue so future backend/provider sequencing, retries, and cancellation can
+;; extend the same architecture without moving logic into host UI code.
+
+(defn now-ms
+  []
+  (.now js/Date))
+
+(defn queue-entry
+  [step index plan]
+  (assoc step
+         :agency "conversation"
+         :queueIndex index
+         :commandType (:commandType plan)
+         :queuedAt (now-ms)))
+
+(defn emit-status!
+  [emit-event state-atom status reason]
+  (emit-event (cond-> {:type "conversation.status"
+                       :agency "conversation"
+                       :status status
+                       :turnId (:turnId @state-atom)
+                       :at (now-ms)}
+                reason (assoc :reason reason))))
+
+(defn create-scheduler
+  [{:keys [state-atom emit-event dispatch-command provider-effector]}]
+  (let [queue (atom [])
+        disposed? (atom false)]
+    (letfn [(enqueue! [step plan]
+              (let [entry (queue-entry step (count @queue) plan)]
+                (swap! queue conj entry)
+                entry))
+
+            (request-tts! [step requested-at]
+              (let [request {:type "tts.requestSpeak"
+                             :agency "conversation"
+                             :targetAgency (get-in @state-atom [:config :ttsAgency])
+                             :requestId (:requestId step)
+                             :text (:text step)
+                             :source (:source step)
+                             :turnId (:turnId @state-atom)
+                             :requestedAt requested-at
+                             :command {:type "speak"
+                                       :text (:text step)
+                                       :source "conversation"}}]
+                (swap! state-atom state/record-tts-request request)
+                (emit-event request)))
+
+            (invoke-provider! [request]
+              (when (:available? provider-effector)
+                ((:invoke provider-effector)
+                 request
+                 (fn [response]
+                   (dispatch-command
+                    {:type "responseReady"
+                     :requestId (:requestId request)
+                     :turnId (:turnId request)
+                     :text (or (:text response)
+                               (:responseText response)
+                               (:agentText response))
+                     :source (or (:source response)
+                                 (get-in @state-atom [:config :responseSource]))}))
+                 (fn [error]
+                   (dispatch-command
+                    {:type "providerError"
+                     :requestId (:requestId request)
+                     :turnId (:turnId request)
+                     :message (:message error)})))))
+
+            (execute-step! [step command plan]
+              (let [now (now-ms)]
+                (enqueue! step plan)
+                (case (:op step)
+                  "apply-config"
+                  (do
+                    (swap! state-atom state/configure (:config command))
+                    (emit-status! emit-event state-atom (:status @state-atom) "configured"))
+
+                  "start-session"
+                  (do
+                    (swap! state-atom state/mark-started now)
+                    (emit-status! emit-event state-atom "listening" nil))
+
+                  "stop-session"
+                  (do
+                    (swap! state-atom state/mark-stopped now (:reason step))
+                    (emit-status! emit-event state-atom "idle" (:reason step)))
+
+                  "reset-state"
+                  (do
+                    (swap! state-atom state/reset-state)
+                    (emit-status! emit-event state-atom "idle" "reset"))
+
+                  "record-user-utterance"
+                  (swap! state-atom state/record-user-utterance (:text step) now (:source step))
+
+                  "emit-user-utterance"
+                  (emit-event {:type "conversation.userUtterance"
+                               :agency "conversation"
+                               :text (:text step)
+                               :source (:source step)
+                               :turnId (:turnId @state-atom)
+                               :at now})
+
+                  "request-response"
+                  (let [request (:request step)]
+                    (swap! state-atom state/record-response-request request)
+                    (emit-event (assoc request
+                                       :type "conversation.requestResponse"
+                                       :agency "conversation"
+                                       :targetAgency "conversation-provider")))
+
+                  "invoke-provider"
+                  (invoke-provider! (:request step))
+
+                  "cancel-provider"
+                  (when-let [request-id (:requestId step)]
+                    ((:cancel provider-effector) request-id))
+
+                  "record-agent-utterance"
+                  (do
+                    (swap! state-atom state/record-agent-utterance (:text step) now (:source step))
+                    (emit-event {:type "conversation.agentUtterance"
+                                 :agency "conversation"
+                                 :text (:text step)
+                                 :source (:source step)
+                                 :turnId (:turnId @state-atom)
+                                 :at now}))
+
+                  "request-tts"
+                  (request-tts! step now)
+
+                  "record-provider-error"
+                  (swap! state-atom state/record-provider-error
+                         (:requestId step)
+                         (:message step)
+                         now)
+
+                  "publish-provider-error"
+                  (emit-event {:type "conversation.providerError"
+                               :agency "conversation"
+                               :requestId (:requestId step)
+                               :turnId (:turnId step)
+                               :message (:message step)
+                               :at now})
+
+                  "cancel-turn"
+                  (swap! state-atom state/record-cancel now (:reason step))
+
+                  "publish-cancel"
+                  (emit-event {:type "conversation.cancelRequested"
+                               :agency "conversation"
+                               :targetAgency (get-in @state-atom [:config :ttsAgency])
+                               :reason (:reason step)
+                               :turnId (:turnId @state-atom)
+                               :at now})
+
+                  "ignore-stale-response"
+                  (emit-event {:type "conversation.ignored"
+                               :agency "conversation"
+                               :reason (:reason step)
+                               :requestId (:requestId step)
+                               :turnId (:turnId step)
+                               :at now})
+
+                  "record-tts-status"
+                  (swap! state-atom assoc
+                         :status (or (:status step) (:status @state-atom))
+                         :lastEvent {:type "conversation.ttsStatus"
+                                     :status (:status step)
+                                     :at now})
+
+                  "publish-status"
+                  (emit-status! emit-event state-atom (:status step) (:reason step))
+
+                  "fail"
+                  (emit-event {:type "error"
+                               :agency "conversation"
+                               :message (:reason step)
+                               :commandType (:commandType step)})
+
+                  nil)))]
+      {:schedule
+       (fn [command plan]
+         (when-not @disposed?
+           (doseq [step (:steps plan)]
+             (execute-step! step command plan))))
+
+       :queue
+       (fn []
+         @queue)
+
+       :dispose
+       (fn []
+         (reset! disposed? true)
+         ((:dispose provider-effector))
+         (reset! queue []))})))