extra/webapps/mason/version/source/source.factor

   1 ! Copyright (C) 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: bootstrap.image bootstrap.image.download io
   4 io.directories io.directories.hierarchy io.files.unique
   5 io.launcher io.pathnames kernel namespaces sequences
   6 mason.common mason.config webapps.mason.version.files ;
   7 IN: webapps.mason.version.source
   8
   9 : clone-factor ( -- )
  10     { "git" "clone" "git://factorcode.org/git/factor.git" } try-process ;
  11
  12 : git-reset ( git-id -- )
  13     { "git" "reset" "--hard" } swap suffix try-process ;
  14
  15 : save-git-id ( git-id -- )
  16     "git-id" to-file ;
  17
  18 : delete-git-tree ( -- )
  19     ".git" delete-tree
  20     ".gitignore" delete-file ;
  21
  22 : download-images ( -- )
  23     image-names [ boot-image-name download-image ] each ;
  24
  25 : prepare-source ( git-id -- )
  26     "factor" [
  27         [ git-reset ] [ save-git-id ] bi
  28         delete-git-tree
  29         download-images
  30     ] with-directory ;
  31
  32 : (make-source-release) ( version -- path )
  33     [ { "zip" "-qr9" } ] dip source-release-name file-name
  34     [ suffix "factor" suffix try-process ] keep ;
  35
  36 : make-source-release ( version git-id -- path )
  37     "Creating source release..." print flush
  38     [
  39         current-temporary-directory get [
  40             clone-factor prepare-source (make-source-release)
  41             "Package created: " write absolute-path dup print
  42         ] with-directory
  43     ] with-unique-directory drop ;
  44
  45 : upload-source-release ( package version -- )
  46     "Uploading source release..." print flush
  47     [ package-username get package-host get ] dip
  48     remote-source-release-name
  49     upload-safely ;
  50
  51 : do-source-release ( version git-id -- )
  52     [ make-source-release ] [ drop upload-source-release ] 2bi ;