Add try-process word

extra/benchmark/bootstrap2/bootstrap2.factor

@@ -9,6 +9,6 @@ IN: benchmark.bootstrap2
         "-i=" my-boot-image-name append ,
         "-output-image=foo.image" ,
         "-no-user-init" ,
-    ] { } make run-process drop ;
+    ] { } make try-process ;
 
 MAIN: bootstrap-benchmark

extra/bootstrap/image/upload/upload.factor

@@ -16,8 +16,7 @@ bootstrap.image sequences io namespaces io.launcher math ;
 : upload-images ( -- )
     [
         "scp" , boot-image-names % "checksums.txt" , destination ,
-    ] { } make run-process
+    ] { } make try-process ;
-    wait-for-process zero? [ "Upload failed" throw ] unless ;
 
 : new-images ( -- )
     make-images compute-checksums upload-images ;

extra/editors/emacs/emacs.factor

@@ -8,7 +8,7 @@ IN: editors.emacs
         "--no-wait" ,
         "+" swap number>string append ,
         ,
-    ] { } make run-process drop ;
+    ] { } make try-process ;
 
 : emacs ( word -- )
     where first2 emacsclient ;

extra/editors/textmate/textmate.factor

@@ -5,6 +5,6 @@ IN: editors.textmate
 
 : textmate-location ( file line -- )
     [ "mate" , "-a" , "-l" , number>string , , ] { } make
-    run-process drop ;
+    try-process ;
 
 [ textmate-location ] edit-hook set-global

extra/io/launcher/launcher-docs.factor

@@ -116,6 +116,15 @@ HELP: run-detached
     "The output value can be passed to " { $link wait-for-process } " to get an exit code."
 } ;
 
+HELP: process-failed
+{ $values { "code" "an exit status" } }
+{ $description "Throws a " { $link process-failed } " error." }
+{ $error-description "Thrown by " { $link try-process } " if the process exited with a non-zero status code." } ;
+
+HELP: try-process
+{ $values { "desc" "a launch descriptor" } }
+{ $description "Launches a process and waits for it to complete. If it exits with a non-zero status code, throws a " { $link process-failed } " error." } ;
+
 HELP: kill-process
 { $values { "process" process } }
 { $description "Kills a running process. Does nothing if the process has already exited." } ;
@@ -175,6 +184,7 @@ $nl
 "The following words are used to launch processes:"
 { $subsection run-process }
 { $subsection run-detached }
+{ $subsection try-process }
 "Stopping processes:"
 { $subsection kill-process }
 "Redirecting standard input and output to a pipe:"

extra/io/launcher/launcher.factor

@@ -84,6 +84,15 @@ HOOK: run-process* io-backend ( desc -- handle )
 : run-detached ( desc -- process )
     >descriptor H{ { +detached+ t } } union run-process ;
 
+TUPLE: process-failed code ;
+
+: process-failed ( code -- * )
+    process-failed construct-boa throw ;
+
+: try-process ( desc -- )
+    run-process wait-for-process dup zero?
+    [ drop ] [ process-failed ] if ;
+
 HOOK: kill-process* io-backend ( handle -- )
 
 : kill-process ( process -- )

extra/logging/parser/parser.factor

@@ -2,13 +2,17 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: parser-combinators memoize kernel sequences
 logging arrays words strings vectors io io.files
-namespaces combinators combinators.lib logging.server ;
+namespaces combinators combinators.lib logging.server
+calendar ;
 IN: logging.parser
 
 : string-of satisfy <!*> [ >string ] <@ ;
 
+SYMBOL: multiline
+
 : 'date'
-    [ CHAR: ] eq? not ] string-of
+    multiline-header token [ drop multiline ] <@
+    [ CHAR: ] eq? not ] string-of [ rfc3339>timestamp ] <@ <|>
     "[" "]" surrounded-by ;
 
 : 'log-level'
@@ -41,7 +45,7 @@ MEMO: 'log-line' ( -- parser )
     first malformed eq? ;
 
 : multiline? ( line -- ? )
-    first first CHAR: - = ;
+    first multiline eq? ;
 
 : malformed-line
     "Warning: malformed log line:" print

extra/tools/deploy/backend/backend.factor

@@ -22,7 +22,10 @@ IN: tools.deploy.backend
         +stdout+ +stderr+ set
     ] H{ } make-assoc <process-stream>
     dup duplex-stream-out dispose
-    copy-lines ;
+    dup copy-lines
+    process-stream-process wait-for-process zero? [
+        "Deployment failed" throw
+    ] unless ;
 
 : make-boot-image ( -- )
     #! If stage1 image doesn't exist, create one.

extra/tools/deploy/macosx/macosx.factor

@@ -8,10 +8,10 @@ QUALIFIED: unix
 IN: tools.deploy.macosx
 
 : touch ( path -- )
-    { "touch" } swap add run-process drop ;
+    { "touch" } swap add try-process ;
 
 : rm ( path -- )
-    { "rm" "-rf" } swap add run-process drop ;
+    { "rm" "-rf" } swap add try-process ;
 
 : bundle-dir ( -- dir )
     vm parent-directory parent-directory ;