main.lisp: Reload extensions

Send DevTools Protocol messages to reload extensions. Not easy to do
things sequentially since the responses have to be handled in
`ws-on-message`. Once we filter the list of extensions wanted to reload,
attach to their DevTools targets, then send them JavaScript evaluation
messages that tells the extensions to reload.

1 files changed, 37 insertions, 2 deletions

diff --git a/l/src/main.lisp b/l/src/main.lisp
index 65372d2..31afe73 100644
--- a/l/src/main.lisp
+++ b/l/src/main.lisp
@@ -18,13 +18,38 @@
     `(:obj ("id" . ,call-id)
            ("method" . "Target.getTargets"))))
 
+(defun target-attach-to-target-msg (call-id target-id)
+  (jsown:to-json
+    `(:obj ("id" . ,call-id)
+           ("method" . "Target.attachToTarget")
+           ("params" . (:obj ("targetId" . ,target-id)
+                             ("flatten" . t))))))
+
+(defun target-attached-to-target-msg-p (message)
+  (equal
+    (json-obj-get message "method")
+    "Target.attachedToTarget"))
+
+(defun runtime-evaluate-msg (call-id session-id expression)
+  (jsown:to-json
+    `(:obj ("id" . ,call-id)
+           ("sessionId" . ,session-id)
+           ("method" . "Runtime.evaluate")
+           ("params" . (:obj ("expression" . ,expression))))))
+
 (defun ws-on-message (message)
   (let* ((response (jsown:parse message))
          (targets (parse-get-targets-response response)))
     (if targets
         (reload-extensions
           (extension-targets targets)
-          '("pacpdcpgfbpkdpmhfaljffnfbdanmblh")))))
+          '("pacpdcpgfbpkdpmhfaljffnfbdanmblh")))
+
+    (if (target-attached-to-target-msg-p response)
+        (reload-extension
+          (json-obj-get
+            (json-obj-get response "params")
+            "sessionId")))))
 
 (defun parse-get-targets-response (response)
   (let* ((result (json-obj-get response "result"))
@@ -49,7 +74,17 @@
 
              nil))
 
-    (filter #'requested-extension-p targets)))
+    (dolist (extension (filter #'requested-extension-p targets))
+      (attach-to-target extension))))
+
+(defun attach-to-target (extension)
+  (let ((target-id (json-obj-get extension "targetId")))
+    (wsd:send *client*
+              (target-attach-to-target-msg 2 target-id))))
+
+(defun reload-extension (session-id)
+  (wsd:send *client*
+            (runtime-evaluate-msg 1 session-id "chrome.runtime.reload()")))
 
 (defun extension-targets (targets)
   (labels ((extensionp (target)