(load-relative "../sxml-informal.scm")
(import sxml-informal)
(use sxml-transforms test)

(define-syntax test-form 
  (syntax-rules ()
    ((_ result form description) (test description result (pre-post-order* form informal-rules)))
    ((_ result form) (test-form result form #f))))


(define-syntax test-field
  (syntax-rules ()
    ((_ result form)
     (test-form result form (symbol->string (car form))))))


(test-form '(form (@ (action "/foo") (method "POST"))
		  (fieldset (legend "Paste") 
			    (ol (li (@ (class "string title"))
				    (label (@ (for "title")) "A Title")
				    (input (@ (type "text") (id "title") (name "title"))))
				(li (@ (class "string name"))
				    (label (@ (for "name")) "Your Name")
				    (input (@ (type "text") (id "name") (name "name")))))))

	   '(informal (@ (action "/foo") (method "POST"))
		      (fields "Paste"
			      (string "title" label: "A Title")
			      (string "name" label: "Your Name"))))



;; form field rules

(test-field '(li (@ (class "string foo"))
		 (input (@ (type "text") (id "foo") (name "foo") (value "bar"))))
	    '(string "foo" value: "bar"))

(test-field '(li (@ (class "password foo"))
		 (input (@ (type "password") (id "foo") (name "foo") (value "bar"))))
	    '(password "foo" value: "bar"))

(test-field '(li (@ (class "checkbox foo")) 
		 (input (@ (checked "checked") (type "checkbox") (id "foo") (name "foo") (value "bar"))))
	    '(checkbox "foo" value: "bar" checked: #t))

(test-field '(li (@ (class "foo-bar radio foo"))
		 (input (@ (checked "checked") (type "radio") (id "foo-bar") (name "foo") (value "bar"))))
	    '(radio "foo" value: "bar" checked: #t))

(test-field '(li (@ (class "foo-baz radio foo")) 
		 (input (@ (type "radio") (id "foo-baz") (name "foo") (value "bar"))))
	    '(radio "foo" value: "bar" checked: #f suffix: "-baz"))

(test-field '(li (@ (class "text foo")) (textarea (@ (id "foo") (name "foo")) "bar"))
	    '(text "foo" value: "bar"))

(test-field '(li (@ (class "text foo"))
                 (label (@ (for "foo")) "a text")
                 (textarea (@ (id "foo") (name "foo")) #f))
	    '(text "foo" label: "a text"))

(test-field '(li (@ (class "select foo"))
		 (select (@ (id "foo") (name "foo"))
		   (option (@ (value 10)) "bar")
		   (option (@ (value 20)) "baz")
		   (option (@ (selected "selected") (value 30)) "qux")))

	    '(select "foo" value: 30
		     options: ((10 "bar")
			       (20 "baz")
			       (30 "qux"))))

(test-field '(li (@ (class "submit commit")) (input (@ (type "submit") (id "commit") (name "commit") (value "submit!"))))
	    '(submit "submit!"))

(test-field '(li (@ (class "password some")) (input (@ (type "password") (id "some") (name "some"))))
	    '(password "some"))


;; special case: hidden fields aren't wrapped in an li element
(test-form '(input (@ (type "hidden") (id "foo") (name "foo") (value "bar")))
	   '(hidden "foo" "bar") "hidden")


;; prefixing
(test-form '(form (@ (foo "bar")) 
		  (fieldset
		   (ol (li (@ (class "foo-bar string bar"))  (label (@ (for "foo-bar")) "foo!")
			   (input (@ (type "text") (id "foo-bar") (name "foo-bar") (value "baz"))))))
		  (fieldset (legend "some fields")
			    (ol (li (@ (class "foo-bar-qux string qux"))
				    (input (@ (type "text") (id "foo-bar-qux") (name "foo-bar-qux")))))))

	   '(informal ((prefix "foo-") (@ (foo "bar")))
		      (fields (string "bar" value: "baz" label: "foo!"))
		      (fields ((prefix "bar-") (legend "some fields")) (string "qux"))))

;; errors

(test-field '(li (@ (class "string hehe invalid"))
		 (input (@ (type "text") (id "hehe") (name "hehe") (value "hoho"))))
	    '(string "hehe" value: "hoho" error: #t))

(test-field '(li (@ (class "string hehe invalid"))
		 (input (@ (type "text") (id "hehe") (name "hehe") (value "hoho")))
		 (span (@ (class "error")) "fail"))
	    '(string "hehe" value: "hoho" error: "fail"))

(test-field '(li (@ (class "string hehe invalid"))
		 (input (@ (type "text") (id "hehe") (name "hehe") (value "hoho")))
		 (ul (@ (class "errors"))
		     (li "two")
		     (li "errors")))
	    '(string "hehe" value: "hoho" error: ("two" "errors")))