(module selenium mzscheme

  (require
   (lib "etc.ss")
   (lib "include.ss")
   (lib "plt-match.ss")
   (lib "list.ss" "srfi" "1")
   (lib "uri-codec.ss" "net")
   (lib "url.ss" "net")
   (planet "aif.ss" ("schematics" "macro.plt" 1))
   (planet "parameter.ss" ("untyped" "unlib.plt" 1))
   (planet "exn.ss" ("untyped" "unlib.plt" 1))
   (file "support.ss"))

  (provide
   with-selenium
   (rename create-selenium-server selenium-server)
   exn:selenium?
   exn:selenium:bad-response?

   click
   double-click
   click-at
   double-click-at
   fire-event
   key-press
   shift-key-down
   shift-key-up
   meta-key-down
   meta-key-up
   alt-key-down
   alt-key-up
   control-key-down
   control-key-up
   key-down
   key-up
   mouse-over
   mouse-out
   mouse-down
   mouse-down-at
   mouse-up
   mouse-up-at
   mouse-move
   mouse-move-at
   type
   type-keys
   set-speed
   get-speed
   check
   uncheck
   select
   add-selection
   remove-selection
   remove-all-selections
   submit
   open
   open-window
   select-window
   select-frame
   get-log-messages
   get-whether-this-frame-match-frame-expression
   get-whether-this-window-match-window-expression
   wait-for-pop-up
   choose-cancel-on-next-confirmation
   answer-on-next-prompt
   go-back
   refresh
   close
   is-alert-present
   is-prompt-present
   is-confirmation-present
   get-alert
   get-confirmation
   get-prompt
   get-location
   get-title
   get-body-text
   get-value
   get-text
   highlight
   get-eval
   is-checked
   get-table
   get-selected-labels
   get-selected-label
   get-selected-values
   get-selected-value
   get-selected-indexes
   get-selected-index
   get-selected-ids
   get-selected-id
   is-something-selected
   get-select-options
   get-attribute
   is-text-present
   is-element-present
   is-visible
   is-editable
   get-all-buttons
   get-all-links
   get-all-fields
   get-attribute-from-all-windows
   dragdrop
   set-mouse-speed
   get-mouse-speed
   drag-and-drop
   drag-and-drop-to-object
   window-focus
   window-maximize
   get-all-window-ids
   get-all-window-names
   get-all-window-titles
   get-html-source
   set-cursor-position
   get-element-index
   is-ordered
   get-element-position-left
   get-element-position-top
   get-element-width
   get-element-height
   get-cursor-position
   set-context
   get-expression
   wait-for-condition
   set-timeout
   wait-for-page-to-load
   get-cookie
   create-cookie
   delete-cookie)
 
  ;;; Infrastructure -------------------------------------------
  
  ;; struct selenium-server : string integer string string (U integer #f)
  (define-struct server (host port browser target session) #f)

  (define (create-selenium-server host port browser target)
    (make-server host port browser target #f))

  (define-struct (exn:selenium exn) ())
  (define-struct (exn:selenium:bad-response exn:selenium) ())
  
  ;; current-selenium-server : (parameter-of (U #f selenium-server))
  (define-parameter current-selenium-server
    #f
    (make-guard server?
                "selenium-server")
    with-selenium-server)
  
  (define-syntax with-selenium
    (syntax-rules ()
      [(with-selenium server cmd ...)
       (with-selenium-server
        server
        (dynamic-wind
            (lambda () (start!))
            (lambda () cmd ...)
            (lambda () (stop!))))]))

  ;; send-command : string string ... -> string
  (define (send-command cmd . args)
    (parameterize
        ([current-alist-separator-mode 'amp])
      (let* ([server (current-selenium-server)]
             [cmd (apply
                   string-append
                   "http://"
                   (server-host server)
                   ":"
                   (number->string (server-port server))
                   "/selenium-server/driver/?cmd="
                   (uri-encode cmd)
                   (aif session (server-session server)
                       (string-append "&sessionId="
                                      (number->string session))
                       "")
                   (map
                    (lambda (arg number)
                      (string-append
                       "&"
                       (number->string number)
                       "="
                       (uri-encode (format "~a" arg))))
                    args
                    (iota (length args) 1)))]
             [ip (get-pure-port (string->url cmd))]
             [response (read-line ip)])
        (close-input-port ip)
        (if (regexp-match #rx"^OK" response)
            response
            (raise-exn
             exn:selenium:bad-response
             (format "Did not receive 'OK' response.  Instead, server responded with: ~a" response))))))
  

  ;; read-response : string [(string -> 'a)] -> 'a
  (define read-response
    (opt-lambda (response [converter (lambda (x) x)])
      (match (regexp-match #rx"^OK,(.*)$" response)
        [(list full result) (converter result)]
        [err (raise-exn
              exn:selenium:bad-response
              (format "Bad response: ~a/~a" response err))])))

  
  ;;; Commands -------------------------------------------------

  ;; start! : () -> integer
  (define (start!)
    (let* ([server (current-selenium-server)]
           [session (read-response
                     (send-command "getNewBrowserSession"
                                   (server-browser server)
                                   (server-target server))
                    string->number)])
      (set-server-session! server session)
      session))

  ;; stop! : () -> void
  (define (stop!)
    (let ([server (current-selenium-server)])
      (send-command "testComplete")
      (set-server-session! server #f)))

  ;; Include the rest of the commands that are autogenerated
  ;; from the Selenium API
  (include "commands.scm")
  
  )