initial web-driver
parent
260d2fb9da
commit
d4065dcc3f
|
|
@ -0,0 +1,150 @@
|
|||
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: prettyprint ;
|
||||
|
||||
IN: web-driver
|
||||
|
||||
SYMBOL: current-session-id
|
||||
SYMBOL: current-remote-host
|
||||
|
||||
CONSTANT: web-element-identifier "element-6066-11e4-a52e-4f735466cecf"
|
||||
|
||||
CONSTANT: css-location-strategy "css selector"
|
||||
CONSTANT: link-text-location-strategy "link text"
|
||||
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? ;
|
||||
|
||||
: current-session-relative-url ( -- url )
|
||||
"session" current-session-id get append-path >url ;
|
||||
|
||||
: current-base-url ( -- url )
|
||||
current-remote-host get >url ;
|
||||
|
||||
: current-session-url ( -- url )
|
||||
current-base-url current-session-relative-url derive-url ;
|
||||
|
||||
: <web-driver-url> ( path -- url )
|
||||
[ current-base-url ] dip >url derive-url ;
|
||||
|
||||
: <web-driver-session-url> ( path -- url )
|
||||
[ current-session-url present ] dip append-path >url ;
|
||||
|
||||
: <web-driver-element-url> ( path id -- url )
|
||||
swap append-path
|
||||
[ "element" <web-driver-session-url> present ] dip append-path >url ;
|
||||
|
||||
: <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-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> ;
|
||||
|
||||
: <session-get-request> ( path -- request )
|
||||
<web-driver-session-url> <get-request> ;
|
||||
|
||||
: <session-delete-request> ( path -- request )
|
||||
<web-driver-session-url> <delete-request> ;
|
||||
|
||||
: <element-get-request> ( path element -- request )
|
||||
id>> <web-driver-element-url> <get-request> ;
|
||||
|
||||
: <element-post-request> ( data path id -- request )
|
||||
id>> <web-driver-element-url> [ <web-driver-post-data> ] dip <post-request> ;
|
||||
|
||||
: http-web-driver-request ( request -- data )
|
||||
http-request nip json> "value" of ;
|
||||
|
||||
! sessions
|
||||
|
||||
: status ( -- session-status )
|
||||
"status" <web-driver-get-request> http-web-driver-request
|
||||
[ "message" of ] [ "ready" of ] bi session-status boa ;
|
||||
|
||||
: new-session ( capabilities -- json )
|
||||
"session" <web-driver-post-request> http-web-driver-request
|
||||
dup "sessionId" of current-session-id set ;
|
||||
|
||||
: delete-session ( id -- )
|
||||
<web-driver-delete-request> http-web-driver-request drop ;
|
||||
|
||||
: delete-current-session ( -- )
|
||||
current-session-id get delete-session ;
|
||||
|
||||
! navigation
|
||||
|
||||
: get-current-url ( -- url )
|
||||
"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 ;
|
||||
|
||||
: back ( -- )
|
||||
f "back" <session-post-request> http-web-driver-request drop ;
|
||||
|
||||
: refresh ( -- )
|
||||
f "refresh" <session-post-request> http-web-driver-request drop ;
|
||||
|
||||
: title ( -- title )
|
||||
"title" <session-get-request> http-web-driver-request ;
|
||||
|
||||
! elements
|
||||
|
||||
TUPLE: web-element id ;
|
||||
C: <web-element> web-element
|
||||
|
||||
: find-element ( using value -- element )
|
||||
[ "using" swap 2array ] [ "value" swap 2array ] bi* 2array >hashtable
|
||||
"element" <session-post-request> http-web-driver-request
|
||||
web-element-identifier of <web-element> ;
|
||||
|
||||
: find-elements ( using value -- 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 )
|
||||
link-text-location-strategy swap find-element ;
|
||||
|
||||
: find-element/partial-link-text ( value -- element )
|
||||
partial-link-text-location-strategy swap find-element ;
|
||||
|
||||
: find-element/tag-name ( value -- element )
|
||||
tag-name-location-strategy swap find-element ;
|
||||
|
||||
: find-element/xpath ( value -- element )
|
||||
xpath-location-strategy swap find-element ;
|
||||
|
||||
: find-element-by-id ( id -- element )
|
||||
"#" prepend find-element/css-selector ;
|
||||
|
||||
: find-element-by-class-name ( name -- element )
|
||||
"." prepend find-element/css-selector ;
|
||||
|
||||
: active-element ( -- element )
|
||||
"element/active" <session-get-request> http-web-driver-request ;
|
||||
|
||||
! TODO: handle driver processes better
|
||||
|
||||
: <chrome-driver-stream> ( url capabilities -- stream )
|
||||
2drop
|
||||
"chromedriver --silent --port 4444" utf8 <process-stream> ;
|
||||
|
||||
: <gecko-driver-stream> ( url capabilities -- stream )
|
||||
2drop
|
||||
"geckodriver --port 4444" utf8 <process-stream> ;
|
||||
Loading…
Reference in New Issue