Created
November 11, 2015 15:40
-
-
Save erantapaa/5511f817691e0860a032 to your computer and use it in GitHub Desktop.
Example of concurrently processing output form a process.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- from the School of Haskell article: https://www.fpcomplete.com/user/snoyberg/library-documentation/data-conduit-process | |
{-# LANGUAGE OverloadedStrings #-} | |
import Control.Applicative ((*>)) | |
import Control.Concurrent.Async (Concurrently (..)) | |
import Data.Conduit (await, yield, ($$), (=$)) | |
import qualified Data.Conduit.Binary as CB | |
import qualified Data.Conduit.List as CL | |
import Data.Conduit.Process (ClosedStream (..), streamingProcess, | |
proc, waitForStreamingProcess) | |
import System.IO (stdin) | |
main :: IO () | |
main = do | |
putStrLn "Enter lines of data. I'll run ./base64-perl on it." | |
putStrLn "Enter \"quit\" to exit." | |
((toProcess, close), fromProcess, fromStderr, cph) <- | |
streamingProcess (proc "./base64-perl" []) | |
let input = CB.sourceHandle stdin | |
$$ CB.lines | |
=$ inputLoop | |
=$ toProcess | |
inputLoop = do | |
mbs <- await | |
case mbs of | |
Nothing -> close | |
Just "quit" -> close | |
Just bs -> do | |
yield bs | |
inputLoop | |
output = fromProcess $$ CL.mapM_ | |
(\bs -> putStrLn $ "from process: " ++ show bs) | |
errout = fromStderr $$ CL.mapM_ | |
(\bs -> putStrLn $ "from stderr: " ++ show bs) | |
ec <- runConcurrently $ | |
Concurrently input *> | |
Concurrently output *> | |
Concurrently errout *> | |
Concurrently (waitForStreamingProcess cph) | |
putStrLn $ "Process exit code: " ++ show ec |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env perl | |
use strict; | |
use warnings; | |
use MIME::Base64; | |
$| = 1; | |
my $timeout = 3; | |
my $buf = ""; | |
while (1) { | |
my $rin = ''; | |
vec($rin, fileno(STDIN), 1) = 1; | |
my ($nfound) = select($rin, undef, undef, $timeout); | |
if ($nfound) { | |
my $nread = sysread(STDIN, $buf, 4096, length($buf)); | |
last if $nread <= 0; | |
print encode_base64($buf); | |
$buf = ""; | |
} else { | |
print STDERR "this is from stderr\n"; | |
} | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment