(import (chicken format))
(import test)
(import uri-match)
(import (srfi 1))
(import uri-common)
(import (chicken irregex))

(test-group "routes creation"
  (let ([routes (make-routes '(((/ "foo")
				(GET "bar")
				(POST "POSTed")
				((/ "bar") 
				 (GET "nested")))))])

    (test-assert (lset= eq? '(GET POST) (map car routes)))
    (test-group "expansion"
      (test-assert (lset= equal? (list (list (irregex "foo")) (list (irregex "foo") (irregex "bar")))
			  (map car (alist-ref 'GET routes))))
      (test-assert (lset= equal? (list (list (irregex "foo")))
			  (map car (alist-ref 'POST routes)))))))

(test-group "basic matching"

  (test "this is the body"
    ((uri-match 'GET "/" (make-routes '(((/ "") (GET "this is the body")))))))

  (test "against the path of a uri-reference" "something!"
	((uri-match 'GET (uri-reference "http://foo/bar") (make-routes '(((/ "bar") (GET "something!")))))))

  (test-assert (not (uri-match 'GET "/" (make-routes '(((/ "") (POST "won't reach me")))))))

  (test-group "with nesting"
    (test "foo" ((uri-match 'POST "/foo/bar" (make-routes '(((/ "foo") ((/ "bar") (POST "foo"))))))))

    (test-group "with procedure body"
      (test 'something
	((uri-match 'GET "/me" (make-routes `(((/ "me") (GET ,(lambda (c) 'something))))))))

      (test 100 ((uri-match 'GET "/numbers/100"
			    (make-routes `(((/ "numbers" "(\\d+)") (GET ,(lambda (c n) (string->number n)))))))))))

  (test-group "with capture groups"
    (let ([routes (make-routes `(((/ "foo") ((/ "(\\d+)") ((/ "(\\d+)") (GET ,(lambda (c . args) (apply string-append args))))))))])
      
      (test "105" ((uri-match 'GET "/foo/10/5" routes)))
      (test-assert (not (uri-match 'GET "/foo/bar/10" routes)))))
  
  (test-group "with irregex capture groups"
    (let ([routes (make-routes
                   `(((/ "foo") ((/ (submatch (+ num)))
				 ((/ (submatch (+ num)))
				  (GET ,(lambda (c . args) (apply string-append args))))))))])

      (test "105" ((uri-match 'GET "/foo/10/5" routes)))
      (test-assert (not (uri-match 'GET "/foo/bar/10" routes)))))
  
  (test-group "with irregex named capture groups"
    (let ([routes (make-routes
                   `(((/ "foo") ((/ (submatch (+ num)))
				 ((/ (or (submatch-named b (+ num))
					 (submatch-named c (+ alpha))))
				  (GET ,(lambda (cont a #!key (b "b") (c "c"))
					  (string-append a b c))))))))])
      (test "105c" ((uri-match 'GET "/foo/10/5" routes)))
      (test "10bx" ((uri-match 'GET "/foo/10/x" routes)))
      (test-assert (not (uri-match 'GET "/foo/bar/10" routes))))))


(test-group "matcher" 
	  
  (let ([matcher (make-uri-matcher '(((/ "") (GET "is")) 
				     ((/ "this") (POST "it")
				      ((/ "or") (PUT "what?")))))])

    (test "is" ((matcher 'GET "/")))

    (test "it" ((matcher 'POST "/this")))

    (test "what?" ((matcher 'PUT "/this/or")))))

(test-group "precedence"
  (let ([matcher (make-uri-matcher '(((/ "f..") (GET "first"))
				     ((/ "foo") (GET "second"))))])

    (test "first come, first serve" "first" ((matcher 'GET "/foo")))))

(test-group "a bit more complex nesting"
  (let ((match (make-uri-matcher `(((/ "") (GET "this is the root path!")
				    ((/ "some")
				     ((/ "nested") (GET "I'm nested!")
				      ((/ "route" "(.+)" "(.+)") (GET ,(lambda (c x y)
									 (format "I am the ~A and ~A!" x y)))))))))))

    (test "this is the root path!" ((match 'GET "/")))
    (test "I'm nested!" ((match 'GET "/some/nested")))
    (test "I am the alpha and omega!" ((match 'GET (uri-reference "http://localhost/some/nested/route/alpha/omega"))))))

(test-group "continuing matching"
  (let ((match (make-uri-matcher `(((/ (submatch (+ any)))
				    (PUT ,(lambda (continue arg)
					    (if (string=? "foo" arg)
						'this-is-foo
						(continue))))
				    (PUT ,(lambda (continue arg)
					    (if (string=? "sparta" arg)
						'this-is-spartaaaa
						(continue)))))))))

    (test 'this-is-foo ((match 'PUT "/foo")))
    (test 'this-is-spartaaaa ((match 'PUT "/sparta")))
    (test-assert (not ((match 'PUT "/nothing"))))))

(test-exit)