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/>
- "- " write
- dup posting-author write bl
- <a posting-link =href "more" =class a>
+ <b> dup entry-title write </b> <br/>
+ <a entry-link =href "more" =class a>
"Read More..." write
</a>
</p> ;
: print-posting ( posting -- )
<h2 "posting-title" =class h2>
- <a dup posting-link =href a>
- dup posting-title write-html
- " - " write
- dup posting-author write
+ <a dup entry-link =href a>
+ dup entry-title write-html
</a>
</h2>
- <p "posting-body" =class p> dup posting-body write-html </p>
- <p "posting-date" =class p> posting-date format-date write </p> ;
+ <p "posting-body" =class 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 ;
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 [
- "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> ;
+
+: 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 ;
+
+: <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
"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> <entry>
- 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