extra/mason/notify/notify.factor

   1 ! Copyright (C) 2009, 2011 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors continuations debugger http.client io
   4 io.encodings.utf8 io.files kernel make mason.common mason.config
   5 mason.email mason.twitter namespaces sequences ;
   6 IN: mason.notify
   7
   8 : status-notify? ( -- ? )
   9     status-url get
  10     target-variant get not and ;
  11
  12 : status-params ( report arg message -- assoc )
  13     [
  14         short-host-name "host-name" ,,
  15         target-cpu get "target-cpu" ,,
  16         target-os get "target-os" ,,
  17         status-secret get "secret" ,,
  18         [ "report" ,, ]
  19         [ "arg" ,, ]
  20         [ "message" ,, ] tri*
  21     ] H{ } make ;
  22
  23 : status-notify ( report arg message -- )
  24     status-notify? [
  25         '[
  26             5 [
  27                 _ _ _ status-params status-url get
  28                 http-post 2drop
  29             ] retry
  30         ] [
  31             "STATUS NOTIFY FAILED:" print-timestamp
  32             error. flush
  33         ] recover
  34     ] [ 3drop ] if ;
  35
  36 : notify-heartbeat ( -- )
  37     f f "heartbeat" status-notify ;
  38
  39 : notify-idle ( -- )
  40     f f "idle" status-notify ;
  41
  42 : notify-begin-build ( git-id -- )
  43     [ "Starting build of GIT ID " prepend print-timestamp ]
  44     [ f swap "git-id" status-notify ]
  45     bi ;
  46
  47 : notify-make-vm ( -- )
  48     "Compiling VM" print-timestamp
  49     f f "make-vm" status-notify ;
  50
  51 : notify-boot ( -- )
  52     "Bootstrapping" print-timestamp
  53     f f "boot" status-notify ;
  54
  55 : notify-test ( -- )
  56     "Running tests" print-timestamp
  57     f f "test" status-notify ;
  58
  59 : notify-report ( status -- )
  60     [ name>> "Build finished with status: " prepend print-timestamp ]
  61     [
  62         [ "report" utf8 file-contents ] dip
  63         [ name>> "report" status-notify ] [ email-report ] 2bi
  64     ] bi ;
  65
  66 : notify-upload ( -- )
  67     f f "upload" status-notify ;
  68
  69 : notify-finish ( -- )
  70     f f "finish" status-notify ;
  71
  72 : notify-release ( archive-name -- )
  73     [ "Uploaded " prepend [ print-timestamp ] [ mason-tweet ] bi ]
  74     [ f swap "release" status-notify ]
  75     bi ;