在 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应该return 您可以根据需要 hGetLine 从中获取句柄。

Answer 2

从这个 answer 我必须将 fflush(stdout); 添加到我的 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++;
    fflush(stdout);
  }
}

下面是我在 Haskell 中读取过程的方式：

 ...
 import System.IO
 ...

counter :: MonadIO m => Source m TL.Text
counter = do
  r <- liftIO $ createProcess (proc "./counter" []){ std_out = CreatePipe, std_in = CreatePipe}
  let (_, Just outp, _, _) = r
  liftIO $ hSetBuffering outp LineBuffering
  forever $ do 
    contents <- liftIO $ hGetLine outp
    yield $ TL.pack $ show ("Stdout: " ++ contents)
    liftIO $ threadDelay 1000000 -- already put 1s delay in C file, so it's optional
  liftIO $ hClose outp

在 Haskell 中从无限循环（C 程序）获取每个换行符的数据

Get data every newline from endless loop (C program) in Haskell

haskell

websocket

yesod