Получайте данные каждую новую строку из бесконечного цикла (программа C) в Haskell - PullRequest
0 голосов

У меня проблемы с получением каждой новой строки со стандартного выхода.Данные производятся программой 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

Я пытался использовать readProcess и readCreateProcess из *Модуль 1009 *.Это одна из моих попыток:

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

Итак, мой вопрос: как получить доступ к данным каждые 1023 * в бесконечном цикле и использовать их в Haskell?

EDIT 1:

Основываясь на предложении MateticOrchid, вот что я сделал до сих пор.

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

Видимо, это все еще блокирует.

Ответы [ 2 ]

0 голосов

Из этого ответа Я должен добавить 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

enter image description here

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

Цитирование документации для readProcess:

readProcess разветвляет внешний процесс, строго читает его стандартный вывод, блокирует до тех пор, пока процесс не завершит , и возвращает выводстрока.Внешний процесс наследует стандартную ошибку.

(примечание выделено). Похоже, что readCreateProcess работает аналогично.

Таким образом, в основном, когда вы вызываете эту функцию, она будет существовать вечноожидание завершения вашего внешнего процесса.

Я предлагаю вам использовать proc, чтобы создать CreateProcess структуру, как и раньше, изменить std_in на CreatePipe, а затем вызвать createProcess, который должен вернутьвы ручка, с которой вы можете hGetLine по мере необходимости.

...