Adding coops

This commit is contained in:
Daniel Ziltener 2022-05-12 02:12:50 +02:00
parent d244cd7181
commit 635014400a
2 changed files with 33 additions and 10 deletions

View File

@ -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

View File

@ -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)))