]> gitweb.factorcode.org Git - factor.git/commitdiff
Working minimal couchdb.
authorAlex Chapman <chapman.alex@gmail.com>
Wed, 15 Apr 2009 00:54:10 +0000 (10:54 +1000)
committerAlex Chapman <chapman.alex@gmail.com>
Wed, 15 Apr 2009 00:54:10 +0000 (10:54 +1000)
Tests will fail unless couchdb is running.

extra/couchdb/couchdb-tests.factor
extra/couchdb/couchdb.factor

index 7e38f5c2eeb5ac1c25c2f861189fa4b08fa3e509..d7161a14cdb459775c79534a21e7d787e8489dd1 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs couchdb kernel namespaces sequences strings tools.test ;
+USING: accessors assocs couchdb kernel namespaces sequences strings tools.test ;
 IN: couchdb.tests
 
 ! You must have a CouchDB server (currently only the version from svn will
@@ -16,6 +16,7 @@ IN: couchdb.tests
     [ ] [ couch get ensure-db ] unit-test
     [ 0 ] [ couch get db-info "doc_count" swap at ] unit-test
     [ ] [ couch get compact-db ] unit-test
+    [ t ] [ couch get server>> next-uuid string? ] unit-test
     [ ] [ H{
             { "Subject" "I like Planktion" }
             { "Tags" { "plankton" "baseball" "decisions" } }
index c586287b2e27e3082e391cd0b87a0258025d9c60..da71acb07408a94b9446bfcaadaa8cca948ded10 100644 (file)
@@ -1,6 +1,9 @@
-! Copyright (C) 2008 Alex Chapman
+! Copyright (C) 2008, 2009 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 urls.encoding vectors ;
+USING: accessors arrays assocs continuations debugger hashtables http
+http.client io io.encodings.string io.encodings.utf8 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
@@ -27,7 +30,7 @@ PREDICATE: file-exists-error < couchdb-error
 : couch-http-request ( request -- data )
     [ http-request ] [
         dup download-failed? [
-            data>> json> <couchdb-error> throw
+            response>> body>> json> <couchdb-error> throw
         ] [
             rethrow
         ] if
@@ -46,7 +49,7 @@ PREDICATE: file-exists-error < couchdb-error
     <post-request> couch-request ;
 
 : couch-delete ( url -- assoc )
-    "DELETE" <client-request> couch-request ;
+    <delete-request> couch-request ;
 
 : response-ok ( assoc -- assoc )
     "ok" over delete-at* and t assert= ;
@@ -79,11 +82,11 @@ TUPLE: server { host string } { port integer } { uuids vector } { uuids-to-cache
 : uuids-url ( server -- url )
     [ dup server-url % "_uuids?count=" % uuids-to-cache>> number>string % ] "" make ;
 
-: uuids-post ( server -- uuids )
-     uuids-url f swap couch-post "uuids" swap at >vector ;
+: uuids-get ( server -- uuids )
+     uuids-url couch-get "uuids" swap at >vector ;
 
 : get-uuids ( server -- server )
-    dup uuids-post [ nip ] curry change-uuids ;
+    dup uuids-get [ nip ] curry change-uuids ;
 
 : ensure-uuids ( server -- server )
     dup uuids>> empty? [ get-uuids ] when ;
@@ -123,7 +126,7 @@ C: <db> db
     db-url "_all_docs" append couch-get ;
 
 : <json-post-data> ( assoc -- post-data )
-    >json "application/json" <post-data> swap >>data ;
+    >json utf8 encode "application/json" <post-data> swap >>data ;
 
 ! documents
 : id> ( assoc -- id ) "_id" swap at ; 
@@ -189,7 +192,7 @@ C: <db> db
 !     construct-attachment H{ } clone
 
 ! TODO:
-! - startkey, count, descending, etc.
+! - startkey, limit, descending, etc.
 ! - loading specific revisions
 ! - views
 ! - attachments