extra/webapps/mason/version/version.factor

   1 ! Copyright (C) 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors bitly combinators db.tuples debugger fry
   4 grouping io io.streams.string kernel locals make sequences
   5 threads mason.email mason.twitter webapps.mason.backend
   6 webapps.mason.version.common webapps.mason.version.data
   7 webapps.mason.version.files webapps.mason.version.source
   8 webapps.mason.version.binary ;
   9 IN: webapps.mason.version
  10
  11 : check-releases ( builders -- )
  12     [ release-git-id>> ] map all-equal?
  13     [ "Some builders are out of date" throw ] unless ;
  14
  15 : make-release-directory ( version -- )
  16     "Creating release directory..." print flush
  17     [ "mkdir -p " % "" release-directory remote-directory % "\n" % ] "" make
  18     execute-on-server ;
  19
  20 : tweet-release ( version announcement-url -- )
  21     [
  22         "Factor " %
  23         [ % " released -- " % ] [ shorten-url % ] bi*
  24     ] "" make mason-tweet ;
  25
  26 :: (do-release) ( version announcement-url -- )
  27     [
  28         builder new select-tuples :> builders
  29         builders first release-git-id>> :> git-id
  30
  31         builders check-releases
  32         version make-release-directory
  33         version builders do-binary-release
  34         version builders update-binary-releases
  35         version git-id do-source-release
  36         version git-id announcement-url update-version
  37         version announcement-url tweet-release
  38
  39         "Done." print flush
  40     ] with-mason-db ;
  41
  42 : send-release-email ( string version -- )
  43     [ "text/plain" ] dip "Release output: " prepend mason-email ;
  44
  45 :: do-release ( version announcement-url -- )
  46     [
  47         [
  48             [
  49                 version announcement-url (do-release)
  50             ] try
  51         ] with-string-writer
  52         version send-release-email
  53     ] "Mason release" spawn drop ;