steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

io.launcher: add versions of with-process that preserve process and status.

db4
John Benediktsson 2014-12-30 14:51:23 -08:00
parent cd003fbef9
commit 9fd568267d
2 changed files with 26 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
basis/io/launcher/launcher.factor
View File

@ -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>
: <process-reader> ( 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
<PRIVATE
@ -234,10 +239,12 @@ PRIVATE>
: <process-writer> ( 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
<PRIVATE
@ -263,10 +270,12 @@ PRIVATE>
: <process-stream> ( 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 } ;

12
extra/mason/git/git.factor
View File

@ -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 ;