From dd553440dcfce9add2e8a97a396b10569aa37f6b Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-103.local>
Date: Mon, 26 Jan 2009 16:48:14 -0600
Subject: [PATCH] Use xml.interpolate for xml-rpc

---
 basis/xml-rpc/xml-rpc.factor             | 58 +++++++++++++++---------
 basis/xml/interpolate/interpolate.factor |  5 +-
 2 files changed, 39 insertions(+), 24 deletions(-)

diff --git a/basis/xml-rpc/xml-rpc.factor b/basis/xml-rpc/xml-rpc.factor
index 602fb90172..d2fd111b39 100644
--- a/basis/xml-rpc/xml-rpc.factor
+++ b/basis/xml-rpc/xml-rpc.factor
@@ -3,7 +3,7 @@
 USING: accessors kernel xml arrays math generic http.client
 combinators hashtables namespaces io base64 sequences strings
 calendar xml.data xml.writer xml.utilities assocs math.parser
-debugger calendar.format math.order ;
+debugger calendar.format math.order xml.interpolate ;
 IN: xml-rpc
 
 ! * Sending RPC requests
@@ -15,56 +15,70 @@ GENERIC: item>xml ( object -- xml )
 M: integer item>xml
     dup 31 2^ neg 31 2^ 1 - between?
     [ "Integers must fit in 32 bits" throw ] unless
-    number>string "i4" build-tag ;
+    number>string [XML <i4><-></i4> XML] ;
 
 UNION: boolean t POSTPONE: f ;
 
 M: boolean item>xml
-    "1" "0" ? "boolean" build-tag ;
+    "1" "0" ? [XML <boolean><-></boolean> XML] ;
 
 M: float item>xml
-    number>string "double" build-tag ;
+    number>string [XML <double><-></double> XML] ;
 
-M: string item>xml ! This should change < and &
-    "string" build-tag ;
+M: string item>xml
+    [XML <string><-></string> XML] ;
 
 : struct-member ( name value -- tag )
-    swap dup string?
-    [ "Struct member name must be string" throw ] unless
-    "name" build-tag swap
-    item>xml "value" build-tag
-    2array "member" build-tag* ;
+    over string? [ "Struct member name must be string" throw ] unless
+    item>xml
+    [XML
+        <member>
+            <name><-></name>
+            <value><-></value>
+        </member>
+    XML] ;
 
 M: hashtable item>xml
     [ struct-member ] { } assoc>map
-    "struct" build-tag* ;
+    [XML <struct><-></struct> XML] ;
 
 M: array item>xml
-    [ item>xml "value" build-tag ] map
-    "data" build-tag* "array" build-tag ;
+    [ item>xml [XML <value><-></value> XML] ] map
+    [XML <array><data><-></data></array> XML] ;
 
 TUPLE: base64 string ;
 
 C: <base64> base64
 
 M: base64 item>xml
-    string>> >base64 "base64" build-tag ;
+    string>> >base64
+    [XML <base64><-></base64> XML] ;
 
 : params ( seq -- xml )
-    [ item>xml "value" build-tag "param" build-tag ] map
-    "params" build-tag* ;
+    [ item>xml [XML <param><value><-></value></param> XML] ] map
+    [XML <params><-></params> XML] ;
 
 : method-call ( name seq -- xml )
-    params [ "methodName" build-tag ] dip
-    2array "methodCall" build-tag* build-xml ;
+    params
+    <XML
+        <methodCall>
+            <methodName><-></methodName>
+            <->
+        </methodCall>
+    XML> ;
 
 : return-params ( seq -- xml )
-    params "methodResponse" build-tag build-xml ;
+    params <XML <methodResponse><-></methodResponse> XML> ;
 
 : return-fault ( fault-code fault-string -- xml )
     [ "faultString" set "faultCode" set ] H{ } make-assoc item>xml
-    "value" build-tag "fault" build-tag "methodResponse" build-tag
-    build-xml ;
+    <XML
+        <methodResponse>
+            <fault>
+                <value><-></value>
+            </fault>
+        </methodResponse>
+    XML> ;
 
 TUPLE: rpc-method name params ;
 
diff --git a/basis/xml/interpolate/interpolate.factor b/basis/xml/interpolate/interpolate.factor
index d9ba8e1036..2334a5c3cc 100644
--- a/basis/xml/interpolate/interpolate.factor
+++ b/basis/xml/interpolate/interpolate.factor
@@ -3,7 +3,7 @@
 USING: xml xml.state kernel sequences fry assocs xml.data
 accessors strings make multiline parser namespaces macros
 sequences.deep generalizations locals words combinators
-math present ;
+math present arrays ;
 IN: xml.interpolate
 
 <PRIVATE
@@ -31,7 +31,8 @@ DEFER: interpolate-sequence
 GENERIC: push-item ( item -- )
 M: string push-item , ;
 M: object push-item , ;
-M: sequence push-item % ;
+M: sequence push-item
+    [ dup array? [ % ] [ , ] if ] each ;
 
 GENERIC: interpolate-item ( table item -- )
 M: object interpolate-item nip , ;