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

   1 ! Copyright (C) 2010 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: bootstrap.image bootstrap.image.download io
   4 io.directories io.files.temp io.files.unique io.launcher
   5 io.pathnames kernel namespaces sequences mason.common
   6 mason.config webapps.mason.version.files ;
   7 IN: webapps.mason.version.source
   8
   9 : clone-factor ( -- )
  10     { "git" "clone" "https://github.com/factor/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 : zip-source ( 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     clone-factor prepare-source zip-source
  39     "Package created: " write absolute-path dup print ;
  40
  41 : upload-source-release ( path version -- )
  42     "Uploading source release..." print flush
  43     [ package-username get package-host get ] dip
  44     remote-source-release-name
  45     upload-safely ;
  46
  47 : do-source-release ( version git-id -- )
  48     [
  49         [
  50             [ make-source-release ]
  51             [ drop upload-source-release ] 2bi
  52         ] cleanup-unique-directory
  53     ] with-temp-directory ;