mason: more useful logging to console, with timestamps

db4
Slava Pestov 2011-09-09 19:33:13 -07:00
parent f1c2707b5f
commit 396ef06355
5 changed files with 17 additions and 11 deletions

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov. ! Copyright (C) 2008, 2011 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel calendar io.directories io.encodings.utf8 USING: arrays kernel calendar io.directories io.encodings.utf8
io.files io.launcher io.pathnames namespaces prettyprint io.files io.launcher io.pathnames namespaces prettyprint
combinators mason.child mason.cleanup mason.common mason.config combinators sequences mason.child mason.cleanup mason.common mason.config
mason.docs mason.release mason.report mason.email mason.git mason.docs mason.release mason.report mason.email mason.git
mason.notify mason.platform mason.updates ; mason.notify mason.platform mason.updates ;
QUALIFIED: continuations QUALIFIED: continuations
@ -13,9 +13,11 @@ IN: mason.build
build-dir make-directory ; build-dir make-directory ;
: enter-build-dir ( -- ) : enter-build-dir ( -- )
"Building in directory " build-dir append print-timestamp
build-dir set-current-directory ; build-dir set-current-directory ;
: clone-source ( -- ) : clone-source ( -- )
"Cloning GIT repository" print-timestamp
"git" "clone" builds-dir get "factor" append-path 3array "git" "clone" builds-dir get "factor" append-path 3array
short-running-process ; short-running-process ;

View File

@ -1,4 +1,4 @@
! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov. ! Copyright (C) 2008, 2011 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces sequences splitting system accessors USING: kernel namespaces sequences splitting system accessors
math.functions make io io.files io.pathnames io.directories math.functions make io io.files io.pathnames io.directories
@ -8,6 +8,9 @@ calendar.format arrays mason.config locals debugger fry
continuations strings io.sockets ; continuations strings io.sockets ;
IN: mason.common IN: mason.common
: print-timestamp ( string -- )
now timestamp>string write bl print flush ;
ERROR: no-host-name ; ERROR: no-host-name ;
: short-host-name ( -- string ) : short-host-name ( -- string )

View File

@ -16,7 +16,7 @@ IN: mason.email
_ >>subject _ >>subject
send-email send-email
] [ ] [
"E-MAILING FAILED:" print "E-MAILING FAILED:" print-timestamp
error. flush error. flush
] recover ; ] recover ;

View File

@ -21,6 +21,7 @@ IN: mason.git
: git-clone ( -- ) : git-clone ( -- )
#! Must be run from builds-dir #! Must be run from builds-dir
"Cloning initial repository" print-timestamp
git-clone-cmd try-output-process ; git-clone-cmd try-output-process ;
: git-pull-cmd ( -- cmd ) : git-pull-cmd ( -- cmd )

View File

@ -28,7 +28,7 @@ IN: mason.notify
http-post 2drop http-post 2drop
] retry ] retry
] [ ] [
"STATUS NOTIFY FAILED:" print "STATUS NOTIFY FAILED:" print-timestamp
error. flush error. flush
] recover ] recover
] [ 3drop ] if ; ] [ 3drop ] if ;
@ -40,24 +40,24 @@ IN: mason.notify
f f "idle" status-notify ; f f "idle" status-notify ;
: notify-begin-build ( git-id -- ) : notify-begin-build ( git-id -- )
[ "Starting build of GIT ID " write print flush ] [ "Starting build of GIT ID " prepend print-timestamp ]
[ f swap "git-id" status-notify ] [ f swap "git-id" status-notify ]
bi ; bi ;
: notify-make-vm ( -- ) : notify-make-vm ( -- )
"Compiling VM" print flush "Compiling VM" print-timestamp
f f "make-vm" status-notify ; f f "make-vm" status-notify ;
: notify-boot ( -- ) : notify-boot ( -- )
"Bootstrapping" print flush "Bootstrapping" print-timestamp
f f "boot" status-notify ; f f "boot" status-notify ;
: notify-test ( -- ) : notify-test ( -- )
"Running tests" print flush "Running tests" print-timestamp
f f "test" status-notify ; f f "test" status-notify ;
: notify-report ( status -- ) : notify-report ( status -- )
[ "Build finished with status: " write . flush ] [ name>> "Build finished with status: " prepend print-timestamp ]
[ [
[ "report" utf8 file-contents ] dip [ "report" utf8 file-contents ] dip
[ name>> "report" status-notify ] [ email-report ] 2bi [ name>> "report" status-notify ] [ email-report ] 2bi
@ -70,6 +70,6 @@ IN: mason.notify
f f "finish" status-notify ; f f "finish" status-notify ;
: notify-release ( archive-name -- ) : notify-release ( archive-name -- )
[ "Uploaded " prepend [ print flush ] [ mason-tweet ] bi ] [ "Uploaded " prepend [ print-timestamp ] [ mason-tweet ] bi ]
[ f swap "release" status-notify ] [ f swap "release" status-notify ]
bi ; bi ;