RSS feed in planet

extra/webapps/planet/planet.factor

@@ -1,41 +1,14 @@
 USING: sequences rss arrays concurrency kernel sorting
 html.elements io assocs namespaces math threads vocabs html
 furnace http.server.templating calendar math.parser splitting
-continuations debugger system http.server.responders ;
+continuations debugger system http.server.responders
+xml.writer ;
 IN: webapps.planet
 
-TUPLE: posting author title date link body ;
-
-: diagnostic write print flush ;
-
-: fetch-feed ( pair -- feed )
-    second
-    dup "Fetching " diagnostic
-    dup download-feed feed-entries
-    swap "Done fetching " diagnostic ;
-
-: fetch-blogroll ( blogroll -- entries )
-    #! entries is an array of { author entries } pairs.
-    dup [
-        [ fetch-feed ] [ error. drop f ] recover
-    ] parallel-map
-    [ [ >r first r> 2array ] curry* map ] 2map concat ;
-
-: sort-entries ( entries -- entries' )
-    [ [ second entry-pub-date ] compare ] sort <reversed> ;
-
-: <posting> ( pair -- posting )
-    #! pair has shape { author entry }
-    first2
-    { entry-title entry-pub-date entry-link entry-description }
-    get-slots posting construct-boa ;
-
 : print-posting-summary ( posting -- )
     <p "news" =class p>
-        <b> dup posting-title write </b> <br/>
+        <b> dup entry-title write </b> <br/>
-        "- " write
+        <a entry-link =href "more" =class a>
-        dup posting-author write bl
-        <a posting-link =href "more" =class a>
             "Read More..." write
         </a>
     </p> ;
@@ -63,14 +36,16 @@ TUPLE: posting author title date link body ;
 
 : print-posting ( posting -- )
     <h2 "posting-title" =class h2>
-        <a dup posting-link =href a>
+        <a dup entry-link =href a>
-            dup posting-title write-html
+            dup entry-title write-html
-            " - " write
-            dup posting-author write
         </a>
     </h2>
-    <p "posting-body" =class p> dup posting-body write-html </p>
+    <p "posting-body" =class p>
-    <p "posting-date" =class p> posting-date format-date write </p> ;
+        dup entry-description write-html
+    </p>
+    <p "posting-date" =class p>
+        entry-pub-date format-date write
+    </p> ;
 
 : print-postings ( postings -- )
     [ print-posting ] each ;
@@ -83,38 +58,56 @@ TUPLE: posting author title date link body ;
 SYMBOL: default-blogroll
 SYMBOL: cached-postings
 
-: update-cached-postings ( -- )
-    default-blogroll get fetch-blogroll sort-entries
-    [ <posting> ] map
-    cached-postings set-global ;
-
 : mini-planet-factor ( -- )
     cached-postings get 4 head print-posting-summaries ;
 
 : planet-factor ( -- )
-    serving-html [
+    serving-html [ "planet" render-template ] with-html-stream ;
-        "resource:extra/webapps/planet/planet.fhtml"
-        run-template-file
-    ] with-html-stream ;
 
 \ planet-factor { } define-action
 
-{
+: planet-feed ( -- feed )
-    { "Berlin Brown" "http://factorlang-fornovices.blogspot.com/feeds/posts/default" "http://factorlang-fornovices.blogspot.com" }
+    "[ planet-factor ]"
-    { "Chris Double" "http://www.bluishcoder.co.nz/atom.xml" "http://www.bluishcoder.co.nz/" }
+    "http://planet.factorcode.org"
-    { "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" }
+    cached-postings get 30 head <feed> ;
-    { "Doug Coleman" "http://code-factor.blogspot.com/feeds/posts/default" "http://code-factor.blogspot.com/" }
+
-    { "Daniel Ehrenberg" "http://useless-factor.blogspot.com/feeds/posts/default" "http://useless-factor.blogspot.com/" }
+: feed.xml
-    { "Kio M. Smallwood"
+    "text/xml" serving-content
-    "http://sekenre.wordpress.com/feed/atom/"
+    planet-feed feed>xml write-xml ;
-    "http://sekenre.wordpress.com/" }
+
-    { "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" }
+\ feed.xml { } define-action
-    { "Samuel Tardieu" "http://www.rfc1149.net/blog/tag/factor/feed/atom/" "http://www.rfc1149.net/blog/tag/factor/" }
-    { "Slava Pestov" "http://factor-language.blogspot.com/atom.xml" "http://factor-language.blogspot.com/" }
-} default-blogroll set-global
 
 SYMBOL: last-update
 
+: diagnostic write print flush ;
+
+: fetch-feed ( triple -- feed )
+    second
+    dup "Fetching " diagnostic
+    dup download-feed feed-entries
+    swap "Done fetching " diagnostic ;
+
+: <posting> ( author entry -- entry' )
+    clone
+    [ ": " swap entry-title 3append ] keep
+    [ set-entry-title ] keep ;
+
+: ?fetch-feed ( triple -- feed/f )
+    [ fetch-feed ] [ error. drop f ] recover ;
+
+: fetch-blogroll ( blogroll -- entries )
+    dup 0 <column>
+    swap [ ?fetch-feed ] parallel-map
+    [ [ <posting> ] curry* map ] 2map concat ;
+
+: sort-entries ( entries -- entries' )
+    [ [ entry-pub-date ] compare ] sort <reversed> ;
+
+: update-cached-postings ( -- )
+    default-blogroll get
+    fetch-blogroll sort-entries
+    cached-postings set-global ;
+
 : update-thread ( -- )
     millis last-update set-global
     [ update-cached-postings ] in-thread
@@ -126,14 +119,16 @@ SYMBOL: last-update
 
 "planet" "planet-factor" "extra/webapps/planet" web-app
 
-: merge-feeds ( feeds -- feed )
+{
-    [ feed-entries ] map concat sort-entries ;
+    { "Berlin Brown" "http://factorlang-fornovices.blogspot.com/feeds/posts/default" "http://factorlang-fornovices.blogspot.com" }
-
+    { "Chris Double" "http://www.bluishcoder.co.nz/atom.xml" "http://www.bluishcoder.co.nz/" }
-: planet-feed ( -- feed )
+    { "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" }
-    default-blogroll get [ second download-feed ] map merge-feeds 
+    { "Doug Coleman" "http://code-factor.blogspot.com/feeds/posts/default" "http://code-factor.blogspot.com/" }
-    >r "[ planet-factor ]" "http://planet.factorcode.org" r> <entry>
+    { "Daniel Ehrenberg" "http://useless-factor.blogspot.com/feeds/posts/default" "http://useless-factor.blogspot.com/" }
-    feed>xml ;
+    { "Kio M. Smallwood"
-
+    "http://sekenre.wordpress.com/feed/atom/"
-: feed.xml planet-feed ;
+    "http://sekenre.wordpress.com/" }
-
+    ! { "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" }
-\ feed.xml { } define-action
+    { "Samuel Tardieu" "http://www.rfc1149.net/blog/tag/factor/feed/atom/" "http://www.rfc1149.net/blog/tag/factor/" }
+    { "Slava Pestov" "http://factor-language.blogspot.com/atom.xml" "http://factor-language.blogspot.com/" }
+} default-blogroll set-global