steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/furnace/auth/providers/couchdb/couchdb.factor
View File

@ -161,7 +161,7 @@ TUPLE: couchdb-auth-provider
] H{ } make ] H{ } make
reserve-multiple reserve-multiple
[ [
user>user-hash >json user>user-hash
"" get-url "" get-url
couch-post couch-post
] [ ] [
@ -219,7 +219,7 @@ M: couchdb-auth-provider update-user ( user provider -- )
[ drop "_id" of get-url ] [ drop "_id" of get-url ]
[ user>user-hash swapd [ user>user-hash swapd
2dup check-update drop 2dup check-update drop
unify-users >json swap couch-put drop unify-users swap couch-put drop
] ]
tri tri
] with-variable ; ] with-variable ;

10
extra/couchdb/couchdb-tests.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2008 Alex Chapman ! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: couchdb.tests
! You must have a CouchDB server (currently only the version from svn will ! You must have a CouchDB server (currently only the version from svn will
@ -42,5 +43,12 @@ IN: couchdb.tests
} save-doc ] unit-test } save-doc ] unit-test
[ t ] [ "id" get load-doc delete-doc string? ] unit-test [ t ] [ "id" get load-doc delete-doc string? ] unit-test
[ "id" get load-doc ] must-fail [ "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 [ ] [ couch get delete-db ] unit-test
] with-couch ] with-couch

20
extra/couchdb/couchdb.factor
View File

@ -42,11 +42,14 @@ PREDICATE: file-exists-error < couchdb-error
: couch-get ( url -- assoc ) : couch-get ( url -- assoc )
<get-request> couch-request ; <get-request> couch-request ;
: couch-put ( post-data url -- assoc ) : <json-post-data> ( assoc -- post-data )
<put-request> couch-request ; >json utf8 encode "application/json" <post-data> swap >>data ;
: couch-post ( post-data url -- assoc ) : couch-put ( assoc url -- assoc' )
<post-request> couch-request ; [ <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 ) : couch-delete ( url -- assoc )
<delete-request> couch-request ; <delete-request> couch-request ;
@ -122,11 +125,8 @@ C: <db> db
! TODO: queries. Maybe pass in a hashtable with options ! TODO: queries. Maybe pass in a hashtable with options
db-url "_all_docs" append couch-get ; 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 -- ) : 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 ! documents
: id> ( assoc -- id ) "_id" of ; : id> ( assoc -- id ) "_id" of ;
@ -153,13 +153,13 @@ C: <db> db
id> id-url ; id> id-url ;
: temp-view ( view -- results ) : 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 ) : temp-view-map ( map -- results )
"map" associate temp-view ; "map" associate temp-view ;
: save-doc-as ( assoc id -- ) : 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 ; [ copy-id ] [ copy-rev ] 2bi ;
: save-new-doc ( assoc -- ) : save-new-doc ( assoc -- )