couchdb: make it so couch-put and couch-post calls <json-post-data>

char-rename
Björn Lindqvist 2016-11-18 20:05:23 +01:00
parent ec0169a50b
commit 7806bdb953
3 changed files with 21 additions and 13 deletions

View File

@ -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 ;

View File

@ -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

View File

@ -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 -- )