From 9fd568267d614b534e8b2dc88c5974111f0f1c39 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 30 Dec 2014 14:51:23 -0800 Subject: [PATCH] io.launcher: add versions of with-process that preserve process and status. --- basis/io/launcher/launcher.factor | 35 +++++++++++++++++++------------ extra/mason/git/git.factor | 12 ++++------- 2 files changed, 26 insertions(+), 21 deletions(-) diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index 19fed50307..b457a34013 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -157,8 +157,11 @@ M: process-failed error. "Launch descriptor:" print nl ] [ process>> . ] bi ; +: check-success ( process status -- ) + 0 = [ drop ] [ process-failed ] if ; + : wait-for-success ( process -- ) - dup wait-for-process 0 = [ drop ] [ process-failed ] if ; + dup wait-for-process check-success ; : try-process ( desc -- ) run-process wait-for-success ; @@ -210,10 +213,12 @@ PRIVATE> : ( desc encoding -- stream ) (process-reader) drop ; inline -: with-process-reader ( desc encoding quot -- ) - [ (process-reader) ] dip - '[ _ with-input-stream ] dip - wait-for-success ; inline +: with-process-reader* ( ... desc encoding quot: ( ... -- ... ) -- ... process status ) + [ (process-reader) ] dip '[ _ with-input-stream ] dip + dup wait-for-process ; inline + +: with-process-reader ( ... desc encoding quot: ( ... -- ... ) -- ... ) + with-process-reader* check-success ; inline : ( desc encoding -- stream ) (process-writer) drop ; inline -: with-process-writer ( desc encoding quot -- ) - [ (process-writer) ] dip - '[ _ with-output-stream ] dip - wait-for-success ; inline +: with-process-writer* ( ... desc encoding quot: ( ... -- ... ) -- ... process status ) + [ (process-writer) ] dip '[ _ with-output-stream ] dip + dup wait-for-process ; inline + +: with-process-writer ( ... desc encoding quot: ( ... -- ... ) -- ... ) + with-process-writer* check-success ; inline : ( desc encoding -- stream ) (process-stream) drop ; inline -: with-process-stream ( desc encoding quot -- ) - [ (process-stream) ] dip - '[ _ with-stream ] dip - wait-for-success ; inline +: with-process-stream* ( ... desc encoding quot: ( ... -- ... ) -- ... process status ) + [ (process-stream) ] dip '[ _ with-stream ] dip + dup wait-for-process ; inline + +: with-process-stream ( ... desc encoding quot: ( ... -- ... ) -- ... ) + with-process-stream* check-success ; inline ERROR: output-process-error { output string } { process process } ; diff --git a/extra/mason/git/git.factor b/extra/mason/git/git.factor index f78ceb850a..cd9ef01459 100644 --- a/extra/mason/git/git.factor +++ b/extra/mason/git/git.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators.short-circuit continuations debugger io io.directories io.directories.hierarchy -io.encodings.utf8 io.files io.launcher io.launcher.private -io.sockets io.streams.string kernel mason.common mason.email -sequences splitting ; +io.encodings.utf8 io.files io.launcher io.sockets +io.streams.string kernel mason.common mason.email sequences +splitting ; IN: mason.git : git-id ( -- id ) @@ -54,11 +54,6 @@ IN: mason.git if ] [ rethrow ] if ; -: with-process-reader* ( desc encoding quot -- ) - [ (process-reader) ] dip swap [ with-input-stream ] dip - dup wait-for-process dup { 0 1 } member? - [ 2drop ] [ process-failed ] if ; inline - : git-status-cmd ( -- cmd ) { "git" "status" } ; @@ -70,6 +65,7 @@ IN: mason.git : git-status ( -- seq ) [ git-status-cmd utf8 [ lines ] with-process-reader* + { 0 1 } member? [ 2drop ] [ process-failed ] if [ "#\t" head? ] filter ] [ git-status-failed { } ] recover ;