extra/webapps/mason/grids/grids.factor

   1 ! Copyright (C) 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs db.tuples furnace.actions
   4 furnace.utilities http.server.responses kernel locals sequences
   5 splitting urls xml.syntax xml.writer webapps.mason.backend
   6 webapps.mason.version.data webapps.mason.utils ;
   7 IN: webapps.mason.grids
   8
   9 : render-grid-cell ( cpu os quot -- xml )
  10     call( cpu os -- url label )
  11     2dup and
  12     [ link [XML <td class="supported"><div class="bigdiv"><-></div></td> XML] ]
  13     [ 2drop [XML <td class="doesnotexist" /> XML] ]
  14     if ;
  15
  16 CONSTANT: oses
  17 {
  18     { "winnt" "Windows" }
  19     { "macosx" "Mac OS X" }
  20     { "linux" "Linux" }
  21     { "freebsd" "FreeBSD" }
  22     { "openbsd" "OpenBSD" }
  23 }
  24
  25 CONSTANT: cpus
  26 {
  27     { "x86.32" "x86" }
  28     { "x86.64" "x86-64" }
  29 }
  30
  31 : render-grid-header ( -- xml )
  32     oses values [ [XML <th align='center' scope='col'><-></th> XML] ] map ;
  33
  34 :: render-grid-row ( cpu quot -- xml )
  35     cpu second oses keys [| os | cpu os quot render-grid-cell ] map
  36     [XML <tr><th align='center' scope='row'><-></th><-></tr> XML] ;
  37
  38 :: render-grid ( quot -- xml )
  39     render-grid-header
  40     cpus [ quot render-grid-row ] map
  41     [XML
  42         <table id="downloads" cellspacing="0">
  43             <tr><th class="nobg">OS/CPU</th><-></tr>
  44             <->
  45         </table>
  46     XML] ;
  47
  48 : package-date ( filename -- date )
  49     "." split1 drop 16 tail* 6 head* ;
  50
  51 : package-grid-cell ( cpu os -- url label )
  52     builder new swap >>os swap >>cpu select-tuple [
  53         [ package-url ]
  54         [ last-release>> [ package-date ] [ "N/A" ] if* ] bi
  55     ] [ f f ] if* ;
  56
  57 : package-grid ( -- xml )
  58     [ package-grid-cell ] render-grid ;
  59
  60 : <package-grid-action> ( -- action )
  61     <action>
  62     [
  63         [
  64             package-grid xml>string
  65             "text/html" <content>
  66         ] with-mason-db
  67     ] >>display ;
  68
  69 : release-version ( filename -- release )
  70     ".tar.gz" ?tail drop ".zip" ?tail drop ".dmg" ?tail drop
  71     "-" split1-last nip ;
  72
  73 : release-grid-cell ( cpu os -- url label )
  74     release new swap >>os swap >>cpu select-tuple [
  75         [ release-url ]
  76         [ last-release>> [ release-version ] [ "N/A" ] if* ] bi
  77     ] [ f f ] if* ;
  78
  79 : release-grid ( -- xml )
  80     [ release-grid-cell ] render-grid ;
  81
  82 : <release-grid-action> ( -- action )
  83     <action>
  84     [
  85         [
  86             release-grid xml>string
  87             "text/html" <content>
  88         ] with-mason-db
  89     ] >>display ;