Merge branch 'master' into xml

[factor.git] / extra / rss / rss.factor

diff --git a/extra/rss/rss.factor b/extra/rss/rss.factor
index d34a9855180e9746f280e1d5e53486c77e736ea5..233dfcb221a05fd09df89c4a21c648e336ac7e87 100644 (file)
--- a/extra/rss/rss.factor
+++ b/extra/rss/rss.factor
@@ -9,6 +9,9 @@ USING: xml.utilities kernel assocs xml.generator
 : ?children>string ( tag/f -- string/f )
     [ children>string ] [ f ] if* ;
 
+: any-tag-named ( tag names -- tag-inside )
+    f -rot [ tag-named nip dup ] curry* find 2drop ;
+
 TUPLE: feed title link entries ;
 
 C: <feed> feed
@@ -17,50 +20,51 @@ TUPLE: entry title link description pub-date ;
 
 C: <entry> entry
 
+: rss1.0-entry ( tag -- entry )
+    [ "title" tag-named children>string ] keep   
+    [ "link" tag-named children>string ] keep
+    [ "description" tag-named children>string ] keep
+    f "date" "http://purl.org/dc/elements/1.1/" <name>
+    tag-named ?children>string
+    <entry> ;
+
 : rss1.0 ( xml -- feed )
     [
         "channel" tag-named
         [ "title" tag-named children>string ] keep
         "link" tag-named children>string
     ] keep
-    "item" tags-named [
-        [ "title" tag-named children>string ] keep   
-        [ "link" tag-named children>string ] keep
-        [ "description" tag-named children>string ] keep
-        f "date" "http://purl.org/dc/elements/1.1/" <name>
-        tag-named ?children>string
-        <entry>
-    ] map <feed> ;
+    "item" tags-named [ rss1.0-entry ] map <feed> ;
+
+: rss2.0-entry ( tag -- entry )
+    [ "title" tag-named children>string ] keep
+    [ "link" tag-named ] keep
+    [ "guid" tag-named dupd ? children>string ] keep
+    [ "description" tag-named children>string ] keep
+    "pubDate" tag-named children>string <entry> ;
 
 : rss2.0 ( xml -- feed )
     "channel" tag-named 
     [ "title" tag-named children>string ] keep
     [ "link" tag-named children>string ] keep
-    "item" tags-named [
-        [ "title" tag-named children>string ] keep
-        [ "link" tag-named ] keep
-        [ "guid" tag-named dupd ? children>string ] keep
-        [ "description" tag-named children>string ] keep
-        "pubDate" tag-named children>string <entry>
-    ] map <feed> ;
+    "item" tags-named [ rss2.0-entry ] map <feed> ;
+
+: atom1.0-entry ( tag -- entry )
+    [ "title" tag-named children>string ] keep
+    [ "link" tag-named "href" swap at ] keep
+    [
+        { "content" "summary" } any-tag-named
+        dup tag-children [ string? not ] contains?
+        [ tag-children [ write-chunk ] string-out ]
+        [ children>string ] if
+    ] keep
+    { "published" "updated" "issued" "modified" } any-tag-named
+    children>string <entry> ;
 
 : atom1.0 ( xml -- feed )
     [ "title" tag-named children>string ] keep
     [ "link" tag-named "href" swap at ] keep
-    "entry" tags-named [
-        [ "title" tag-named children>string ] keep
-        [ "link" tag-named "href" swap at ] keep
-        [
-            dup "content" tag-named
-            [ nip ] [ "summary" tag-named ] if*
-            dup tag-children [ tag? ] contains?
-            [ tag-children [ write-chunk ] string-out ]
-            [ children>string ] if
-        ] keep
-        dup "published" tag-named
-        [ nip ] [ "updated" tag-named ] if*
-        children>string <entry>
-    ] map <feed> ;
+    "entry" tags-named [ atom1.0-entry ] map <feed> ;
 
 : xml>feed ( xml -- feed )
     dup name-tag {
@@ -98,5 +102,5 @@ C: <entry> entry
         ]
     XML> ;
 
-: write-feed ( feed -- xml )
+: write-feed ( feed -- )
     feed>xml write-xml ;