 
 : 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 ;

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 ;
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>
            "Read More..." write
        </a>
    </p> ;

SYMBOL: default-blogroll
SYMBOL: cached-postings

: mini-planet-factor ( -- )
    cached-postings get 4 head print-posting-summaries ;

: planet-factor ( -- )
    serving-html [ "planet" render-template ] with-html-stream ;

\ planet-factor { } define-action

: 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
