首页 > 解决方案 > 从 Haskell 中的无限循环(C 程序)中获取每个换行符的数据

问题描述

我无法从标准输出中获取每个换行符的数据。数据由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

我尝试使用readProcessand readCreateProcessfromSystem.Process模块。这是我的尝试之一:

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

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

    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

显然它仍然处于阻塞状态。

标签: haskellwebsocketyesod

解决方案


引用文档readProcess

readProcessfork 一个外部进程,严格读取其标准输出,阻塞直到进程终止,并返回输出字符串。外部进程继承标准误差。

(注意强调。)看起来readCreateProcess类似。

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

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


推荐阅读