From 7806bdb95344790723d2623c98b962f562011e65 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Fri, 18 Nov 2016 20:05:23 +0100
Subject: [PATCH] couchdb: make it so couch-put and couch-post calls
 <json-post-data>

---
 .../auth/providers/couchdb/couchdb.factor     |  4 ++--
 extra/couchdb/couchdb-tests.factor            | 10 +++++++++-
 extra/couchdb/couchdb.factor                  | 20 +++++++++----------
 3 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/basis/furnace/auth/providers/couchdb/couchdb.factor b/basis/furnace/auth/providers/couchdb/couchdb.factor
index 8c9d47cb04..62accc6410 100644
--- a/basis/furnace/auth/providers/couchdb/couchdb.factor
+++ b/basis/furnace/auth/providers/couchdb/couchdb.factor
@@ -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 ;
diff --git a/extra/couchdb/couchdb-tests.factor b/extra/couchdb/couchdb-tests.factor
index 5b4c40e3ed..3cb84d59e0 100644
--- a/extra/couchdb/couchdb-tests.factor
+++ b/extra/couchdb/couchdb-tests.factor
@@ -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
diff --git a/extra/couchdb/couchdb.factor b/extra/couchdb/couchdb.factor
index f0faf94e99..0de1cb95b8 100644
--- a/extra/couchdb/couchdb.factor
+++ b/extra/couchdb/couchdb.factor
@@ -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-put ( assoc url -- assoc' )
+    [ <json-post-data> ] dip <put-request> couch-request ;
 
-: couch-post ( post-data url -- assoc )
-    <post-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 -- )
-- 
2.34.1