(load-relative "../couchdb.scm")

(use test http-client intarweb uri-common)

(import couchdb)

(define (simple-request method uri)
  (condition-case (with-input-from-request
		   (make-request method: method
				 uri: uri) values values)
		  (exn (client-error) #f)))

(define conn (make-connection server: (uri-reference "http://localhost:5984/")
			      database: "chicken-test-couchdb"))

;; (Re)create the test database
(define (reset-test-db)
  (simple-request 'DELETE (connection-uri conn))
  (simple-request 'PUT (connection-uri conn)))

(reset-test-db)

(test-group "server API"
	    (test-assert "reporting version" (json-ref 'version (get-server-info conn))))

(test-group "database API"
  (let ((conn (update-connection conn database: "chicken-test-couchdb-foo")))
    (test-assert "creating" 
		 (begin
		   (simple-request 'DELETE (connection-uri conn))
		   (create-database conn)))

    (test-assert "deleting"
		 (begin 
		   (simple-request 'PUT (connection-uri conn))
		   (delete-database conn))))

  (test "getting information about it" "chicken-test-couchdb" 
	(json-ref 'db_name (get-database-info conn))))

(test-group "document API"

  (let ((body (alist->hash-table '((foo . "bar")))))

    (test "accessing attributes" "bar"
	  (document-attribute (make-document body: body) 'foo))

    (test-assert "creating"
		 (document-id (save-document conn (make-document body: body))))

    (test "creating with given id" "foo"
	  (document-id (save-document conn (make-document id: "foo"))))


    (test "retrieving" "bar"
	  (let ([id (document-id (save-document conn (make-document body: body)))])
	    (document-attribute (get-document conn id) 'foo)))

    (test-assert "deleting"
		 (let ((doc (save-document conn (make-document))))
		   (delete-document conn doc)
		   (not (get-document conn (document-id doc)))))

    (test "updating" "baz!"
	  (let* ((doc (save-document conn (make-document body: body)))
		 (doc (save-document conn (update-document doc body: (alist->hash-table '((foo . "baz!")))))))
	    (document-attribute (get-document conn (document-id doc)) 'foo))))

  (test-group "errors"
    (parameterize ((last-error #f))
      (test-assert "retrieving non-existant document"
		   (and (not (get-document conn "bogus"))
			(last-error))))

    (parameterize ((last-error #f))
      (test-assert "deleting non-existant document"
		   (and (not (delete-document conn "something"))
			(last-error))))))

(reset-test-db)

(test-group "view API"
  (let ((doc (save-document conn (make-document body: (alist->hash-table '((foo . "bar")))))))

    (let ((result (get-all-documents conn)))

      (test "total row count" 1 (json-ref 'total_rows result))
      (test "offset" 0 (json-ref 'offset result))

      (let ((rows (json-ref 'rows result)))
	(test-assert "value" (json-ref 'rev (json-ref 'value (car rows))))))


    (let ((result (get-all-documents conn '((include-docs . #t)))))
      (test-assert "make document objects on include_docs" (document? (json-ref 'doc (car (json-ref 'rows result))))))))