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

…tatus.
factor · Dec 30, 2014 · 9fd5682 · 9fd5682
1 parent cd003fb
commit 9fd5682
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 21 deletions.
diff --git 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>
 : <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 } ;
 

diff --git 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 ;