haskell - 在 Haskell 中从无限循环(C 程序)中获取每个换行符的数据

Question

我无法从标准输出中获取每个换行符的数据。数据由C程序产生。这是 C 代码:

// gcc counter.c -o counter

#include <stdio.h>
#include <unistd.h>

int main(int argc, char *argv[]) {
  unsigned int i = 0;
  while(1) {
    printf("%d\n", i);
    sleep(1);
    i++;
  }
}

我的目标是获得与下面这个 haskell 函数相同的行为:

timeSource :: MonadIO m => Source m TL.Text
timeSource = forever $ do
    now <- liftIO getCurrentTime
    yield $ TL.pack $ show now
    liftIO $ threadDelay 1000000

我尝试使用 System.Process 模块中的 readProcess 和 readCreateProcess 。这是我的尝试之一:

counter :: MonadIO m => Source m TL.Text
counter = do
    r <- liftIO $ readCreateProcess (proc "./counter" []) ""
    -- r <- liftIO $ readProcess "./counter" [] [] 
    yield $ TL.pack $ show r
    liftIO $ threadDelay 1000000

这就是我在 webSockets 中使用 counter 函数的方式:

    webSockets $ race_
        (sourceWS $$ Data.Conduit.List.map TL.toUpper =$ sinkWSText)
        -- (timeSource $$ sinkWSText)
        (counter $$ sinkWSText)

当我打开http://localhost:3000/时，它不起作用。这是完整的代码。

{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings #-}

module Main where

import Yesod.Core
import Yesod.WebSockets
import qualified Data.Text.Lazy as TL
import Control.Monad (forever)
import Control.Concurrent (threadDelay)
import Data.Time
import Data.Conduit
import System.Process 
import qualified Data.Conduit.List

data App = App

instance Yesod App

mkYesod "App" [parseRoutes|
/ HomeR GET
|]

timeSource :: MonadIO m => Source m TL.Text
timeSource = forever $ do
    now <- liftIO getCurrentTime
    yield $ TL.pack $ show now
    liftIO $ threadDelay 1000000

counter :: MonadIO m => Source m TL.Text
counter = do
  r <- liftIO $ readCreateProcess (proc "./counter" []) ""
  -- r <- liftIO $ readProcess "./counter" [] [] 
  yield $ TL.pack $ show r
  liftIO $ threadDelay 1000000

getHomeR :: Handler Html
getHomeR = do
    webSockets $ race_
        (sourceWS $$ Data.Conduit.List.map TL.toUpper =$ sinkWSText)
        (timeSource $$ sinkWSText)
        -- (counter $$ sinkWSText)
    defaultLayout $
        toWidget
            [julius|
                var conn = new WebSocket("ws://localhost:3000/");
                conn.onopen = function() {
                    document.write("<p>open!</p>");
                    document.write("<button id=button>Send another message</button>")
                    document.getElementById("button").addEventListener("click", function(){
                        var msg = prompt("Enter a message for the server");
                        conn.send(msg);
                    });
                    conn.send("hello world");
                };
                conn.onmessage = function(e) {
                    document.write("<p>" + e.data + "</p>");
                };
                conn.onclose = function () {
                    document.write("<p>Connection Closed</p>");
                };
            |]

main :: IO ()
main = warp 3000 App

所以我的问题是如何在无限循环中访问每个 printf 数据并在 Haskell 中使用它？

编辑1:

根据 MathematicalOrchid 的建议，这就是我到目前为止所做的。

counter :: MonadIO m => Source m TL.Text
counter = do
  r <- liftIO $ createProcess (proc "./counter" []){ std_out = CreatePipe, std_in = CreatePipe}
  let (Just inp, Just outp, _, phandle) = r
  liftIO $ hSetBuffering outp LineBuffering
  contents <- liftIO $ hGetLine outp
  yield $ TL.pack $ show contents
  liftIO $ threadDelay 1000000

我想它仍然阻塞直到进程终止。

编辑2:

为了测试createProcess是否有效，我尝试了这个。

counterTest :: IO ()
counterTest = do
  r <- createProcess (proc "./counter" []){ std_out = CreatePipe, std_in = CreatePipe}
  let (Just inp, Just outp, _, phandle) = r
  hSetBuffering outp LineBuffering
  contents <- hGetLine outp
  print contents

显然它仍然阻塞。

Answer 1

引用readProcess的文档:

readProcess forks an external process, reads its standard output strictly, blocking until the process terminates, and returns the output string. The external process inherits the standard error.

(注意强调。)看起来 readCreateProcess 的工作原理类似。

所以基本上当你调用这个函数时，它会永远坐在那里等待你的外部进程退出。

我建议你像以前一样使用proc创建一个CreateProcess结构，将std_in更改为CreatePipe，然后调用createProcess，它应该返回一个句柄，您可以根据需要hGetLine从中获取句柄。