]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/syndication/syndication.factor
Revert "sequences.product: faster product iteration."
[factor.git] / basis / syndication / syndication.factor
old mode 100755 (executable)
new mode 100644 (file)
index 4cd5ef1..8e6010f
@@ -1,11 +1,10 @@
 ! Copyright (C) 2006 Chris Double, Daniel Ehrenberg.
-! Portions copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: xml.utilities kernel assocs math.order
-    strings sequences xml.data xml.writer
-    io.streams.string combinators xml xml.entities.html io.files io
-    http.client namespaces make xml.literals hashtables
-    calendar.format accessors continuations urls present ;
+! Portions copyright (C) 2008, 2009 Slava Pestov.
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors byte-arrays calendar.format calendar.parser
+combinators combinators.short-circuit continuations http.client
+kernel present sequences strings urls xml xml.data
+xml.entities.html xml.syntax xml.traversal xml.writer ;
 IN: syndication
 
 : any-tag-named ( tag names -- tag-inside )
@@ -27,57 +26,59 @@ TUPLE: entry title url description date ;
 : try-parsing-timestamp ( string -- timestamp )
     [ rfc822>timestamp ] [ drop rfc3339>timestamp ] recover ;
 
+: ?children>string ( tag -- str/f )
+    dup [ children>string ] when ; inline
+
 : rss1.0-entry ( tag -- entry )
-    entry new
-    swap {
+    <entry> swap {
         [ "title" tag-named children>string >>title ]
         [ "link" tag-named children>string >url >>url ]
         [ "description" tag-named children>string >>description ]
         [
-            f "date" "http://purl.org/dc/elements/1.1/" <name>
+            f "date" "https://purl.org/dc/elements/1.1/" <name>
             tag-named dup [ children>string try-parsing-timestamp ] when
             >>date
         ]
     } cleave ;
 
 : rss1.0 ( xml -- feed )
-    feed new
-    swap [
+    <feed> swap [
         "channel" tag-named
         [ "title" tag-named children>string >>title ]
         [ "link" tag-named children>string >url >>url ] bi
     ] [ "item" tags-named [ rss1.0-entry ] map set-entries ] bi ;
 
 : rss2.0-entry ( tag -- entry )
-    entry new
-    swap {
-        [ "title" tag-named children>string >>title ]
-        [ { "link" "guid" } any-tag-named children>string >url >>url ]
-        [ { "description" "encoded" } any-tag-named children>string >>description ]
+    <entry> swap {
+        [ "title" tag-named ?children>string >>title ]
+        [ { "link" "guid" } any-tag-named ?children>string >url >>url ]
+        [ { "description" "encoded" } any-tag-named ?children>string >>description ]
         [
             { "date" "pubDate" } any-tag-named
-            children>string try-parsing-timestamp >>date
+            ?children>string try-parsing-timestamp >>date
         ]
     } cleave ;
 
 : rss2.0 ( xml -- feed )
-    feed new
-    swap
-    "channel" tag-named 
+    <feed> swap
+    "channel" tag-named
     [ "title" tag-named children>string >>title ]
     [ "link" tag-named children>string >url >>url ]
     [ "item" tags-named [ rss2.0-entry ] map set-entries ]
     tri ;
 
-: atom-entry-link ( tag -- url/f )
-    "link" tags-named [ "rel" attr "alternate" = ] find nip
-    dup [ "href" attr >url ] when ;
+: atom-link ( tag -- url/f )
+    {
+        [ "link" "alternate" "rel" tag-named-with-attr ]
+        [ "link" "self" "rel" tag-named-with-attr ]
+        [ "link" tag-named ]
+    } 1||
+    [ "href" attr >url ] [ f ] if* ;
 
 : atom1.0-entry ( tag -- entry )
-    entry new
-    swap {
+    <entry> swap {
         [ "title" tag-named children>string >>title ]
-        [ atom-entry-link >>url ]
+        [ atom-link >>url ]
         [
             { "content" "summary" } any-tag-named
             dup children>> [ string? not ] any?
@@ -85,17 +86,16 @@ TUPLE: entry title url description date ;
             [ children>string ] if >>description
         ]
         [
-            { "published" "updated" "issued" "modified" } 
+            { "published" "updated" "issued" "modified" }
             any-tag-named children>string try-parsing-timestamp
             >>date
         ]
     } cleave ;
 
 : atom1.0 ( xml -- feed )
-    feed new
-    swap
+    <feed> swap
     [ "title" tag-named children>string >>title ]
-    [ "link" tag-named "href" attr >url >>url ]
+    [ atom-link >>url ]
     [ "entry" tags-named [ atom1.0-entry ] map set-entries ]
     tri ;
 
@@ -106,12 +106,15 @@ TUPLE: entry title url description date ;
         { "feed" [ atom1.0 ] }
     } case ;
 
-: string>feed ( string -- feed )
-    [ string>xml xml>feed ] with-html-entities ;
+GENERIC: parse-feed ( seq -- feed )
+
+M: string parse-feed [ string>xml xml>feed ] with-html-entities ;
+
+M: byte-array parse-feed [ bytes>xml xml>feed ] with-html-entities ;
 
 : download-feed ( url -- feed )
-    #! Retrieve an news syndication file, return as a feed tuple.
-    http-get nip string>feed ;
+    ! Retrieve an news syndication file, return as a feed tuple.
+    http-get nip parse-feed ;
 
 ! Atom generation
 
@@ -125,7 +128,7 @@ TUPLE: entry title url description date ;
     [XML
         <entry>
             <title type="html"><-></title>
-            <link href=<-> />
+            <link rel="alternate" href=<-> />
             <published><-></published>
             <content type="html"><-></content>
         </entry>
@@ -138,7 +141,7 @@ TUPLE: entry title url description date ;
     <XML
         <feed xmlns="http://www.w3.org/2005/Atom">
             <title><-></title>
-            <link href=<-> />
+            <link rel="alternate" href=<-> />
             <->
         </feed>
     XML> ;