;; 
;; %%HEADER%%
;;

(use test json regex-literals regex missbehave)
(load "../chickumber.scm")
(load "../chickumber-server.scm")

(import chickumber chickumber-server)


(define (test-message-on-handler input)
  (call-with-input-string input
    (lambda (inport)
     (call-with-output-string
      (lambda (outport)
        (handle-wire-request inport outport))))))


(define-syntax test-wire-message
  (syntax-rules ()
     ((_ label input-object expected)
      (test label
            expected
            (let ((input-string (with-output-to-string (lambda ()
                                                         (json-write input-object)
                                                         (newline)))))
              (with-input-from-string (test-message-on-handler input-string) json-read))))))


(define-syntax with-clean-steps
  (syntax-rules ()
    ((_ code more-code ...)
     (parameterize ((current-steps-file "chicken_steps.scm"))
       (set! *step-definitions* '())
       (reset-step-id-generator)
       code more-code ...))))


(test-group "Steps"
            (test "Given adds a step"
                  1
                  (begin
                    (set! step-defintions '())
                    (Given #/there is a step/ #t)
                    (length *step-definitions*)))

            (test "Find a step"
                  1
                  (with-clean-steps
                   (Given #/there is a step/ #t)
                   (let ((step (find-step 1)))
                     (if step
                         (step-id step)
                         #f))))


            )


(test-group "State"
            (test "Retrieve state of unset variable"
                  #f
                  ($ 'some-variable))

            (test "Default value"
                  'default
                  ($ 'some-variable default: 'default))

            (test "Set state"
                  1
                  (begin
                    (set! ($ 'number) 1)
                    ($ 'number)))

            (test "reset all states"
                  #f
                  (begin
                    (set! ($ 'number) 2)
                    (reset-state!)
                    ($ 'number))))

(test-group "Hooks"
   (test "Before on 1-element queue"
         '(before)
         (let ((hooks '()))
           (hooks-clear!)
           (Before ()
                   (set! hooks (cons 'before hooks)))
           (apply-hooks 'before)
           hooks))

   (test "Before on empty queue"
         '()
         (let ((hooks '()))
           (hooks-clear!)
           (apply-hooks 'before)
           hooks))

   (test "Before on two-or-more elements queue"
         '(one two three)
         (let ((hooks '()))
           (hooks-clear!)
           (Before ()
                   (set! hooks (cons 'one hooks)))
           (Before ()
                   (set! hooks (cons 'two hooks)))
           (Before ()
                   (set! hooks (cons 'three hooks)))
           (apply-hooks 'before)
           hooks))
   
   (test "Begin-scenario invokes before"
         '(before)
         (let ((hooks '()))
           (hooks-clear!)
           (Before ()
                  (set! hooks (cons 'before hooks)))
           (test-message-on-handler "[\"begin_scenario\"]")
           hooks))

   (test "After on 1-element queue"
         '(after)
         (let ((hooks '()))
           (hooks-clear!)
           (After ()
                   (set! hooks (cons 'after hooks)))
           (apply-hooks 'after)
           hooks))

   (test "After on empty queue"
         '()
         (let ((hooks '()))
           (hooks-clear!)
           (apply-hooks 'after)
           hooks))

   (test "After on two-or-more elements queue"
         '(one two three)
         (let ((hooks '()))
           (hooks-clear!)
           (After ()
                   (set! hooks (cons 'one hooks)))
           (After ()
                   (set! hooks (cons 'two hooks)))
           (After ()
                   (set! hooks (cons 'three hooks)))
           (apply-hooks 'after)
           hooks))

   (test "End-scenario invokes after"
         '(after)
         (let ((hooks '()))
           (hooks-clear!)
           (After ()
                  (set! hooks (cons 'after hooks)))
           (test-message-on-handler "[\"end_scenario\"]")
           hooks))
   )


(test-group "Wire-Messages"

     (test "Succeeding message"
           '("success" (test))
           (succeed '(test)))
     (test "Failing message"
           '("fail" #(("message" . "test")))
           (fail "test"))
            
     (test "find method returns #f for undefined wire-procedures"
           #f
           (find-wire-procedure "i_dont_exist"))
     
     (test "add wire-procedure"
           #t
           (begin
             (add-wire-procedure! "testmethod" (lambda _ 'test))
             (procedure? (find-wire-procedure "testmethod"))))
     
     (test "define wire-procedure"
           #t
           (begin
             (define-wire-procedure "wireshark" (argument1 argument2)
               'testmethod)
             (procedure? (find-wire-procedure "wireshark"))))

     (define-wire-procedure "firstrun" () 'testoutput)
     (test-wire-message "procedure without arguments" '("firstrun" #()) "testoutput")

     (define-wire-procedure "with-args" (arg) arg)
     (define-wire-procedure "multiple-arguments" (second_arg first_arg) (list first_arg second_arg))
     
     (test-wire-message "procedure passing arguments" '("with-args" #(("arg" . 1))) 1)
     (test-wire-message "procedure with arguments retains order" '("multiple-arguments" #(( "first_arg" . 1) ("second_arg" . 2))) (list 1 2))

     (test-group "step_matches"
        (with-clean-steps         
          (test-wire-message
           "no matching steps"
           '("step_matches" #(("name_to_match" . "I'm not defined")))
           '("success" ()))

          (reset-step-id-generator)
          (Given #/teststep/ #t)
          (Given #/teststep with (.*?)/ #t)
         
          (test-wire-message
           "matching step without captures"
           '("step_matches" #(("name_to_match" . "teststep")))
           '("success" (#(("id" . "1") ("args") ("regexp" . "teststep") ("source" . "chicken_steps.scm")))))

         
          (test-wire-message
           "matching step with captures"
           '("step_matches" #(("name_to_match" . "teststep with capture")))
           '("success" (#(("id" . "2") ("args" #(("val" . "capture") ("pos" . 14))) ("regexp" . "teststep with (.*?)") ("source" . "chicken_steps.scm")))))))

     (test-group "snippets"
         (test-group "generate-step-suggestion"
            (test "No capture groups"
                  "(Given #/^I have no capture groups$/ ()\n  ;write the code you wish you had\n  (pending))"
                  (suggest-step-snippet-for "Given" "I have no capture groups"))
            (test "One capture group"
                  "(Given #/^I have \"([^\"]+)\" capture group$/ (arg1)\n  ;write the code you wish you had\n  (pending))"
                  (suggest-step-snippet-for "Given" "I have \"one\" capture group")))


         (test-wire-message
          "snippet_text does work"
          '("snippet_text" #(("step_name". "A Teststep with \"foo\" captures") ("step_keyword" . "Given") ("multiline_arg_class" . "")))
          '("success" "(Given #/^A Teststep with \"([^\"]+)\" captures$/ (arg1)\n  ;write the code you wish you had\n  (pending))"))
         )

     (test-group "Invoke"
                 (test-group "Pending"
                             (with-clean-steps         
                               (Given #/pending/
                                      (pending))

                               (Given #/pending with args/
                                      (pending "test"))
                               
                               (test-wire-message
                                "Without string argument"
                                '("invoke" #(("id" . "1") ("args")))
                                '("pending"))
                               
                               (test-wire-message
                                "With string argument"
                                '("invoke" #(("id" . "2") ("args")))
                                '("pending" "test"))

                               ))
                 (test-group "Passing"
                             (with-clean-steps
                               (Given #/passing/
                                      #t)

                               (test-wire-message
                                "Failing"
                                '("invoke" #(("id" . "1") ("args")))
                                '("success"))))

                 (test-group "Failing"
                             (with-clean-steps
                               (Given #/failing/
                                      #f)

                               (test-wire-message
                                "Failing"
                                '("invoke" #(("id" . "1") ("args")))
                                '("fail" #(("message" . "Step failed"))))))


                 )

     


     )


(test-group "Stepevaluators"
            (test-group "Boolean"
                        (test "Succeeding steps"
                              '("success")
                              (with-clean-steps
                               (Given #/success/ #t)
                               (boolean-step-evaluator (car *step-definitions*) '())))
                        
                        (test "Failing steps"
                              '("fail" #(("message" . "Step failed")))
                              (with-clean-steps
                               (Given #/failing/ #f)
                               (boolean-step-evaluator (car *step-definitions*) '())))

                        

                        )

            (test-group "Test"
                        (test "Succeeding steps"
                              '("success")
                              (with-clean-steps
                               (Given #/success/
                                      (test "sometest" #t #t))
                               (test-step-evaluator (car *step-definitions*) '())))
                        
                        (test "Failing steps"
                              '("fail" #(("message" . "expected #f but got #t\n")))
                              (with-clean-steps
                               (Given #/failing/
                                      (test "failing" #f #t))
                               (test-step-evaluator (car *step-definitions*) '())))


                        )

            (test-group "Missbehave"
                        (test "Succeeding steps"
                              '("success")
                              (with-clean-steps
                               (Given #/success/
                                      (expect #t (be true)))

                               (missbehave-step-evaluator (car *step-definitions*) '())))
                        (test "Failing steps"
                              '("fail" #(("message" . "Expected #t to be #f")))
                              (with-clean-steps
                               (Given #/failing/
                                      (expect #t (be false)))
                               (missbehave-step-evaluator (car *step-definitions*) '())))))