command-test.ss
(module command-test mzscheme
  
  (require (all-except (lib "list.ss" "srfi" "1") any)
           (lib "cut.ss" "srfi" "26"))
  
  (require (file "command.ss")
           (file "core.ss")
           (file "selector.ss")
           (file "test-base.ss"))
  
  ; Test suite -----------------------------------
  
  (define command-tests
    (test-suite "command.ss"
      
      (test-case "click, click/wait"
        (let ([request-box (box #f)])
          (open/wait (lambda (request)
                       (send/suspend/dispatch
                        (lambda (embed-url)
                          `(html (head (title "Test form"))
                                 (body (form ([method "POST"] 
                                              [action ,(embed-url (lambda (request)
                                                                    (set-box! request-box request)
                                                                    (send/back '(html (body (p "Submitted"))))))])
                                             ,@(map (lambda (num)
                                                      `(div "Box " ,(number->string num)
                                                            (input ([id ,(format "box~a" num)]
                                                                    [name ,(format "box~a" num)]
                                                                    [class "checkbox"]
                                                                    [type "checkbox"]))))
                                                    (iota 3))
                                             (input ([id "submit"]
                                                     [name "submit"]
                                                     [type "submit"])))))))))
          (click (node/id 'box1))
          (click/wait (node/id 'submit))
          (let ([bindings (request-bindings (unbox request-box))])
            (check-false (exists-binding? 'box0 bindings) "check 1")
            (check-true  (exists-binding? 'box1 bindings) "check 2")
            (check-false (exists-binding? 'box2 bindings) "check 3"))))
      
      (test-case "click, select, type and click/wait"
        (let ([request-box (box #f)])
          (open/wait (lambda (request)
                       (send/suspend/dispatch
                        (lambda (embed-url)
                          `(html (head (title "Test form"))
                                 (body (form ([method "POST"]
                                              [action ,(embed-url (lambda (request)
                                                                    (set-box! request-box request)
                                                                    (send/back '(html (body (p "Submitted"))))))])
                                             (input ([id "check-box"] [name "check-box"] [type "checkbox"]))
                                             (select ([id "select"] [name "select"])
                                                     (option ([value "value1"]) "Value 1")
                                                     (option ([value "value2"]) "Value 2")
                                                     (option ([value "value3"]) "Value 3"))
                                             (input ([id "text-field"] [name "text-field"] [type "text"]))
                                             (input ([id "submit"] [name "submit"] [type "submit"])))))))))
          (click (node/id 'check-box))
          (select (node/id 'select) "value2")
          (type (node/id 'text-field) "Sample text")
          (check-exn exn:fail:delirium? (cut click (node/id 'does-not-exist)))
          (check-exn exn:fail:delirium? (cut select (node/id 'does-not-exist) "value"))
          (check-exn exn:fail:delirium? (cut type (node/id 'does-not-exist) "Text"))
          (click/wait (node/id 'submit))
          (let ([bindings (request-bindings (unbox request-box))])
            (check-true (exists-binding? 'check-box bindings) "check 1")
            (check-true (exists-binding? 'select bindings) "check 2")
            (check-equal? (extract-binding/single 'select bindings) "value2" "check 3")
            (check-true (exists-binding? 'text-field bindings) "check 4")
            (check-equal? (extract-binding/single 'text-field bindings) "Sample text" "check 5"))))

      (test-case
       "click*, select*, type*, and click/wait*"
       (let ([request-box (box #f)])
         (open/wait (lambda (request)
                      (send/suspend/dispatch
                       (lambda (embed-url)
                         `(html (head (title "Test form"))
                                (body (form ([method "POST"]
                                             [action ,(embed-url (lambda (request)
                                                                   (set-box! request-box request)
                                                                   (send/back '(html (body (p "Submitted"))))))])
                                            (input ([id "check-box1"] [name "check-box1"] [type "checkbox"]))
                                            (input ([id "check-box2"] [name "check-box2"] [type "checkbox"]))
                                            (select ([id "select1"] [name "select1"])
                                                    (option ([value "value1"]) "Value 1")
                                                    (option ([value "value2"]) "Value 2")
                                                    (option ([value "value3"]) "Value 3"))
                                            (select ([id "select2"] [name "select2"])
                                                    (option ([value "value1"]) "Value 1")
                                                    (option ([value "value2"]) "Value 2")
                                                    (option ([value "value3"]) "Value 3"))
                                            (input ([id "text-field1"] [name "text-field1"] [type "text"]))
                                            (input ([id "text-field2"] [name "text-field2"] [type "text"]))
                                            (input ([id "submit"] [name "submit"] [type "submit"])))))))))
         (click* (node/xpath "//input[@type='checkbox']"))
         (select* (node/xpath "//select") 'value2)
         (type* (node/xpath "//input[@type='text']") "Sample text")
         (check-exn exn:fail:delirium? (cut click* (node/id 'does-not-exist)))
         (check-exn exn:fail:delirium? (cut select* (node/id 'does-not-exist) "value"))
         (check-exn exn:fail:delirium? (cut type* (node/id 'does-not-exist) "Text"))
         (click*/wait (node/id 'submit))
         (let ([bindings (request-bindings (unbox request-box))])
           (check-true (exists-binding? 'check-box1 bindings) "check-box1")
           (check-true (exists-binding? 'check-box2 bindings) "check-box2")
           (check-true (exists-binding? 'select1 bindings) "select1")
           (check-true (exists-binding? 'select2 bindings) "select2")
           (check-equal? (extract-binding/single 'select1 bindings) "value2" "select1 value")
           (check-equal? (extract-binding/single 'select2 bindings) "value2" "select2 value")
           (check-true (exists-binding? 'text-field1 bindings) "text-field1")
           (check-true (exists-binding? 'text-field2 bindings) "text-field2")
           (check-equal? (extract-binding/single 'text-field1 bindings) "Sample text" "text-field2 value")
           (check-equal? (extract-binding/single 'text-field2 bindings) "Sample text" "text-field1 value"))))
      ))
  
  ; Provide statements ---------------------------
  
  (provide command-tests)
  
  )