extra/mason/common/common.factor

   1 ! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel namespaces sequences splitting system accessors
   4 math.functions make io io.files io.pathnames io.directories
   5 io.launcher io.encodings.utf8 prettyprint
   6 combinators.short-circuit parser combinators calendar
   7 calendar.format arrays mason.config locals ;
   8 IN: mason.common
   9
  10 : short-running-process ( command -- )
  11     #! Give network operations at most 15 minutes to complete.
  12     <process>
  13         swap >>command
  14         15 minutes >>timeout
  15     try-process ;
  16
  17 :: upload-safely ( local username host remote -- )
  18     [let* | temp [ remote ".incomplete" append ]
  19             scp-remote [ { username "@" host ":" temp } concat ]
  20             scp [ scp-command get ]
  21             ssh [ ssh-command get ] |
  22         { scp local scp-remote } short-running-process
  23         { ssh host "-l" username "mv" temp remote } short-running-process
  24     ] ;
  25
  26 : eval-file ( file -- obj )
  27     dup utf8 file-lines parse-fresh
  28     [ "Empty file: " swap append throw ] [ nip first ] if-empty ;
  29
  30 : cat ( file -- ) utf8 file-contents print ;
  31
  32 : cat-n ( file n -- ) [ utf8 file-lines ] dip short tail* [ print ] each ;
  33
  34 : to-file ( object file -- ) utf8 [ . ] with-file-writer ;
  35
  36 : datestamp ( timestamp -- string )
  37     [
  38         {
  39             [ year>> , ]
  40             [ month>> , ]
  41             [ day>> , ]
  42             [ hour>> , ]
  43             [ minute>> , ]
  44         } cleave
  45     ] { } make [ pad-00 ] map "-" join ;
  46
  47 : milli-seconds>time ( n -- string )
  48     millis>timestamp
  49     [ hour>> ] [ minute>> ] [ second>> floor ] tri 3array
  50     [ pad-00 ] map ":" join ;
  51
  52 SYMBOL: stamp
  53
  54 : builds/factor ( -- path ) builds-dir get "factor" append-path ;
  55 : build-dir ( -- path ) builds-dir get stamp get append-path ;
  56
  57 : prepare-build-machine ( -- )
  58     builds-dir get make-directories
  59     builds-dir get
  60     [ { "git" "clone" "git://factorcode.org/git/factor.git" } try-process ]
  61     with-directory ;
  62
  63 : git-id ( -- id )
  64     { "git" "show" } utf8 [ readln ] with-process-reader
  65     " " split second ;
  66
  67 : ?prepare-build-machine ( -- )
  68     builds/factor exists? [ prepare-build-machine ] unless ;
  69
  70 : load-everything-vocabs-file "load-everything-vocabs" ;
  71 : load-everything-errors-file "load-everything-errors" ;
  72
  73 : test-all-vocabs-file "test-all-vocabs" ;
  74 : test-all-errors-file "test-all-errors" ;
  75
  76 : help-lint-vocabs-file "help-lint-vocabs" ;
  77 : help-lint-errors-file "help-lint-errors" ;
  78
  79 : boot-time-file "boot-time" ;
  80 : load-time-file "load-time" ;
  81 : compiler-errors-file "compiler-errors" ;
  82 : test-time-file "test-time" ;
  83 : help-lint-time-file "help-lint-time" ;
  84 : benchmark-time-file "benchmark-time" ;
  85 : html-help-time-file "html-help-time" ;
  86
  87 : benchmarks-file "benchmarks" ;
  88
  89 SYMBOL: status
  90
  91 SYMBOL: status-error ! didn't bootstrap, or crashed
  92 SYMBOL: status-dirty ! bootstrapped but not all tests passed
  93 SYMBOL: status-clean ! everything good