diff --git a/chicken-on-a-raft.impl.scm b/chicken-on-a-raft.impl.scm index 5c59e3b..97973cb 100644 --- a/chicken-on-a-raft.impl.scm +++ b/chicken-on-a-raft.impl.scm @@ -3,38 +3,66 @@ (import (r7rs)) (import (scheme base)) (import (srfi 180)) -(import (srfi 99)) -(import coops) -(import (chicken process)) +(import coops coops-extras coops-primitive-objects coops-utils) +(import (chicken process) + (chicken gc) + (chicken condition)) +(import uri-common) (import intarweb) (import http-client) (define-class () - (url stdout stdin stderr pid)) - -(define-method (terminate (browser )) - (process-signal (slot-value browser 'pid))) + ((base-url accessor: base-url) + (stdout accessor: stdout) + (stdin accessor: stdin) + (stderr accessor: stderr) + (pid accessor: pid) + (session accessor: session))) (define-method (initialize-instance (browser )) - (call-next-method) - (set-finalizer! browser (lambda (obj) (terminate browser)))) + (set-finalizer! browser (lambda (obj) (terminate browser))) + (call-next-method)) -(define-method (send (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-method (send (browser ) struct path method) + (let ((uri (string-append (base-url browser) path))) + (with-input-from-request + (make-request method: method + uri: (uri-reference uri) + headers: (headers `((content-type application/json)))) + (lambda () (json-write struct)) + json-read))) + +(define-method (initialize-session (browser )) + (set! (session browser) (alist-ref 'sessionId (send browser '() "session" 'POST)))) + +(define-method (terminate-session (browser )) + (send browser '() (string-append "session/" (session browser)) 'DELETE)) + +;; TODO: Apparently session has to be closed first +(define-method (terminate (browser )) + (call/cc + (lambda (c) + (with-exception-handler + (lambda (x) (c #t)) + (lambda () + (terminate-session browser) + (process-signal (pid browser)) + (close-input-port (stdout browser)) + (close-input-port (stderr browser)) + (close-output-port (stdin browser))))))) (define-class ()) (define (firefox #!key ip ip port port) (let-values (((stdout stdin pid stderr) (process* "geckodriver"))) - (make - url: (string-append "http://" (or ip "127.0.0.1") - ":" (or port "4444") "/") - stdout: stdout - stdin: stdin - stderr: stderr - pid: pid))) + (make + 'base-url (string-append "http://" (or ip "127.0.0.1") + ":" (or port "4444") "/") + 'stdout stdout + 'stdin stdin + 'stderr stderr + 'pid pid))) + +(define-method (send (browser ) struct path method) + (let ((result (call-next-method))) + (alist-ref 'value result)))