(use test sxml-transforms sxml-fu sxml-shortcuts sxml-pagination)

(define normal-rules
  `((rule1 . ,(lambda (tag a b)
                `(processed-by-rule1 ,a ,b)))
    (rule2 *macro* . ,(lambda (tag a b)
                        `(rule3 ,a ,b)))
    (rule3 *preorder* . ,(lambda (tag a b)
                           `(processed-by-rule3 ,a ,b)))
    (nested-rule ((nested1 . ,(lambda (tag a b)
                                `(processed-by-nested1 ,a ,b)))
                  (nested2 *macro* . ,(lambda (tag a b)
                                        `(nested3 ,a ,b)))
                  (nested3 *preorder* . ,(lambda (tag a b)
                                           `(processed-by-nested3 ,a ,b))))
                 . ,(lambda (tag contents)
                      `(processed-by-nested-rule ,contents)))
    . ,alist-conv-rules))

(define input
  `(doc (rule1 "foo" (rule3 "bar" (rule1 "qux")))
        (rule2 "egg" "basket")
        (nested-rule (blabla (nested1 "abc" (nested3 "def" (nested1 "ghi")))
                             (nested2 "aap" "noot")))))

(define expected-output
  `(doc (processed-by-rule1
         "foo" (processed-by-rule3 "bar" (rule1 "qux")))
        (processed-by-rule3 "egg" "basket")
        (processed-by-nested-rule
         (blabla (processed-by-nested1
                  "abc" (processed-by-nested3 "def" (nested1 "ghi")))
                 (processed-by-nested3 "aap" "noot")))))

(test-begin "sxml-fu")

(test-group "transformation rules conversion"
  (test "sanity check" expected-output (pre-post-order input normal-rules))
  (test "normal->starred" expected-output
        (pre-post-order* input
                         (normal->starred-transformation-rules normal-rules)))
  (test "normal->starred->normal" expected-output
        (pre-post-order input
                        (starred->normal-transformation-rules
                         (normal->starred-transformation-rules normal-rules)))))

(test-group "shortcuts"
  (test "url with link text"
        '(a (@ (href "foo")) "bar")
        (pre-post-order* '(url "foo" "bar") shortcut-rules*))
  (test "url without link text"
        '(a (@ (href "foo")) "foo")
        (pre-post-order* '(url "foo") shortcut-rules*))
  (test "pic without title"
        '(img (@ (src "foo") (alt "bar") (title "bar")))
        (pre-post-order* '(pic "foo" "bar") shortcut-rules*))
  (test "pic with title"
        '(img (@ (src "foo") (alt "bar") (title "qux")))
        (pre-post-order* '(pic "foo" "bar" "qux") shortcut-rules*))
  (test "movie"
        '(object (@ (type "video/quicktime"))
                 (param (@ (name "src") (value "video-source")))
                 (param (@ (name "controller") (value "true")))
                 "foo"
                 (a (@ (href "video-source")) "my video"))
        (pre-post-order* '(movie "video-source" "my video" "foo")
                         shortcut-rules*)))

(test-group "pagination"
  (test "list pagination"
        '(ul (li "a") (li "b") (li "c") (li "d"))
        (pre-post-order-splice*
         '(paginate-list
           (ul (entries (li (entry))))
           ("a" "b" "c" "d")) pagination-rules*)))

(test-end "sxml-fu")

(unless (zero? (test-failure-count)) (exit 1))