factor-work/web-driver/web-driver.factor

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> ;