Partial API implementation

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 <Browser>))
+  (lambda ()
+    (json-read)))
+
 (define-method (send (browser <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 <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 <Browser>))
   (call/cc
    (lambda (c)
@@ -68,14 +80,26 @@
       'stderr stderr
       'pid pid)))
 
-(define-method (send (browser <Firefox>) struct path method)
-  (let ((result (call-next-method)))
-    (alist-ref 'value result)))
+(define-method (read-reply (browser <Firefox>))
+  (lambda ()
+    (alist-ref 'value (json-read))))
 
 ;; =======================
 ;; Main API Implementation
 ;; =======================
 
+(define-method (status (browser <Browser>))
+  (send browser '() "status" 'GET))
+
+(define-method (maximize! (browser <Browser>))
+  (send-with-session browser '() "maximize" 'POST))
+
+(define-method (minimize! (browser <Browser>))
+  (send-with-session browser '() "minimize" 'POST))
+
+(define-method (fullscreen! (browser <Browser>))
+  (send-with-session browser '() "fullscreen" 'POST))
+
 (define-method (forward! (browser <Browser>))
   (send-with-session browser '() "forward" 'POST))
 
@@ -96,3 +120,105 @@
 
 (define-method (source (browser <Browser>))
   (send-with-session browser '() "source" 'GET))
+
+;; =============================
+;; Timeout Settings
+;; =============================
+(define-record timeouts script page-load implicit)
+(define-method (get-timeouts (browser <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 <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 <Browser>) (locator-strategy <keyword>) (locator <string>))
+  (make-element
+   (cdar
+    (send-with-session browser `((using . ,(alist-ref locator-strategy locator-strategies))
+                                 (value . ,locator))
+                       "element" 'POST))))
+(define-method (get-elements (browser <Browser>) (locator-strategy <keyword>) (locator <string>))
+  (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 <Browser>) elem)
+  (send-with-session browser '()
+                     (string-append "element/" (element-id elem) "/selected")
+                     'GET))
+
+(define-method (element-attribute (browser <Browser>) elem attribute)
+  (send-with-session browser '()
+                     (string-append "element/" (element-id elem) "/attribute/" attribute)
+                     'GET))
+
+(define-method (element-property (browser <Browser>) elem property)
+  (send-with-session browser '()
+                     (string-append "element/" (element-id elem) "/property/" property)
+                     'GET))
+
+(define-method (element-css-value (browser <Browser>) elem property)
+  (send-with-session browser '()
+                     (string-append "element/" (element-id elem) "/css/" property)
+                     'GET))
+
+(define-method (element-text (browser <Browser>) elem)
+  (send-with-session browser '()
+                     (string-append "element/" (element-id elem) "/text")
+                     'GET))
+
+(define-method (element-tag-name (browser <Browser>) elem)
+  (send-with-session browser '()
+                     (string-append "element/" (element-id elem) "/name")
+                     'GET))
+
+(define-method (element-rect (browser <Browser>) elem)
+  (send-with-session browser '()
+                     (string-append "element/" (element-id elem) "/rect")
+                     'GET))
+
+(define-method (element-enabled? (browser <Browser>) elem)
+  (send-with-session browser '()
+                     (string-append "element/" (element-id elem) "/enabled")
+                     'GET))
+
+(define-method (element-computed-role (browser <Browser>) elem)
+  (send-with-session browser '()
+                     (string-append "element/" (element-id elem) "/computedrole")
+                     'GET))
+
+(define-method (element-computed-label (browser <Browser>) elem)
+  (send-with-session browser '()
+                     (string-append "element/" (element-id elem) "/computedlabel")
+                     'GET))
+
+(define-method (element-click (browser <Browser>) elem)
+  (send-with-session browser '()
+                     (string-append "element/" (element-id elem) "/click")
+                     'POST))
+
+(define-method (element-clear (browser <Browser>) elem)
+  (send-with-session browser '()
+                     (string-append "element/" (element-id elem) "/clear")
+                     'POST))
+
+(define-method (element-type-text (browser <Browser>) elem text)
+  (send-with-session browser `((text . ,text))
+                     (string-append "element/" (element-id elem) "/value")
+                     'POST))