! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors calendar db db.tuples grouping io
+USING: accessors calendar db db.tuples db.types grouping io
io.encodings.ascii io.launcher kernel locals make
mason.release.archive mason.server namespaces sequences ;
IN: mason.server.release
host-name os cpu
last-release release-git-id ;
+release "RELEASES" {
+ { "host-name" "HOST_NAME" TEXT +user-assigned-id+ }
+ { "os" "OS" TEXT +user-assigned-id+ }
+ { "cpu" "CPU" TEXT +user-assigned-id+ }
+ { "last-release" "LAST_RELEASE" TEXT }
+ { "release-git-id" "RELEASE_GIT_ID" TEXT }
+} define-persistent
+
:: <release> ( version builder -- release )
release new
builder host-name>> >>host-name
--- /dev/null
+<?xml version='1.0' ?>
+
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <link rel="stylesheet" href="http://factorcode.org/css/master.css" type="text/css" media="screen" title="no title" charset="utf-8" />
+ <title>Factor binary package for <t:label t:name="platform" /></title>
+ </head>
+ <body>
+ <div><img src="http://factorcode.org/graphics/logo.png" alt="Logo" /></div>
+
+ <h1>Factor binary package for <t:label t:name="platform" /></h1>
+
+ <p>Requirements:</p>
+ <t:xml t:name="requirements" />
+
+ <h2>Download <t:xml t:name="package" /></h2>
+
+ <p>This package was built from GIT ID <t:xml t:name="git-id" />.</p>
+
+ <p>Once you download Factor, you can <a href="http://concatenative.org/wiki/view/Factor/Getting started">get started</a> with the language.</p>
+
+ <h1>Build machine information</h1>
+
+ <table border="1">
+ <tr><td>Host name:</td><td><t:xml t:name="host-name" /></td></tr>
+ <tr><td>Current status:</td><td><t:xml t:name="status" /></td></tr>
+ <tr><td>Last build:</td><td><t:xml t:name="last-build" /></td></tr>
+ <tr><td>Last clean build:</td><td><t:xml t:name="last-clean-build" /></td></tr>
+ <tr><td>Binaries:</td><td><t:xml t:name="binaries" /></td></tr>
+ <tr><td>Clean images:</td><td><t:xml t:name="clean-images" /></td></tr>
+ </table>
+
+ <p><t:xml t:name="last-report" /></p>
+ </body>
+</html>
+
+</t:chloe>
--- /dev/null
+<?xml version='1.0' ?>
+
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <link rel="stylesheet" href="http://factorcode.org/css/master.css" type="text/css" media="screen" title="no title" charset="utf-8" />
+ <title>Factor binary package for <t:label t:name="platform" /></title>
+ </head>
+ <body>
+ <div><img src="http://factorcode.org/graphics/logo.png" alt="Logo" /></div>
+
+ <h1>Factor binary package for <t:label t:name="platform" /></h1>
+
+ <p>Requirements:</p>
+ <t:xml t:name="requirements" />
+
+ <h2>Download <t:xml t:name="release" /></h2>
+
+ <p>This release was built from GIT ID <t:xml t:name="git-id" />.</p>
+
+ <p>Once you download Factor, you can <a href="http://concatenative.org/wiki/view/Factor/Getting started">get started</a> with the language.</p>
+ </body>
+</html>
+
+</t:chloe>
+++ /dev/null
-<?xml version='1.0' ?>
-
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
- "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-<html xmlns="http://www.w3.org/1999/xhtml">
- <head>
- <link rel="stylesheet" href="http://factorcode.org/css/master.css" type="text/css" media="screen" title="no title" charset="utf-8" />
- <title>Factor binary package for <t:label t:name="platform" /></title>
- </head>
- <body>
- <div><img src="http://factorcode.org/graphics/logo.png" alt="Logo" /></div>
-
- <h1>Factor binary package for <t:label t:name="platform" /></h1>
-
- <p>Requirements:</p>
- <t:xml t:name="requirements" />
-
- <h2>Download <t:xml t:name="package" /></h2>
-
- <p>This package was built from GIT ID <t:xml t:name="git-id" />.</p>
-
- <p>Once you download Factor, you can <a href="http://concatenative.org/wiki/view/Factor/Getting started">get started</a> with the language.</p>
-
- <h1>Build machine information</h1>
-
- <table border="1">
- <tr><td>Host name:</td><td><t:xml t:name="host-name" /></td></tr>
- <tr><td>Current status:</td><td><t:xml t:name="status" /></td></tr>
- <tr><td>Last build:</td><td><t:xml t:name="last-build" /></td></tr>
- <tr><td>Last clean build:</td><td><t:xml t:name="last-clean-build" /></td></tr>
- <tr><td>Binaries:</td><td><t:xml t:name="binaries" /></td></tr>
- <tr><td>Clean images:</td><td><t:xml t:name="clean-images" /></td></tr>
- </table>
-
- <p><t:xml t:name="last-report" /></p>
- </body>
-</html>
-
-</t:chloe>
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs db.tuples furnace.actions
+furnace.utilities http.server.responses kernel locals
+mason.server mason.server.release sequences splitting urls
+webapps.mason.utils xml.syntax xml.writer ;
+IN: webapps.mason.grids
+
+: render-grid-cell ( cpu os quot -- xml )
+ call( cpu os -- url label )
+ 2dup and
+ [ link [XML <td class="supported"><div class="bigdiv"><-></div></td> XML] ]
+ [ 2drop [XML <td class="doesnotexist" /> XML] ]
+ if ;
+
+CONSTANT: oses
+{
+ { "winnt" "Windows" }
+ { "macosx" "Mac OS X" }
+ { "linux" "Linux" }
+ { "freebsd" "FreeBSD" }
+ { "netbsd" "NetBSD" }
+ { "openbsd" "OpenBSD" }
+}
+
+CONSTANT: cpus
+{
+ { "x86.32" "x86" }
+ { "x86.64" "x86-64" }
+ { "ppc" "PowerPC" }
+}
+
+: render-grid-header ( -- xml )
+ oses values [ [XML <th align='center' scope='col'><-></th> XML] ] map ;
+
+:: render-grid-row ( cpu quot -- xml )
+ cpu second oses keys [| os | cpu os quot render-grid-cell ] map
+ [XML <tr><th align='center' scope='row'><-></th><-></tr> XML] ;
+
+:: render-grid ( quot -- xml )
+ render-grid-header
+ cpus [ quot render-grid-row ] map
+ [XML
+ <table id="downloads" cellspacing="0">
+ <tr><th class="nobg">OS/CPU</th><-></tr>
+ <->
+ </table>
+ XML] ;
+
+: package-url ( builder -- url )
+ [ URL" $mason-app/package" ] dip
+ [ os>> "os" set-query-param ]
+ [ cpu>> "cpu" set-query-param ] bi
+ adjust-url ;
+
+: package-date ( filename -- date )
+ "." split1 drop 16 tail* 6 head* ;
+
+: package-grid-cell ( cpu os -- url label )
+ builder new swap >>os swap >>cpu select-tuple [
+ [ package-url ]
+ [ last-release>> [ package-date ] [ "N/A" ] if* ] bi
+ ] [ f f ] if* ;
+
+: package-grid ( -- xml )
+ [ package-grid-cell ] render-grid ;
+
+: <package-grid-action> ( -- action )
+ <action>
+ [ package-grid xml>string "text/html" <content> ] >>display ;
+
+: release-url ( builder -- url )
+ [ URL" $mason-app/release" ] dip
+ [ os>> "os" set-query-param ]
+ [ cpu>> "cpu" set-query-param ] bi
+ adjust-url ;
+
+: release-version ( filename -- release )
+ ".tar.gz" ?tail drop ".zip" ?tail drop ".dmg" ?tail drop
+ "-" split1-last nip ;
+
+: release-grid-cell ( cpu os -- url label )
+ release new swap >>os swap >>cpu select-tuple [
+ [ release-url ]
+ [ last-release>> [ release-version ] [ "N/A" ] if* ] bi
+ ] [ f f ] if* ;
+
+: release-grid ( -- xml )
+ [ release-grid-cell ] render-grid ;
+
+: <release-grid-action> ( -- action )
+ <action>
+ [ release-grid xml>string "text/html" <content> ] >>display ;
! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators db db.tuples furnace.actions
-http.server.responses http.server.dispatchers kernel mason.platform
-mason.server mason.report math.order sequences sorting
-splitting xml.syntax xml.writer io.pathnames io.encodings.utf8
-io.files present validators html.forms furnace.db urls ;
-FROM: assocs => at keys values ;
+USING: accessors furnace.db http.server.dispatchers mason.server
+webapps.mason.grids webapps.mason.package webapps.mason.release
+webapps.mason.report ;
IN: webapps.mason
TUPLE: mason-app < dispatcher ;
-: link ( url label -- xml )
- [XML <a href=<->><-></a> XML] ;
-
-: download-link ( builder label -- xml )
- [
- [ URL" http://builds.factorcode.org/download" ] dip
- [ os>> "os" set-query-param ]
- [ cpu>> "cpu" set-query-param ] bi
- ] dip link ;
-
-: download-grid-cell ( cpu os -- xml )
- builder new swap >>os swap >>cpu select-tuple [
- dup last-release>> dup
- [ "." split1 drop 16 tail* 6 head* download-link ] [ 2drop f ] if
- [XML <td class="supported"><div class="bigdiv"><-></div></td> XML]
- ] [
- [XML <td class="doesnotexist" /> XML]
- ] if* ;
-
-CONSTANT: oses
-{
- { "winnt" "Windows" }
- { "macosx" "Mac OS X" }
- { "linux" "Linux" }
- { "freebsd" "FreeBSD" }
- { "netbsd" "NetBSD" }
- { "openbsd" "OpenBSD" }
-}
-
-CONSTANT: cpus
-{
- { "x86.32" "x86" }
- { "x86.64" "x86-64" }
- { "ppc" "PowerPC" }
-}
-
-: download-grid ( -- xml )
- oses
- [ values [ [XML <th align='center' scope='col'><-></th> XML] ] map ]
- [
- keys
- cpus [
- [ nip second ] [ first ] 2bi [
- swap download-grid-cell
- ] curry map
- [XML <tr><th align='center' scope='row'><-></th><-></tr> XML]
- ] with map
- ] bi
- [XML
- <table id="downloads" cellspacing="0">
- <tr><th class="nobg">OS/CPU</th><-></tr>
- <->
- </table>
- XML] ;
-
-: <download-grid-action> ( -- action )
- <action>
- [ download-grid xml>string "text/html" <content> ] >>display ;
-
-: validate-os/cpu ( -- )
- {
- { "os" [ v-one-line ] }
- { "cpu" [ v-one-line ] }
- } validate-params ;
-
-: current-builder ( -- builder )
- builder new "os" value >>os "cpu" value >>cpu select-tuple ;
-
-: <build-report-action> ( -- action )
- <action>
- [ validate-os/cpu ] >>init
- [ current-builder last-report>> "text/html" <content> ] >>display ;
-
-: building ( builder string -- xml )
- swap current-git-id>> git-link
- [XML <-> for <-> XML] ;
-
-: status-string ( builder -- string )
- dup status>> {
- { +dirty+ [ drop "Dirty" ] }
- { +clean+ [ drop "Clean" ] }
- { +error+ [ drop "Error" ] }
- { +starting+ [ "Starting build" building ] }
- { +make-vm+ [ "Compiling VM" building ] }
- { +boot+ [ "Bootstrapping" building ] }
- { +test+ [ "Testing" building ] }
- [ 2drop "Unknown" ]
- } case ;
-
-: current-status ( builder -- xml )
- [ status-string ]
- [ current-timestamp>> present " (as of " ")" surround ] bi
- 2array ;
-
-: build-status ( git-id timestamp -- xml )
- over [ [ git-link ] [ present ] bi* " (built on " ")" surround 2array ] [ 2drop f ] if ;
-
-: binaries-url ( builder -- url )
- [ os>> ] [ cpu>> ] bi (platform) "http://downloads.factorcode.org/" prepend ;
-
-: latest-binary-link ( builder -- xml )
- [ binaries-url ] [ last-release>> ] bi [ "/" glue ] keep link ;
-
-: binaries-link ( builder -- link )
- binaries-url dup link ;
-
-: clean-image-url ( builder -- url )
- [ os>> ] [ cpu>> ] bi (platform) "http://factorcode.org/images/clean/" prepend ;
-
-: clean-image-link ( builder -- link )
- clean-image-url dup link ;
-
-: report-link ( builder -- xml )
- [ URL" report" ] dip
- [ os>> "os" set-query-param ]
- [ cpu>> "cpu" set-query-param ] bi
- [XML <a href=<->>Latest build report</a> XML] ;
-
-: requirements ( builder -- xml )
- [
- os>> {
- { "winnt" "Windows XP, Windows Vista or Windows 7" }
- { "macosx" "Mac OS X 10.5 Leopard" }
- { "linux" "Ubuntu Linux 9.04 (other distributions may also work)" }
- { "freebsd" "FreeBSD 7.1" }
- { "netbsd" "NetBSD 5.0" }
- { "openbsd" "OpenBSD 4.4" }
- } at
- ] [
- dup cpu>> "x86.32" = [
- os>> {
- { [ dup { "winnt" "linux" "freebsd" "netbsd" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] }
- { [ dup { "openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] }
- { [ t ] [ drop f ] }
- } cond
- ] [ drop f ] if
- ] bi
- 2array sift [ [XML <li><-></li> XML] ] map [XML <ul><-></ul> XML] ;
-
-: last-build-status ( builder -- xml )
- [ last-git-id>> ] [ last-timestamp>> ] bi build-status ;
-
-: clean-build-status ( builder -- xml )
- [ clean-git-id>> ] [ clean-timestamp>> ] bi build-status ;
-
-: <download-binary-action> ( -- action )
- <page-action>
- [
- validate-os/cpu
- "os" value "cpu" value (platform) "platform" set-value
- current-builder {
- [ latest-binary-link "package" set-value ]
- [ release-git-id>> git-link "git-id" set-value ]
- [ requirements "requirements" set-value ]
- [ host-name>> "host-name" set-value ]
- [ current-status "status" set-value ]
- [ last-build-status "last-build" set-value ]
- [ clean-build-status "last-clean-build" set-value ]
- [ binaries-link "binaries" set-value ]
- [ clean-image-link "clean-images" set-value ]
- [ report-link "last-report" set-value ]
- } cleave
- ] >>init
- { mason-app "download" } >>template ;
-
: <mason-app> ( -- dispatcher )
mason-app new-dispatcher
<build-report-action> "report" add-responder
- <download-binary-action> "download" add-responder
- <download-grid-action> "grid" add-responder
+ <download-package-action>
+ { mason-app "download-package" } >>template
+ "package" add-responder
+
+ <package-grid-action> "packages" add-responder
+
+ <download-release-action>
+ { mason-app "download-release" } >>template
+ "release" add-responder
+
+ <release-grid-action> "releases" add-responder
mason-db <db-persistence> ;
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays combinators furnace.actions html.forms
+kernel mason.platform mason.report mason.server present
+sequences webapps.mason webapps.mason.report
+webapps.mason.utils xml.syntax ;
+IN: webapps.mason.package
+
+: building ( builder string -- xml )
+ swap current-git-id>> git-link
+ [XML <-> for <-> XML] ;
+
+: status-string ( builder -- string )
+ dup status>> {
+ { +dirty+ [ drop "Dirty" ] }
+ { +clean+ [ drop "Clean" ] }
+ { +error+ [ drop "Error" ] }
+ { +starting+ [ "Starting build" building ] }
+ { +make-vm+ [ "Compiling VM" building ] }
+ { +boot+ [ "Bootstrapping" building ] }
+ { +test+ [ "Testing" building ] }
+ [ 2drop "Unknown" ]
+ } case ;
+
+: current-status ( builder -- xml )
+ [ status-string ]
+ [ current-timestamp>> present " (as of " ")" surround ] bi
+ 2array ;
+
+: build-status ( git-id timestamp -- xml )
+ over [ [ git-link ] [ present ] bi* " (built on " ")" surround 2array ] [ 2drop f ] if ;
+
+: packages-url ( builder -- url )
+ [ os>> ] [ cpu>> ] bi (platform) "http://downloads.factorcode.org/" prepend ;
+
+: package-link ( builder -- xml )
+ [ packages-url ] [ last-release>> ] bi [ "/" glue ] keep link ;
+
+: packages-link ( builder -- link )
+ packages-url dup link ;
+
+: clean-image-url ( builder -- url )
+ [ os>> ] [ cpu>> ] bi (platform) "http://factorcode.org/images/clean/" prepend ;
+
+: clean-image-link ( builder -- link )
+ clean-image-url dup link ;
+
+: last-build-status ( builder -- xml )
+ [ last-git-id>> ] [ last-timestamp>> ] bi build-status ;
+
+: clean-build-status ( builder -- xml )
+ [ clean-git-id>> ] [ clean-timestamp>> ] bi build-status ;
+
+: <download-package-action> ( -- action )
+ <page-action>
+ [
+ validate-os/cpu
+ "os" value "cpu" value (platform) "platform" set-value
+ current-builder {
+ [ package-link "package" set-value ]
+ [ release-git-id>> git-link "git-id" set-value ]
+ [ requirements "requirements" set-value ]
+ [ host-name>> "host-name" set-value ]
+ [ current-status "status" set-value ]
+ [ last-build-status "last-build" set-value ]
+ [ clean-build-status "last-clean-build" set-value ]
+ [ packages-link "binaries" set-value ]
+ [ clean-image-link "clean-images" set-value ]
+ [ report-link "last-report" set-value ]
+ } cleave
+ ] >>init ;
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors furnace.actions html.forms kernel
+mason.platform mason.report sequences webapps.mason
+webapps.mason.utils ;
+IN: webapps.mason.release
+
+: releases-url ( builder -- url )
+ [ os>> ] [ cpu>> ] bi (platform)
+ "http://downloads.factorcode.org/releases/" prepend ;
+
+: release-link ( builder -- xml )
+ [ releases-url ] [ last-release>> ] bi [ "/" glue ] keep link ;
+
+: <download-release-action> ( -- action )
+ <page-action>
+ [
+ validate-os/cpu
+ "os" value "cpu" value (platform) "platform" set-value
+ current-release
+ [ release-link "release" set-value ]
+ [ release-git-id>> git-link "git-id" set-value ]
+ [ requirements "requirements" set-value ]
+ tri
+ ] >>init ;
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors furnace.actions http.server.responses kernel
+urls webapps.mason.utils xml.syntax ;
+IN: webapps.mason.report
+
+: <build-report-action> ( -- action )
+ <action>
+ [ validate-os/cpu ] >>init
+ [ current-builder last-report>> "text/html" <content> ] >>display ;
+
+: report-link ( builder -- xml )
+ [ URL" report" ] dip
+ [ os>> "os" set-query-param ]
+ [ cpu>> "cpu" set-query-param ] bi
+ [XML <a href=<->>Latest build report</a> XML] ;
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs db.tuples furnace.actions
+html.forms kernel mason.server mason.server.release sequences
+validators xml.syntax ;
+IN: webapps.mason.utils
+
+: link ( url label -- xml )
+ [XML <a href=<->><-></a> XML] ;
+
+: validate-os/cpu ( -- )
+ {
+ { "os" [ v-one-line ] }
+ { "cpu" [ v-one-line ] }
+ } validate-params ;
+
+: current-builder ( -- builder )
+ builder new "os" value >>os "cpu" value >>cpu select-tuple ;
+
+: current-release ( -- builder )
+ release new "os" value >>os "cpu" value >>cpu select-tuple ;
+
+: requirements ( builder -- xml )
+ [
+ os>> {
+ { "winnt" "Windows XP, Windows Vista or Windows 7" }
+ { "macosx" "Mac OS X 10.5 Leopard" }
+ { "linux" "Ubuntu Linux 9.04 (other distributions may also work)" }
+ { "freebsd" "FreeBSD 7.1" }
+ { "netbsd" "NetBSD 5.0" }
+ { "openbsd" "OpenBSD 4.5" }
+ } at
+ ] [
+ dup cpu>> "x86.32" = [
+ os>> "macosx" =
+ f "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2."
+ ?
+ ] [ drop f ] if
+ ] bi
+ 2array sift [ [XML <li><-></li> XML] ] map [XML <ul><-></ul> XML] ;
projects / factor.git / commitdiff