Nsryjdtyk

I'm having trouble getting data every newline from standard ouput. Data is produced by C program. This is the C code:

// gcc counter.c -o counter



#include <stdio.h>

#include <unistd.h>



int main(int argc, char *argv) {

  unsigned int i = 0;

  while(1) {

    printf("%dn", i);

    sleep(1);

    i++;

  }

}

My goal is to get the same behaviour as this haskell function below:

timeSource :: MonadIO m => Source m TL.Text

timeSource = forever $ do

    now <- liftIO getCurrentTime

    yield $ TL.pack $ show now

    liftIO $ threadDelay 1000000

I tried using readProcess and readCreateProcess from System.Process module. This is one of my tries:

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

This is how I use counter function within webSockets:

    webSockets $ race_

        (sourceWS $$ Data.Conduit.List.map TL.toUpper =$ sinkWSText)

        -- (timeSource $$ sinkWSText)

        (counter $$ sinkWSText)

When I open http://localhost:3000/, it doesn't work. Here's the complete code.

{-# 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

So my question is how to access data every printf in infinite loop and use it in Haskell?

EDIT 1:

Based on MathematicalOrchid's suggestion, here's what I did so far.

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

I suppose it's still blocking until the process terminates.

EDIT 2:

For testing if createProcess works I tried this.

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

Apparently It's still blocking.

Quoting the documentation for 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.

(Note emphasis.) It appears that readCreateProcess works similarly.

So basically when you call this function, it will sit there forever waiting for your external process to quit.

I suggest you use proc to create a CreateProcess structure as before, change std_in to be CreatePipe, and then call createProcess which should return you a handle that you can hGetLine from as required.

From this answer I must add fflush(stdout); to my C file.

Here's my solution:

// gcc counter.c -o counter



#include <stdio.h>

#include <unistd.h>



int main(int argc, char *argv) {

  unsigned int i = 0;

  while(1) {

    printf("%dn", i);

    sleep(1);

    i++;

    fflush(stdout);

  }

}

And here's how I read a process in 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