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 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"><-></td> XML] ]
  13     [ 2drop [XML <td class="doesnotexist" /> XML] ]
  14     if ;
  15
  16 CONSTANT: oses
  17 {
  18     { "windows" "Windows" }
  19     { "macosx" "Mac OS" }
  20     { "linux" "Linux" }
  21 }
  22
  23 CONSTANT: cpus
  24 {
  25     { "x86.32" "x86" }
  26     { "x86.64" "x86-64" }
  27 }
  28
  29 : render-grid-header ( -- xml )
  30     oses values [ [XML <th scope='col'><-></th> XML] ] map ;
  31
  32 :: render-grid-row ( cpu quot -- xml )
  33     cpu second oses keys [| os | cpu os quot render-grid-cell ] map
  34     [XML <tr><th scope='row'><-></th><-></tr> XML] ;
  35
  36 :: render-grid ( quot -- xml )
  37     render-grid-header
  38     cpus [ quot render-grid-row ] map
  39     [XML
  40         <table class="downloads" cellspacing="0">
  41             <tr><th class="nobg">OS/CPU</th><-></tr>
  42             <->
  43         </table>
  44     XML] ;
  45
  46 : package-date ( filename -- date )
  47     "." split1 drop 16 tail* 6 head* ;
  48
  49 : package-grid-cell ( cpu os -- url label )
  50     builder new swap >>os swap >>cpu select-tuple [
  51         [ package-url ]
  52         [ last-release>> [ package-date ] [ "N/A" ] if* ] bi
  53     ] [ f f ] if* ;
  54
  55 : package-grid ( -- xml )
  56     [ package-grid-cell ] render-grid ;
  57
  58 : <package-grid-action> ( -- action )
  59     <action>
  60     [
  61         [
  62             package-grid xml>string
  63             <html-content>
  64         ] with-mason-db
  65     ] >>display ;
  66
  67 : release-version ( filename -- release )
  68     ".tar.gz" ?tail drop ".zip" ?tail drop ".dmg" ?tail drop
  69     "-" split1-last nip ;
  70
  71 : release-grid-cell ( cpu os -- url label )
  72     release new swap >>os swap >>cpu select-tuple [
  73         [ release-url ]
  74         [ last-release>> [ release-version ] [ "N/A" ] if* ] bi
  75     ] [ f f ] if* ;
  76
  77 : release-grid ( -- xml )
  78     [ release-grid-cell ] render-grid ;
  79
  80 : <release-grid-action> ( -- action )
  81     <action>
  82     [
  83         [
  84             release-grid xml>string
  85             <html-content>
  86         ] with-mason-db
  87     ] >>display ;