added interactions/cookies/document/state

web-driver/web-driver.factor

@@ -1,4 +1,4 @@
-USING: kernel http http.client http.server io.pathnames io.encodings.string io.encodings.utf8 io.launcher accessors urls parser effects.parser words arrays sequences quotations json.reader json.writer formatting assocs namespaces present hashtables ;
+USING: kernel http http.client http.server io.pathnames io.encodings.string io.encodings.utf8 io.launcher accessors urls parser effects.parser words arrays sequences quotations json.reader json.writer formatting assocs namespaces present hashtables words.symbol combinators lexer calendar ;
 USING: prettyprint ;
 
 IN: web-driver
@@ -58,11 +58,11 @@ TUPLE: session-status
  : <session-delete-request> ( path -- request )
      <web-driver-session-url> <delete-request> ;
 
- : <element-get-request> ( path element -- request )
+ : <element-get-request> ( element path -- request )
-     id>> <web-driver-element-url> <get-request> ;
+     swap id>> <web-driver-element-url> <get-request> ;
 
- : <element-post-request> ( data path id -- request )
+ : <element-post-request> ( element data path -- request )
-     id>> <web-driver-element-url> [ <web-driver-post-data> ] dip <post-request> ;
+     swap [ swap id>> <web-driver-element-url> ] dip <web-driver-post-data> swap <post-request> ;
 
  : http-web-driver-request ( request -- data )
      http-request nip json> "value" of ;
@@ -89,7 +89,7 @@ TUPLE: session-status
     "url" <session-get-request> http-web-driver-request >url ;
 
 : navigate-to ( url -- )
-    present "url" swap 2array 1array >hashtable "url" <session-post-request> http-web-driver-request drop ;
+    present '{ { "url" _ } } >hashtable "url" <session-post-request> http-web-driver-request drop ;
 
 : back ( -- )
     f "back" <session-post-request> http-web-driver-request drop ;
@@ -105,40 +105,139 @@ TUPLE: session-status
 TUPLE: web-element id ;
 C: <web-element> web-element
 
-: find-element ( using value -- element )
+: <locator> ( using value -- hashtable )
-    [ "using" swap 2array ] [ "value" swap 2array ] bi* 2array >hashtable
+    [ "value" swap 2array ] [ "using" swap 2array ] bi* 2array >hashtable ;
+
+: <css-locator> ( value -- hashtable )
+    css-location-strategy <locator> ;
+
+: <link-text-locator> ( value -- hashtable )
+    link-text-location-strategy <locator> ;
+
+: <partial-link-text-locator> ( value -- hashtable )
+    partial-link-text-location-strategy <locator> ;
+
+: <tag-name-locator> ( value -- hashtable )
+    tag-name-location-strategy <locator> ;
+
+: <xpath-locator> ( value -- hashtable )
+    xpath-location-strategy <locator> ;
+
+: find-element ( locator -- element )
     "element" <session-post-request> http-web-driver-request
     web-element-identifier of <web-element> ;
 
-: find-elements ( using value -- element )
+: find-elements ( locator -- element )
-    [ "using" swap 2array ] [ "value" swap 2array ] bi* 2array >hashtable
     "elements" <session-post-request> http-web-driver-request
     [ web-element-identifier of <web-element> ] map ;
 
-: find-element/css-selector ( value -- element )
-    css-location-strategy swap find-element ;
 
-: find-element/link-text ( value -- element )
+! TODO: finish the element by definitions
-    link-text-location-strategy swap find-element ;
+!       clean up a little
+<<
+SYNTAX: DEFINE-LOCATORS:
+    scan-token
+    {
+        [
+            [ "find-element" prepend-path create-word-in ]
+            [ "-locator" append "<" ">" surround parse-word 1quotation [ find-element ] compose ( value -- element ) ] bi
+            define-declared
+        ]
+        [
+            [ "find-elements" prepend-path create-word-in ]
+            [ "-locator" append "<" ">" surround parse-word 1quotation [ find-elements ] compose ( value -- seq ) ] bi
+            define-declared
+        ]
+    } cleave ;
+>>
 
-: find-element/partial-link-text ( value -- element )
+DEFINE-LOCATORS: css
-    partial-link-text-location-strategy swap find-element ;
+DEFINE-LOCATORS: link-text
+DEFINE-LOCATORS: partial-link-text
+DEFINE-LOCATORS: tag-name
+DEFINE-LOCATORS: xpath
 
-: find-element/tag-name ( value -- element )
+! some helper css locators
-    tag-name-location-strategy swap find-element ;
 
-: find-element/xpath ( value -- element )
+: maybe-prepend ( string char -- string' )
-    xpath-location-strategy swap find-element ;
+    2dup [ first ] bi@ = [ drop ] [ prepend ] if ;
 
 : find-element-by-id ( id -- element )
-    "#" prepend find-element/css-selector ;
+    "#" maybe-prepend find-element/css ;
+
+: find-elements-by-id ( id -- element )
+    "#" maybe-prepend find-elements/css ;
 
 : find-element-by-class-name ( name -- element )
-    "." prepend find-element/css-selector ;
+    "." maybe-prepend find-element/css ;
+
+: find-elements-by-class-name ( name -- element )
+    "." maybe-prepend find-elements/css ;
 
 : active-element ( -- element )
     "element/active" <session-get-request> http-web-driver-request ;
 
+! element state
+
+: is-element-selected? ( element -- ? )
+    "selected" <element-get-request> http-web-driver-request ;
+
+: get-element-attribute ( element name -- attribute )
+    "attribute" prepend-path <element-get-request> http-web-driver-request ;
+
+: get-element-property ( element name -- property )
+    "property" prepend-path <element-get-request> http-web-driver-request ;
+
+: get-element-css-value ( element property-name -- css-value )
+    "css" prepend-path <element-get-request> http-web-driver-request ;
+
+: get-element-text ( element -- text )
+    "text" <element-get-request> http-web-driver-request ;
+
+: is-element-enabled? ( element -- ? )
+    "enabled" <element-get-request> http-web-driver-request ;
+
+TUPLE: rect x y width height ;
+
+: get-element-rect ( element -- rect )
+    "rect" <element-get-request> http-web-driver-request
+    { [ "x" of ] [ "y" of ] [ "width" of ] [ "height" of ] } cleave rect boa ;
+
+! element interaction
+
+: element-click ( element -- )
+    f "click" <element-post-request> http-web-driver-request drop ;
+
+: element-clear ( element -- )
+    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 ;
+
+! document handling
+
+: get-page-source ( -- source )
+    "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 ;
+
+: execute-async-script ( script arguments -- return )
+    '{ { "script" _ } { "args" _ } } >hashtable "execute/async" <session-post-request> http-web-driver-request ;
+
+! cookies
+
+! TODO: samesite?
+
+: get-all-cookies ( -- cookies )
+    "cookie" <session-get-request> http-web-driver-request 
+     [
+         {
+             [ "name" of ] [ "value" of f f ]  [ "path" of ] [ "domain" of ]
+             [ "expiry" of f swap unix-time>timestamp ] [ "httpOnly" of ] [ "secure" of ]
+         } cleave cookie boa
+     ] map ;
+
 ! TODO: handle driver processes better
 
 : <chrome-driver-stream> ( url capabilities -- stream )