Fix tests and separate out the construction of a method call

2 files changed, 18 insertions, 15 deletions

diff --git a/tests/run.scm b/tests/run.scm
index 5e887b9..279a3ca 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -268,7 +268,7 @@
   (test "simple response"
         '("test")
         (receive params
-          (handle-xml-rpc-response
+          (xml-rpc-response->values
           `(*TOP*
             (*PI* xml "version=\"1.0\"")
             (methodResponse
@@ -278,7 +278,7 @@
   (test "multi-param response (chicken extension)"
         '("test" 1 2 3)
         (receive params
-          (handle-xml-rpc-response
+          (xml-rpc-response->values
            `(*TOP*
              (*PI* xml "version=\"1.0\"")
              (methodResponse
@@ -290,7 +290,7 @@
           params))
   (test-error "fault code throws exception"
               (receive params
-                (handle-xml-rpc-response
+                (xml-rpc-response->values
                  `(*TOP*
                    (*PI* xml "version=\"1.0\"")
                    (methodResponse
diff --git a/xml-rpc-client.scm b/xml-rpc-client.scm
index a946b9c..eb4bdec 100644
--- a/xml-rpc-client.scm
+++ b/xml-rpc-client.scm
@@ -39,7 +39,7 @@
 ; http://trac.callcc.org
 
 (module xml-rpc-client
-  (xml-rpc-server xml-rpc-response->values)
+  (xml-rpc-server xml-rpc-response->values xml-rpc-methodcall)
 
 (import chicken scheme)
 (use srfi-13 data-structures http-client uri-common intarweb
@@ -78,23 +78,26 @@
 (define (sxml->string sxml)
   (string-concatenate (flatten (sxml:sxml->xml sxml))))
 
+(define (xml-rpc-methodcall method-name args)
+  (if (null? args)
+      `(methodCall (methodName ,method-name))
+      `(methodCall
+        (methodName ,method-name)
+        (params
+         ,(map (lambda (p)
+                 `(param
+                   (value ,(value->xml-rpc-fragment p))))
+               args)))))
+
 (define (xml-rpc-server uri)
-  (set! uri (uri-reference uri))
+  (when (string? uri)
+    (set! uri (uri-reference uri)))
   (lambda (method-name)
     (lambda args
       (let* ((xml
               (string-append
                "<?xml version=\"1.0\"?>\n"
-               (sxml->string
-                (if (null? args)
-                    `(methodCall (methodName ,method-name))
-                    `(methodCall
-                      (methodName ,method-name)
-                      (params
-                       ,(map (lambda (p)
-                               `(param
-                                 (value ,(value->xml-rpc-fragment p))))
-                             args)))))))
+               (sxml->string (xml-rpc-methodcall method-name args))))
              (req (make-request
                    method: 'POST uri: uri
                    headers: (headers `((content-length ,(string-length xml)))))))