contrib/httpd/darcs-responder.factor

   1 USING: httpd io kernel namespaces sequences xml ;
   2
   3 SYMBOL: darcs-directory
   4
   5 "/var/www/factorcode.org/repos/" darcs-directory set
   6
   7 : darcs-changelog
   8     darcs-directory get cd
   9     "darcs changes --xml" "r" <process-stream> contents xml ;
  10
  11 : rss-item ( { title date author } -- )
  12     "item" [ ] [
  13         { "title" "pubDate" "author" } [ [ ] text-tag ] 2each
  14     ] tag ;
  15
  16 : ?tag-name ( tag -- name/f )
  17     dup tag? [ tag-name ] [ drop f ] if ;
  18
  19 : children-named ( tag name -- seq )
  20     swap tag-children [ ?tag-name = ] subset-with ;
  21
  22 : tag-child ( tag name -- tag )
  23     children-named first ;
  24
  25 : patch>rss-item ( tag -- { title link author date } )
  26     [
  27         dup "name" tag-child tag-children %
  28         tag-props [ "local_date" get , "author" get , ] bind
  29     ] { } make ;
  30
  31 SYMBOL: rss-feed-title
  32 SYMBOL: rss-feed-link
  33 SYMBOL: rss-feed-description
  34
  35 "Factor DARCS repository" rss-feed-title set
  36 "http://factorcode.org/repos/" rss-feed-link set
  37 "Recent patches applied to the Factor DARCS repository" rss-feed-description set
  38
  39 : rss-metadata ( -- )
  40     { rss-feed-title rss-feed-link rss-feed-description }
  41     { "title" "link" "description" }
  42     [ >r get r> [ ] text-tag ] 2each ;
  43
  44 : rss-feed ( items -- string )
  45     [
  46         "rss" [ "2.0" "version" set ] [
  47             "channel" [ ] [ rss-metadata [ rss-item ] each ] tag
  48         ] tag
  49     ] make-xml xml>string ;
  50
  51 : changelog>rss-feed ( xml -- string )
  52     "patch" children-named [ patch>rss-item ] map rss-feed ;
  53
  54 : darcs-rss-feed darcs-changelog changelog>rss-feed print ;
  55
  56 "darcs" [ darcs-rss-feed ] add-simple-responder