GHC включает STDUT в присутствии потоков, но GHCi не - PullRequest
Новая
       48

GHC включает STDUT в присутствии потоков, но GHCi не

0 голосов
/ 01 ноября 2018

У меня есть следующая программа на Haskell 

module Main where

import           Control.Concurrent
import           Control.Monad
import           GHC.IO.Handle
import           System.Process

unlessM :: Monad m => m Bool -> m () -> m()
unlessM cond m = do
  c <- cond
  unless c m

main :: IO ()
main = do
  lock <- newMVar ()
  void $ withCreateProcess
    (proc exe args){ std_out = CreatePipe, std_err = CreatePipe }
    $ handleProcess lock
  where
    exe = "/bin/bash"
    args = ["-c", "echo 1; sleep 1; echo 2; sleep 1; echo 3 "]
    handleProcess lock _ (Just outh) (Just errh) hand = do
      _ <- forkIO $ showLines lock outh "STDOUT"
      _ <- forkIO $ showLines lock errh "STDERR"
      waitForProcess hand
    handleProcess _ _ _ _ _ = fail "No output or error handlers"
    showLines :: MVar () -> Handle -> String -> IO ()
    showLines v h str =
      unlessM (hIsClosed h) $
        unlessM (hIsEOF h) $ do
          l <- hGetLine h
          () <- takeMVar v
          putStrLn $ str ++ ": " ++ l
          putMVar v ()
          showLines v h str

Запуск его с ghci обеспечивает ожидаемый результат, но компиляция и запуск ничего не дает 

$ ghci
GHCi, version 8.0.2: http://www.haskell.org/ghc/  :? for help
Loaded GHCi configuration from /home/drninjabatman/.ghci
Prelude> :load Main.hs
[1 of 1] Compiling Main             ( Main.hs, interpreted )
Ok, modules loaded: Main.
*Main> main
STDOUT: 1
STDOUT: 2
STDOUT: 3
*Main> 
Leaving GHCi.
$ runhaskell ./Main.hs
STDOUT: 1
STDOUT: 2
STDOUT: 3
$ ghc Main.hs -o test
[1 of 1] Compiling Main             ( Main.hs, Main.o )
Linking test ...
$ ./test
$ # No output

1 Ответ

0 голосов
/ 01 ноября 2018

Программа на Haskell завершает работу сразу после остановки основного потока.

Вам необходимо изменить main так, чтобы он ожидал порожденных потоков перед выходом.

В GHCi это не проблема, поскольку основной поток запускает REPL, поэтому он не останавливается.

Непроверенная попытка: 

handleProcess lock _ (Just outh) (Just errh) hand = do
      lockOut <- newEmptyMVar
      _ <- forkIO (showLines lock outh "STDOUT" >> putMVar lockOut ())
      lockErr <- newEmptyMVar
      _ <- forkIO (showLines lock errh "STDERR" >> putMVar lockErr ())
      waitForProcess hand
      takeMVar lockOut
      takeMVar lockErr
...