Added some unit tests to couchdb

diff --git a/extra/couchdb/couchdb-tests.factor b/extra/couchdb/couchdb-tests.factor
index 8907c0b811185e15afcde7f58af50122446ab9b4..7e38f5c2eeb5ac1c25c2f861189fa4b08fa3e509 100644 (file)
--- a/extra/couchdb/couchdb-tests.factor
+++ b/extra/couchdb/couchdb-tests.factor
@@ -1,4 +1,45 @@
 ! Copyright (C) 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test couchdb ;
+USING: assocs couchdb kernel namespaces sequences strings tools.test ;
 IN: couchdb.tests
+
+! You must have a CouchDB server (currently only the version from svn will
+! work) running on localhost and listening on the default port for these tests
+! to work.
+
+<default-server> "factor-test" <db> [
+    [ ] [ couch get create-db ] unit-test
+    [ couch get create-db ] must-fail
+    [ ] [ couch get delete-db ] unit-test
+    [ couch get delete-db ] must-fail
+    [ ] [ couch get ensure-db ] unit-test
+    [ ] [ couch get ensure-db ] unit-test
+    [ 0 ] [ couch get db-info "doc_count" swap at ] unit-test
+    [ ] [ couch get compact-db ] unit-test
+    [ ] [ H{
+            { "Subject" "I like Planktion" }
+            { "Tags" { "plankton" "baseball" "decisions" } }
+            { "Body"
+              "I decided today that I don't like baseball. I like plankton." }
+            { "Author" "Rusty" }
+            { "PostedDate" "2006-08-15T17:30:12Z-04:00" }
+           } save-doc ] unit-test
+    [ t ] [ couch get all-docs "rows" swap at first "id" swap at dup "id" set string? ] unit-test
+    [ t ] [ "id" get dup load-doc id> = ] unit-test
+    [ ] [ "id" get load-doc save-doc ] unit-test
+    [ "Rusty" ] [ "id" get load-doc "Author" swap at ] unit-test
+    [ ] [ "id" get load-doc "Alex" "Author" pick set-at save-doc ] unit-test
+    [ "Alex" ] [ "id" get load-doc "Author" swap at ] unit-test
+    [ 1 ] [ "function(doc) { emit(null, doc) }" temp-view-map "total_rows" swap at ] unit-test
+    [ ] [ H{
+         { "_id" "_design/posts" }
+         { "language" "javascript" }
+         { "views" H{
+             { "all" H{ { "map" "function(doc) { emit(null, doc) }" } } }
+           }
+         }
+       } save-doc ] unit-test
+    [ t ] [ "id" get load-doc delete-doc string? ] unit-test
+    [ "id" get load-doc ] must-fail
+    [ ] [ couch get delete-db ] unit-test
+] with-couch

diff --git a/extra/couchdb/couchdb.factor b/extra/couchdb/couchdb.factor
index 8829a59779f431683c327af11315e9a89bb2f432..3419244d7274c4cf975f89e1b62f9834af59f048 100644 (file)
--- a/extra/couchdb/couchdb.factor
+++ b/extra/couchdb/couchdb.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs continuations debugger hashtables http http.client io json.reader json.writer kernel make math math.parser namespaces sequences strings urls vectors ;
+USING: accessors arrays assocs continuations debugger hashtables http http.client io json.reader json.writer kernel make math math.parser namespaces sequences strings urls urls.encoding vectors ;
 IN: couchdb
 
 ! NOTE: This code only works with the latest couchdb (0.9.*), because old
@@ -130,6 +130,8 @@ C: <db> db
 : >id ( assoc id -- assoc ) "_id" pick set-at ;
 : rev> ( assoc -- rev ) "_rev" swap at ;
 : >rev ( assoc rev -- assoc ) "_rev" pick set-at ;
+: attachments> ( assoc -- attachments ) "_attachments" swap at ;
+: >attachments ( assoc attachments -- assoc ) "_attachments" pick set-at ;
 
 : copy-key ( to from to-key from-key -- )
     rot at spin set-at ;
@@ -141,32 +143,35 @@ C: <db> db
     "_rev" "rev" copy-key ;
 
 : id-url ( id -- url )
-    couch get db-url swap append ;
+    couch get db-url swap url-encode-full append ;
 
 : doc-url ( assoc -- url )
     id> id-url ;
 
-: new-doc-url ( -- url )
-    couch get [ db-url ] [ server>> next-uuid ] bi append ;
+: temp-view ( view -- results )
+    <json-post-data> couch get db-url "_temp_view" append couch-post ;
 
-: save-new ( assoc -- )
-    dup <json-post-data> new-doc-url couch-put response-ok
+: temp-view-map ( map -- results )
+    "map" H{ } clone [ set-at ] keep temp-view ;
+
+: save-doc-as ( assoc id -- )
+    [ dup <json-post-data> ] dip id-url couch-put response-ok
     [ copy-id ] [ copy-rev ] 2bi ;
 
-: save-existing ( assoc id -- )
-    [ dup <json-post-data> ] dip id-url couch-put response-ok copy-rev ;
+: save-new-doc ( assoc -- )
+    couch get server>> next-uuid save-doc-as ;
 
-: save ( assoc -- )
-    dup id> [ save-existing ] [ save-new ] if* ; 
+: save-doc ( assoc -- )
+    dup id> [ save-doc-as ] [ save-new-doc ] if* ; 
 
-: load ( id -- assoc )
+: load-doc ( id -- assoc )
     id-url couch-get ;
 
-: delete ( assoc -- )
+: delete-doc ( assoc -- deletion-revision )
     [
         [ doc-url % ]
         [ "?rev=" % "_rev" swap at % ] bi
-    ] "" make couch-delete response-ok* ;
+    ] "" make couch-delete response-ok "rev" swap at  ;
 
 : remove-keys ( assoc keys -- )
     swap [ delete-at ] curry each ;
@@ -174,6 +179,15 @@ C: <db> db
 : remove-couch-info ( assoc -- )
     { "_id" "_rev" "_attachments" } remove-keys ;
 
+! : construct-attachment ( content-type data -- assoc )
+!     H{ } clone "name" pick set-at "content-type" pick set-at ;
+! 
+! : add-attachment ( assoc name attachment -- )
+!     pick attachments> [ H{ } clone ] unless* 
+! 
+! : attach ( assoc name content-type data -- )
+!     construct-attachment H{ } clone
+
 ! TODO:
 ! - startkey, count, descending, etc.
 ! - loading specific revisions