From 635014400ab0574d23f6a71dc01ab13e442269d1 Mon Sep 17 00:00:00 2001
From: Daniel Ziltener <dziltener@lyrion.ch>
Date: Thu, 12 May 2022 02:12:50 +0200
Subject: [PATCH] Adding coops

---
 chicken-on-a-raft.egg      |  2 +-
 chicken-on-a-raft.impl.scm | 41 +++++++++++++++++++++++++++++---------
 2 files changed, 33 insertions(+), 10 deletions(-)

diff --git a/chicken-on-a-raft.egg b/chicken-on-a-raft.egg
index ff6830b..8379235 100644
--- a/chicken-on-a-raft.egg
+++ b/chicken-on-a-raft.egg
@@ -3,7 +3,7 @@
  (synopsis "Cleanroom WebDriver implementation")
  (category testing)
  (license "BSD")
- (dependencies utf8 r7rs http-client srfi-180)
+ (dependencies utf8 r7rs http-client srfi-99 srfi-180)
  (test-dependencies srfi-78)
  (components
    (extension chicken-on-a-raft
diff --git a/chicken-on-a-raft.impl.scm b/chicken-on-a-raft.impl.scm
index ed01f3c..5c59e3b 100644
--- a/chicken-on-a-raft.impl.scm
+++ b/chicken-on-a-raft.impl.scm
@@ -3,15 +3,38 @@
 (import (r7rs))
 (import (scheme base))
 (import (srfi 180))
+(import (srfi 99))
+(import coops)
 (import (chicken process))
+(import intarweb)
 (import http-client)
 
-(define (firefox)
-  (let-values (((stdout stdin pid stderr) (process* "geckodriver"))
-               (host "127.0.0.1")
-               (port "4444")
-               )
-    (lambda (msg #!optional args)
-      (case msg
-        ((test) (print "Test"))
-        ((test-with-args) (print "Args:" args))))))
+(define-class <Browser> ()
+  (url stdout stdin stderr pid))
+
+(define-method (terminate (browser <Browser>))
+  (process-signal (slot-value browser 'pid)))
+
+(define-method (initialize-instance (browser <Browser>))
+  (call-next-method)
+  (set-finalizer! browser (lambda (obj) (terminate browser))))
+
+(define-method (send (browser <Browser>) struct #!key to path using method)
+  (with-input-from-request
+   (make-request method: method
+                 uri: (uri-reference (string-append (slot-value browser 'url) path))
+                 headers: (headers `((content-type application/json))))
+   (lambda () (json-write struct))
+   json-read))
+
+(define-class <Firefox> (<Browser>))
+
+(define (firefox #!key ip ip port port)
+  (let-values (((stdout stdin pid stderr) (process* "geckodriver")))
+    (make <Browser>
+      url: (string-append "http://" (or ip "127.0.0.1")
+                          ":" (or port "4444") "/")
+      stdout: stdout
+      stdin: stdin
+      stderr: stderr
+      pid: pid)))