wip

web-driver/web-driver.factor

@@ -3,9 +3,12 @@ USING: prettyprint ;
 
 IN: web-driver
 
+
+
 SYMBOL: current-session-id
 SYMBOL: current-remote-host
 
+! https://www.w3.org/TR/webdriver/#elements
 CONSTANT: web-element-identifier "element-6066-11e4-a52e-4f735466cecf"
 
 CONSTANT: css-location-strategy               "css selector"
@@ -14,8 +17,8 @@ CONSTANT: partial-link-text-location-strategy "partial link text"
 CONSTANT: tag-name-location-strategy          "tag name"
 CONSTANT: xpath-location-strategy             "xpath"
 
-TUPLE: session-status
-    message ready? ;
+TUPLE: web-driver uri session-id process ;
+TUPLE: session-status message ready? ;
 
 : current-session-relative-url ( -- url )
     "session" current-session-id get append-path >url ;
@@ -36,19 +39,19 @@ TUPLE: session-status
     swap append-path
     [ "element" <web-driver-session-url> present ] dip append-path >url ;
 
+: <web-driver-post-data> ( hashtable -- post-data )
+    "application/json" <post-data> swap
+    [ >json utf8 encode ] [ B{ 123 125 } ] if* >>data ;
+
 : <web-driver-get-request> ( path -- request )
     <web-driver-url> <get-request> ;
 
 : <web-driver-post-request> ( data path -- request )
-    <web-driver-url> <post-request> ;
+    [ <web-driver-post-data> ] dip <web-driver-url> <post-request> ;
 
 : <web-driver-delete-request> ( path -- request )
     <web-driver-url> <delete-request> ;
 
-: <web-driver-post-data> ( hashtable -- post-data )
-    "application/json" <post-data> swap
-    [ >json utf8 encode ] [ B{ 123 125 } ] if* >>data ;
-
  : <session-post-request> ( data path -- request )
      [ <web-driver-post-data> ] dip <web-driver-session-url> <post-request> ;
 
@@ -67,7 +70,19 @@ TUPLE: session-status
  : http-web-driver-request ( request -- data )
      http-request nip json> "value" of ;
 
- ! sessions
+! Capabilities
+! https://www.w3.org/webdriver/#capabilities
+TUPLE: capabilities { always-match hashtable } { first-match hashtable } ;
+
+: <capabilities> ( always-match first-match -- capabilities )
+    [ [ H{ } ] unless* ] bi@ capabilities boa ;
+
+: capabilities>json ( capabilities -- string )
+    [ always-match>> ] [ first-match>> ] bi
+    'H{ { "alwaysMatch" _ } { "firstMatch" _ } } 'H{ { "capabilities" _ } } ;
+
+ ! Sessions
+ ! https://www.w3.org/TR/webdriver/#sessions
 
  : status ( -- session-status )
      "status" <web-driver-get-request> http-web-driver-request
@@ -83,13 +98,32 @@ TUPLE: session-status
 : delete-current-session ( -- )
     current-session-id get delete-session ;
 
-! navigation
+! Timeouts
+! https://www.w3.org/TR/webdriver/#timeouts
+
+TUPLE: timeouts
+    { script initial: 30000 }
+    { page-load initial: 300000 }
+    { implicit initial: 0 } ;
+
+: get-timeouts ( -- timeouts )
+    "timeouts" <session-get-request> http-web-driver-request
+    [ "script" of ] [ "pageload" of ] [ "implicit" of ] tri
+    timeouts boa ;
+
+: set-timeouts ( timeouts -- )
+    [ script>> ] [ page-load>> ] [ implicit>> ] tri
+    'H{ { "script" _  } { "pageLoad" _ } { "implicit" _ } }
+    "timeouts" <session-post-request> http-web-driver-request drop ;
+
+! Navigation
+! https://www.w3.org/TR/webdriver/#navigation
 
 : get-current-url ( -- url )
     "url" <session-get-request> http-web-driver-request >url ;
 
 : navigate-to ( url -- )
-    present '{ { "url" _ } } >hashtable "url" <session-post-request> http-web-driver-request drop ;
+      present 'H{ { "url" _ } } "url" <session-post-request> http-web-driver-request drop ;
 
 : back ( -- )
     f "back" <session-post-request> http-web-driver-request drop ;
@@ -106,7 +140,7 @@ TUPLE: web-element id ;
 C: <web-element> web-element
 
 : <locator> ( using value -- hashtable )
-    [ "value" swap 2array ] [ "using" swap 2array ] bi* 2array >hashtable ;
+    'H{ { "value" _ } { "using" _ } } ;
 
 : <css-locator> ( value -- hashtable )
     css-location-strategy <locator> ;
@@ -212,7 +246,7 @@ TUPLE: rect x y width height ;
     f "clear" <element-post-request> http-web-driver-request drop ;
 
 : element-send-keys ( element value -- )
-    '{ { "text" _ } } >hashtable "value" <element-post-request> http-web-driver-request drop ;
+    'H{ { "text" _ } } "value" <element-post-request> http-web-driver-request drop ;
 
 ! document handling
 
@@ -220,12 +254,12 @@ TUPLE: rect x y width height ;
     "source" <session-get-request> http-web-driver-request ;
 
 : execute-script ( script arguments -- return )
-    '{ { "script" _ } { "args" _ } } >hashtable "execute/sync" <session-post-request> http-web-driver-request ;
+    'H{ { "script" _ } { "args" _ } } "execute/sync" <session-post-request> http-web-driver-request ;
 
 : execute-async-script ( script arguments -- return )
-    '{ { "script" _ } { "args" _ } } >hashtable "execute/async" <session-post-request> http-web-driver-request ;
+    'H{ { "script" _ } { "args" _ } } "execute/async" <session-post-request> http-web-driver-request ;
 
-! cookies
+! cooHkies
 
 ! TODO: samesite?
 
@@ -257,7 +291,23 @@ TUPLE: rect x y width height ;
 : delete-all-cookies ( -- )
     "cookie" <session-delete-request> http-web-driver-request drop ;
 
-! screen capture
+! User prompts
+! https://www.w3.org/TR/webdriver/#user-prompts
+
+: dismiss-alert ( -- )
+    f "alert/dismiss" <session-post-request> http-web-driver-request drop ;
+
+: accept-alert ( -- )
+    f "alert/accept" <session-post-request> http-web-driver-request drop ;
+
+: get-alert-test ( -- text )
+    "alert/accept" <session-get-request> http-web-driver-request ;
+
+: send-alert-text ( text -- )
+    'H{ { "text" _ } } "alert/accept" <session-post-request> http-web-driver-request drop ;
+
+! Screen capture
+! https://www.w3.org/TR/webdriver/#screen-capture
 
 : take-screenshot ( -- loading-png )
     "screenshot" <session-get-request> http-web-driver-request