Adding coops
This commit is contained in:
parent
d244cd7181
commit
635014400a
|
@ -3,7 +3,7 @@
|
||||||
(synopsis "Cleanroom WebDriver implementation")
|
(synopsis "Cleanroom WebDriver implementation")
|
||||||
(category testing)
|
(category testing)
|
||||||
(license "BSD")
|
(license "BSD")
|
||||||
(dependencies utf8 r7rs http-client srfi-180)
|
(dependencies utf8 r7rs http-client srfi-99 srfi-180)
|
||||||
(test-dependencies srfi-78)
|
(test-dependencies srfi-78)
|
||||||
(components
|
(components
|
||||||
(extension chicken-on-a-raft
|
(extension chicken-on-a-raft
|
||||||
|
|
|
@ -3,15 +3,38 @@
|
||||||
(import (r7rs))
|
(import (r7rs))
|
||||||
(import (scheme base))
|
(import (scheme base))
|
||||||
(import (srfi 180))
|
(import (srfi 180))
|
||||||
|
(import (srfi 99))
|
||||||
|
(import coops)
|
||||||
(import (chicken process))
|
(import (chicken process))
|
||||||
|
(import intarweb)
|
||||||
(import http-client)
|
(import http-client)
|
||||||
|
|
||||||
(define (firefox)
|
(define-class <Browser> ()
|
||||||
(let-values (((stdout stdin pid stderr) (process* "geckodriver"))
|
(url stdout stdin stderr pid))
|
||||||
(host "127.0.0.1")
|
|
||||||
(port "4444")
|
(define-method (terminate (browser <Browser>))
|
||||||
)
|
(process-signal (slot-value browser 'pid)))
|
||||||
(lambda (msg #!optional args)
|
|
||||||
(case msg
|
(define-method (initialize-instance (browser <Browser>))
|
||||||
((test) (print "Test"))
|
(call-next-method)
|
||||||
((test-with-args) (print "Args:" args))))))
|
(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)))
|
||||||
|
|
Loading…
Reference in New Issue