[Haskell-beginners] How to wait till a process is finished before invoking the next one?

Thomas Friedrich info at suud.de
Thu May 7 14:53:11 EDT 2009


Hi Daniel and everyone,

Thanks for the reply!

I thought of using waitForProcess, and in fact an earlier version of the 
program did. However, as the program got more complex, I don't really 
see how this is still possible.

For example the runProgram function looks like this:

runProgram :: [String] -> IO ()
runProgram [] = return ()
runProgram (c:cs) = do
  runCommand ("lalala " ++ c)
  runProgram cs

It might be possible to write the function runProgram in a way, so that 
it returns an expression of type [IO ProcessHandle] and then try to work 
from there.  But I have the feeling, that this will become messy very 
quickly, and there must be some more elegant way of doing this.  The 
other thing is that actually not all functions are able to return 
ProcessHandles, e.g.

writeFeatures :: [String] -> IO ()
writeFeatures cs = Exc.bracket (openFile training AppendMode) hClose (\h 
-> goo h)
  where
    goo h = go 1 cs
      where
        go :: Int -> [String] -> IO ()
        go n [] = putStrLn "Features written."
        go n (c:cs) = do
          features <- makeFeatures n c    -- makeFeatures :: Int -> 
String -> IO String
          hPutStr h features
          go (n+1) cs

And the file that is produced here is needed in the next function.

I hoped to do something with forkIO, as I would like to parallelize the 
whole program at the end.  Especially the function runProgram would 
benefit hugely from this (I so don't have a clue how to do this yet;). I 
tried for example the following:

main :: IO ()
main = do
 cs <- getArgs
 p1 <- forkIO $ writeData cs
 p2 <- forkIO $ runProgram cs
 p3 <- forkIO $ writeFeatures cs
 p4 <- forkIO $ runTestOnFeatures
 seq p1 (seq p2 (seq p3 (seq p4 (putStrLn "Done"))))

But that of course doesn't work, because now I am not actually 
requesting anything.  The program does in fact nothing, apart from 
printing out "Done".

Any ideas?

Cheers,
Thomas


Daniel Fischer wrote:
> Am Donnerstag 07 Mai 2009 18:36:08 schrieb Thomas Friedrich:
>   
>> Hi everyone,
>>
>> Each of the above function take a list of filenames, run certain
>> command-line programs on them, which I invoke by runCommand, and each of
>> them produce multiple output-files.  Each function in main needs a
>> couple of those output-files that are produced by the function directly
>> above it.  How do I get Haskell to wait, till all the data is written to
>> the disk, before invoking the next command.
>>     
>
> System.Process.waitForProcess
>
> should do it, conveniently runCommand returns a ProcessHandle.
>
>   
>> The way the program is
>> currently written, Haskell doesn't see that the input of one function
>> depends on the output of another, and tries to run them all at the same
>> time.
>>
>> Any ideas?
>>
>> Thanks everyone for your help.
>>
>> Cheers,
>> Thomas
>>     
>
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>   



More information about the Beginners mailing list