From 214974ec52d97de3d9917b29d7bd122d821e2c83 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 5 Dec 2007 23:16:13 -0500 Subject: [PATCH 1/2] Fix feed>xml --- extra/rss/rss.factor | 9 ++++++--- extra/webapps/planet/{planet.fhtml => planet.furnace} | 7 ++++++- 2 files changed, 12 insertions(+), 4 deletions(-) rename extra/webapps/planet/{planet.fhtml => planet.furnace} (83%) diff --git a/extra/rss/rss.factor b/extra/rss/rss.factor index da810ee377..0e78208f86 100644 --- a/extra/rss/rss.factor +++ b/extra/rss/rss.factor @@ -74,7 +74,7 @@ C: entry : download-feed ( url -- feed ) #! Retrieve an news syndication file, return as a feed tuple. - http-get rot 200 = [ + http-get-stream rot 200 = [ nip read-feed ] [ 2drop "Error retrieving newsfeed file" throw @@ -84,12 +84,15 @@ C: entry : simple-tag, ( content name -- ) [ , ] tag, ; +: simple-tag*, ( content name attrs -- ) + [ , ] tag*, ; + : entry, ( entry -- ) "entry" [ - dup entry-title "title" simple-tag, + dup entry-title "title" { { "type" "html" } } simple-tag*, "link" over entry-link "href" associate contained*, dup entry-pub-date "published" simple-tag, - entry-description "content" simple-tag, + entry-description "content" { { "type" "html" } } simple-tag*, ] tag, ; : feed>xml ( feed -- xml ) diff --git a/extra/webapps/planet/planet.fhtml b/extra/webapps/planet/planet.furnace similarity index 83% rename from extra/webapps/planet/planet.fhtml rename to extra/webapps/planet/planet.furnace index fb5a673077..bc9172a55a 100644 --- a/extra/webapps/planet/planet.fhtml +++ b/extra/webapps/planet/planet.furnace @@ -9,6 +9,7 @@ planet-factor + @@ -23,7 +24,11 @@ Planet Lisp.

- This webapp is written in Factor. + + Syndicate +

+

+ This webapp is written in Factor.
<% "webapps.planet" browse-webapp-source %>

Blogroll

From 4eb4982e60264f62bc3c2341bb9046d2a4dee11b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 5 Dec 2007 23:16:20 -0500 Subject: [PATCH 2/2] RSS feed in planet --- extra/webapps/planet/planet.factor | 135 ++++++++++++++--------------- 1 file changed, 65 insertions(+), 70 deletions(-) diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index 9fdafe033b..92da085128 100644 --- a/extra/webapps/planet/planet.factor +++ b/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 ; - -: ( 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 -- )

- dup posting-title write
- "- " write - dup posting-author write bl - + dup entry-title write
+ "Read More..." write

; @@ -63,14 +36,16 @@ TUPLE: posting author title date link body ; : print-posting ( posting -- )

- - dup posting-title write-html - " - " write - dup posting-author write + + dup entry-title write-html

-

dup posting-body write-html

-

posting-date format-date write

; +

+ dup entry-description write-html +

+

+ entry-pub-date format-date write +

; : 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 - [ ] map - cached-postings set-global ; - : mini-planet-factor ( -- ) cached-postings get 4 head print-posting-summaries ; : planet-factor ( -- ) - serving-html [ - "resource:extra/webapps/planet/planet.fhtml" - run-template-file - ] with-html-stream ; + serving-html [ "planet" render-template ] with-html-stream ; \ planet-factor { } define-action -{ - { "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/" } - { "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" } - { "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/" } - { "Kio M. Smallwood" - "http://sekenre.wordpress.com/feed/atom/" - "http://sekenre.wordpress.com/" } - { "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" } - { "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 +: planet-feed ( -- feed ) + "[ planet-factor ]" + "http://planet.factorcode.org" + cached-postings get 30 head ; + +: feed.xml + "text/xml" serving-content + planet-feed feed>xml write-xml ; + +\ feed.xml { } define-action SYMBOL: last-update +: diagnostic write print flush ; + +: fetch-feed ( triple -- feed ) + second + dup "Fetching " diagnostic + dup download-feed feed-entries + swap "Done fetching " diagnostic ; + +: ( 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 + swap [ ?fetch-feed ] parallel-map + [ [ ] curry* map ] 2map concat ; + +: sort-entries ( entries -- entries' ) + [ [ entry-pub-date ] compare ] sort ; + +: 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 ; - -: planet-feed ( -- feed ) - default-blogroll get [ second download-feed ] map merge-feeds - >r "[ planet-factor ]" "http://planet.factorcode.org" r> - feed>xml ; - -: feed.xml planet-feed ; - -\ feed.xml { } define-action +{ + { "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/" } + { "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" } + { "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/" } + { "Kio M. Smallwood" + "http://sekenre.wordpress.com/feed/atom/" + "http://sekenre.wordpress.com/" } + ! { "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" } + { "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