XML fry

basis/xml/elements/elements.factor

@@ -8,9 +8,11 @@ IN: xml.elements
 
 : take-interpolated ( quot -- interpolated )
     interpolating? get [
-        drop pass-blank
-        " \t\r\n-" take-to <interpolated>
-        pass-blank "->" expect
+        drop get-char CHAR: > =
+        [ next f ] [
+            pass-blank " \t\r\n-" take-to
+            pass-blank "->" expect
+        ] if <interpolated>
     ] [ call ] if ; inline
 
 : interpolate-quote ( -- interpolated )

basis/xml/interpolate/interpolate-tests.factor

@@ -2,11 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test xml.interpolate multiline kernel assocs
 sequences accessors xml.writer xml.interpolate.private
-locals ;
+locals splitting ;
 IN: xml.interpolate.tests
 
-[ "a" "c" { "a" "c" } ] [
-    "<?xml version='1.0'?><x><-a-><b val=<-c->/></x>"
+[ "a" "c" { "a" "c" f } ] [
+    "<?xml version='1.0'?><x><-a-><b val=<-c->/><-></x>"
     interpolated-doc
     [ second var>> ]
     [ fourth "val" swap at var>> ]
@@ -27,3 +27,20 @@ IN: xml.interpolate.tests
         XML> pprint-xml>string
     ]
 ] unit-test
+
+[ {" <?xml version="1.0" encoding="UTF-8"?>
+<doc>
+  <item>
+    one
+  </item>
+  <item>
+    two
+  </item>
+  <item>
+    three
+  </item>
+</doc>"} ] [
+    "one two three" " " split
+    [ [XML <item><-></item> XML] ] map
+    <XML <doc><-></doc> XML> pprint-xml>string
+] unit-test

basis/xml/interpolate/interpolate.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: xml xml.state kernel sequences fry assocs xml.data
 accessors strings make multiline parser namespaces macros
-sequences.deep ;
+sequences.deep generalizations locals words combinators
+math ;
 IN: xml.interpolate
 
 <PRIVATE
@@ -41,32 +42,48 @@ M: interpolated interpolate-item
 : interpolate-xml-doc ( table xml -- xml )
     (clone) [ interpolate-tag ] change-body ;
 
+GENERIC# (each-interpolated) 1 ( item quot -- ) inline
+M: interpolated (each-interpolated) call ;
+M: tag (each-interpolated)
+    swap attrs>> values
+    [ interpolated? ] filter
+    swap each ;
+M: object (each-interpolated) 2drop ;
+
+: each-interpolated ( xml quot -- )
+    '[ _ (each-interpolated) ] deep-each ; inline
+
+:: number<-> ( doc -- doc )
+    0 :> n! doc [
+        dup var>> [ n >>var n 1+ n! ] unless drop
+    ] each-interpolated doc ;
+
 MACRO: interpolate-xml ( string -- doc )
-    interpolated-doc '[ _ interpolate-xml-doc ] ;
+    interpolated-doc number<-> '[ _ interpolate-xml-doc ] ;
 
 MACRO: interpolate-chunk ( string -- chunk )
-    interpolated-chunk '[ _ interpolate-sequence ] ;
+    interpolated-chunk number<-> '[ _ interpolate-sequence ] ;
 
 : >search-hash ( seq -- hash )
     [ dup search ] H{ } map>assoc ;
 
-GENERIC: extract-item ( item -- )
-M: interpolated extract-item var>> , ;
-M: tag extract-item
-    attrs>> values
-    [ interpolated? ] filter
-    [ var>> , ] each ;
-M: object extract-item drop ;
-
 : extract-variables ( xml -- seq )
-    [ [ extract-item ] deep-each ] { } make ;
+    [ [ var>> , ] each-interpolated ] { } make ;
+
+: collect ( accum seq -- accum )
+    {
+        { [ dup [ ] all? ] [ >search-hash parsed ] } ! locals
+        { [ dup [ not ] all? ] [ ! fry
+            length parsed \ narray parsed \ <enum> parsed
+        ] }
+        [ drop "XML interpolation contains both fry and locals" throw ] ! mixed
+    } cond ;
 
 : parse-def ( accum delimiter word -- accum )
     [
-        parse-multiline-string [
-            interpolated-chunk extract-variables
-            >search-hash parsed
-        ] keep parsed
+        parse-multiline-string
+        [ interpolated-chunk extract-variables collect ] keep
+        parsed
     ] dip parsed ;
 
 PRIVATE>