couchdb: make it so couch-put and couch-post calls <json-post-data>
							parent
							
								
									ec0169a50b
								
							
						
					
					
						commit
						7806bdb953
					
				| 
						 | 
				
			
			@ -161,7 +161,7 @@ TUPLE: couchdb-auth-provider
 | 
			
		|||
    ] H{ } make
 | 
			
		||||
    reserve-multiple
 | 
			
		||||
    [
 | 
			
		||||
        user>user-hash >json
 | 
			
		||||
        user>user-hash
 | 
			
		||||
        "" get-url
 | 
			
		||||
        couch-post
 | 
			
		||||
    ] [
 | 
			
		||||
| 
						 | 
				
			
			@ -219,7 +219,7 @@ M: couchdb-auth-provider update-user ( user provider -- )
 | 
			
		|||
        [ drop "_id" of get-url ]
 | 
			
		||||
        [ user>user-hash swapd
 | 
			
		||||
          2dup check-update drop
 | 
			
		||||
          unify-users >json swap couch-put drop
 | 
			
		||||
          unify-users swap couch-put drop
 | 
			
		||||
        ]
 | 
			
		||||
        tri
 | 
			
		||||
    ] with-variable ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,6 +1,7 @@
 | 
			
		|||
! Copyright (C) 2008 Alex Chapman
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors assocs couchdb kernel namespaces sequences strings tools.test ;
 | 
			
		||||
USING: accessors assocs couchdb hashtables kernel namespaces
 | 
			
		||||
random.data sequences strings tools.test ;
 | 
			
		||||
IN: couchdb.tests
 | 
			
		||||
 | 
			
		||||
! You must have a CouchDB server (currently only the version from svn will
 | 
			
		||||
| 
						 | 
				
			
			@ -42,5 +43,12 @@ IN: couchdb.tests
 | 
			
		|||
       } save-doc ] unit-test
 | 
			
		||||
    [ t ] [ "id" get load-doc delete-doc string? ] unit-test
 | 
			
		||||
    [ "id" get load-doc ] must-fail
 | 
			
		||||
 | 
			
		||||
    { t } [
 | 
			
		||||
        "oga" "boga" associate
 | 
			
		||||
        couch get db-url 10 random-string append
 | 
			
		||||
        couch-put "ok" of
 | 
			
		||||
    ] unit-test
 | 
			
		||||
 | 
			
		||||
    [ ] [ couch get delete-db ] unit-test
 | 
			
		||||
] with-couch
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -42,11 +42,14 @@ PREDICATE: file-exists-error < couchdb-error
 | 
			
		|||
: couch-get ( url -- assoc )
 | 
			
		||||
    <get-request> couch-request ;
 | 
			
		||||
 | 
			
		||||
: couch-put ( post-data url -- assoc )
 | 
			
		||||
    <put-request> couch-request ;
 | 
			
		||||
: <json-post-data> ( assoc -- post-data )
 | 
			
		||||
    >json utf8 encode "application/json" <post-data> swap >>data ;
 | 
			
		||||
 | 
			
		||||
: couch-post ( post-data url -- assoc )
 | 
			
		||||
    <post-request> couch-request ;
 | 
			
		||||
: couch-put ( assoc url -- assoc' )
 | 
			
		||||
    [ <json-post-data> ] dip <put-request> couch-request ;
 | 
			
		||||
 | 
			
		||||
: couch-post ( assoc url -- assoc' )
 | 
			
		||||
    [ <json-post-data> ] dip <post-request> couch-request ;
 | 
			
		||||
 | 
			
		||||
: couch-delete ( url -- assoc )
 | 
			
		||||
    <delete-request> couch-request ;
 | 
			
		||||
| 
						 | 
				
			
			@ -122,11 +125,8 @@ C: <db> db
 | 
			
		|||
    ! TODO: queries. Maybe pass in a hashtable with options
 | 
			
		||||
    db-url "_all_docs" append couch-get ;
 | 
			
		||||
 | 
			
		||||
: <json-post-data> ( assoc -- post-data )
 | 
			
		||||
    >json utf8 encode "application/json" <post-data> swap >>data ;
 | 
			
		||||
 | 
			
		||||
: compact-db ( db -- )
 | 
			
		||||
    f <json-post-data> swap db-url "_compact" append couch-post response-ok* ;
 | 
			
		||||
    f swap db-url "_compact" append couch-post response-ok* ;
 | 
			
		||||
 | 
			
		||||
! documents
 | 
			
		||||
: id> ( assoc -- id ) "_id" of ;
 | 
			
		||||
| 
						 | 
				
			
			@ -153,13 +153,13 @@ C: <db> db
 | 
			
		|||
    id> id-url ;
 | 
			
		||||
 | 
			
		||||
: temp-view ( view -- results )
 | 
			
		||||
    <json-post-data> couch get db-url "_temp_view" append couch-post ;
 | 
			
		||||
    couch get db-url "_temp_view" append couch-post ;
 | 
			
		||||
 | 
			
		||||
: temp-view-map ( map -- results )
 | 
			
		||||
    "map" associate temp-view ;
 | 
			
		||||
 | 
			
		||||
: save-doc-as ( assoc id -- )
 | 
			
		||||
    [ dup <json-post-data> ] dip id-url couch-put response-ok
 | 
			
		||||
    dupd id-url couch-put response-ok
 | 
			
		||||
    [ copy-id ] [ copy-rev ] 2bi ;
 | 
			
		||||
 | 
			
		||||
: save-new-doc ( assoc -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue