diff --git a/extra/mason/server/release/release.factor b/extra/mason/server/release/release.factor index 2683d642de..8aae749839 100644 --- a/extra/mason/server/release/release.factor +++ b/extra/mason/server/release/release.factor @@ -1,6 +1,6 @@ ! 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 @@ -39,6 +39,14 @@ TUPLE: 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 + :: ( version builder -- release ) release new builder host-name>> >>host-name diff --git a/extra/webapps/mason/download.xml b/extra/webapps/mason/download-package.xml similarity index 100% rename from extra/webapps/mason/download.xml rename to extra/webapps/mason/download-package.xml diff --git a/extra/webapps/mason/download-release.xml b/extra/webapps/mason/download-release.xml new file mode 100644 index 0000000000..751bb14c77 --- /dev/null +++ b/extra/webapps/mason/download-release.xml @@ -0,0 +1,29 @@ + + + + + + + + + + Factor binary package for <t:label t:name="platform" /> + + +
Logo
+ +

Factor binary package for

+ +

Requirements:

+ + +

Download

+ +

This release was built from GIT ID .

+ +

Once you download Factor, you can get started with the language.

+ + + + diff --git a/extra/webapps/mason/grids/authors.txt b/extra/webapps/mason/grids/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/webapps/mason/grids/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/webapps/mason/grids/grids.factor b/extra/webapps/mason/grids/grids.factor new file mode 100644 index 0000000000..57551b4aa5 --- /dev/null +++ b/extra/webapps/mason/grids/grids.factor @@ -0,0 +1,93 @@ +! 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
<->
XML] ] + [ 2drop [XML 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 <-> XML] ] map ; + +:: render-grid-row ( cpu quot -- xml ) + cpu second oses keys [| os | cpu os quot render-grid-cell ] map + [XML <-><-> XML] ; + +:: render-grid ( quot -- xml ) + render-grid-header + cpus [ quot render-grid-row ] map + [XML + + <-> + <-> +
OS/CPU
+ 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 ; + +: ( -- action ) + + [ package-grid xml>string "text/html" ] >>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 ; + +: ( -- action ) + + [ release-grid xml>string "text/html" ] >>display ; diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index 1c2d9e0d8c..00e1b200f6 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -1,183 +1,24 @@ ! 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 ><-> 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
<->
XML] - ] [ - [XML 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 <-> XML] ] map ] - [ - keys - cpus [ - [ nip second ] [ first ] 2bi [ - swap download-grid-cell - ] curry map - [XML <-><-> XML] - ] with map - ] bi - [XML - - <-> - <-> -
OS/CPU
- XML] ; - -: ( -- action ) - - [ download-grid xml>string "text/html" ] >>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 ; - -: ( -- action ) - - [ validate-os/cpu ] >>init - [ current-builder last-report>> "text/html" ] >>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 >Latest build report 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
  • <->
    • XML] ] map [XML
      <->
    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 ; - -: ( -- 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 ; - : ( -- dispatcher ) mason-app new-dispatcher "report" add-responder - "download" add-responder - "grid" add-responder + + { mason-app "download-package" } >>template + "package" add-responder + + "packages" add-responder + + + { mason-app "download-release" } >>template + "release" add-responder + + "releases" add-responder mason-db ; diff --git a/extra/webapps/mason/package/authors.txt b/extra/webapps/mason/package/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/webapps/mason/package/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/webapps/mason/package/package.factor b/extra/webapps/mason/package/package.factor new file mode 100644 index 0000000000..0917eaa33a --- /dev/null +++ b/extra/webapps/mason/package/package.factor @@ -0,0 +1,71 @@ +! 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 ; + +: ( -- 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 ; diff --git a/extra/webapps/mason/release/authors.txt b/extra/webapps/mason/release/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/webapps/mason/release/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/webapps/mason/release/release.factor b/extra/webapps/mason/release/release.factor new file mode 100644 index 0000000000..e87b53fdfe --- /dev/null +++ b/extra/webapps/mason/release/release.factor @@ -0,0 +1,25 @@ +! 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 ; + +: ( -- 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 ; diff --git a/extra/webapps/mason/report/authors.txt b/extra/webapps/mason/report/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/webapps/mason/report/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/webapps/mason/report/report.factor b/extra/webapps/mason/report/report.factor new file mode 100644 index 0000000000..f2d7542b9e --- /dev/null +++ b/extra/webapps/mason/report/report.factor @@ -0,0 +1,16 @@ +! 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 + +: ( -- action ) + + [ validate-os/cpu ] >>init + [ current-builder last-report>> "text/html" ] >>display ; + +: report-link ( builder -- xml ) + [ URL" report" ] dip + [ os>> "os" set-query-param ] + [ cpu>> "cpu" set-query-param ] bi + [XML >Latest build report XML] ; diff --git a/extra/webapps/mason/utils/authors.txt b/extra/webapps/mason/utils/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/webapps/mason/utils/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/webapps/mason/utils/utils.factor b/extra/webapps/mason/utils/utils.factor new file mode 100644 index 0000000000..8197cce820 --- /dev/null +++ b/extra/webapps/mason/utils/utils.factor @@ -0,0 +1,40 @@ +! 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 ><-> 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
  • <->
    • XML] ] map [XML
      <->
    XML] ;