From 22011e8451603ab7251e8d42bcbe516518e63d8c Mon Sep 17 00:00:00 2001 From: Daniel Ziltener Date: Sun, 15 May 2022 00:30:10 +0200 Subject: [PATCH] Partial API implementation --- chicken-on-a-raft.impl.scm | 150 ++++++++++++++++++++++++++++++++++--- 1 file changed, 138 insertions(+), 12 deletions(-) diff --git a/chicken-on-a-raft.impl.scm b/chicken-on-a-raft.impl.scm index 1cc1030..b6a14ee 100644 --- a/chicken-on-a-raft.impl.scm +++ b/chicken-on-a-raft.impl.scm @@ -2,7 +2,8 @@ (import (r7rs)) (import (scheme base)) -(import (srfi 180)) +(import (srfi 1) + (srfi 180)) (import coops coops-extras coops-primitive-objects coops-utils) (import (chicken process) (chicken gc) @@ -23,14 +24,26 @@ (set-finalizer! browser (lambda (obj) (terminate browser))) (call-next-method)) +(define (raise-error error-alist) + (print "BOOM!") + (error (alist-ref 'error error-alist) + error-alist)) + +(define-method (read-reply (browser )) + (lambda () + (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))) + (let ((reply + (with-input-from-request + (make-request method: method + uri: (uri-reference (string-append (base-url browser) path)) + headers: (headers `((content-type application/json)))) + (lambda () (json-write struct)) + (read-reply browser)))) + (if (and (list? reply) (find (lambda (x) (eqv? (car x) 'error)) reply)) + (raise-error (alist-ref 'error reply)) + reply))) (define-method (initialize-session (browser )) (set! (session browser) (alist-ref 'sessionId (send browser '() "session" 'POST)))) @@ -43,7 +56,6 @@ (string-append "session/" (session browser) "/" path) method)) -;; TODO: Apparently session has to be closed first (define-method (terminate (browser )) (call/cc (lambda (c) @@ -68,14 +80,26 @@ 'stderr stderr 'pid pid))) -(define-method (send (browser ) struct path method) - (let ((result (call-next-method))) - (alist-ref 'value result))) +(define-method (read-reply (browser )) + (lambda () + (alist-ref 'value (json-read)))) ;; ======================= ;; Main API Implementation ;; ======================= +(define-method (status (browser )) + (send browser '() "status" 'GET)) + +(define-method (maximize! (browser )) + (send-with-session browser '() "maximize" 'POST)) + +(define-method (minimize! (browser )) + (send-with-session browser '() "minimize" 'POST)) + +(define-method (fullscreen! (browser )) + (send-with-session browser '() "fullscreen" 'POST)) + (define-method (forward! (browser )) (send-with-session browser '() "forward" 'POST)) @@ -96,3 +120,105 @@ (define-method (source (browser )) (send-with-session browser '() "source" 'GET)) + +;; ============================= +;; Timeout Settings +;; ============================= +(define-record timeouts script page-load implicit) +(define-method (get-timeouts (browser )) + (let ((result (send-with-session browser '() "timeouts" 'GET))) + (make-timeouts (alist-ref 'script result) + (alist-ref 'pageLoad result) + (alist-ref 'implicit result)))) +(define-method (timeouts! (browser ) timeouts) + (let ((timeouts-alist `((script . ,(timeouts-script timeouts)) + (pageLoad . ,(timeouts-page-load timeouts)) + (implicit . ,(timeouts-implicit timeouts))))) + (send-with-session browser timeouts-alist "timeouts" 'POST))) + +;; ============================= +;; Elements +;; ============================= + +(define-record element id) +(define locator-strategies '((css: . "css selector") + (linktext: . "link text") + (partial-linktext: . "partial link text") + (tag: . "tag name") + (xpath: . "xpath"))) +(define-method (get-element (browser ) (locator-strategy ) (locator )) + (make-element + (cdar + (send-with-session browser `((using . ,(alist-ref locator-strategy locator-strategies)) + (value . ,locator)) + "element" 'POST)))) +(define-method (get-elements (browser ) (locator-strategy ) (locator )) + (map (lambda (elem) (make-element (cdar elem))) + (send-with-session browser `((using . ,(alist-ref locator-strategy locator-strategies)) + (value . ,locator)) + "elements" 'POST))) + +(define-method (element-selected? (browser ) elem) + (send-with-session browser '() + (string-append "element/" (element-id elem) "/selected") + 'GET)) + +(define-method (element-attribute (browser ) elem attribute) + (send-with-session browser '() + (string-append "element/" (element-id elem) "/attribute/" attribute) + 'GET)) + +(define-method (element-property (browser ) elem property) + (send-with-session browser '() + (string-append "element/" (element-id elem) "/property/" property) + 'GET)) + +(define-method (element-css-value (browser ) elem property) + (send-with-session browser '() + (string-append "element/" (element-id elem) "/css/" property) + 'GET)) + +(define-method (element-text (browser ) elem) + (send-with-session browser '() + (string-append "element/" (element-id elem) "/text") + 'GET)) + +(define-method (element-tag-name (browser ) elem) + (send-with-session browser '() + (string-append "element/" (element-id elem) "/name") + 'GET)) + +(define-method (element-rect (browser ) elem) + (send-with-session browser '() + (string-append "element/" (element-id elem) "/rect") + 'GET)) + +(define-method (element-enabled? (browser ) elem) + (send-with-session browser '() + (string-append "element/" (element-id elem) "/enabled") + 'GET)) + +(define-method (element-computed-role (browser ) elem) + (send-with-session browser '() + (string-append "element/" (element-id elem) "/computedrole") + 'GET)) + +(define-method (element-computed-label (browser ) elem) + (send-with-session browser '() + (string-append "element/" (element-id elem) "/computedlabel") + 'GET)) + +(define-method (element-click (browser ) elem) + (send-with-session browser '() + (string-append "element/" (element-id elem) "/click") + 'POST)) + +(define-method (element-clear (browser ) elem) + (send-with-session browser '() + (string-append "element/" (element-id elem) "/clear") + 'POST)) + +(define-method (element-type-text (browser ) elem text) + (send-with-session browser `((text . ,text)) + (string-append "element/" (element-id elem) "/value") + 'POST))