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

Question

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("%d\n", 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.

A blocking createProcess would not make any sense, so I strongly suspect this is not the case. — n. m. could be an AI, Nov 26 '18 at 13:45

score 2 · Answer 1 · answered Nov 26 '18 at 11:42

2

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.

answered Nov 26 '18 at 11:42

MathematicalOrchid

61,854
19
123
220

thanks for your suggestion. It's still blocking, see my edit. – Ηλεκτρολόγος Μηχανικός Nov 26 '18 at 12:17
Hmm. Not sure what the problem is now... I've tried all the things I would have tried. Unless the problem is at the web end somehow... – MathematicalOrchid Nov 26 '18 at 12:57
I tried using `createProcess` in `IO ()` . Still blocking, see my edit. So I don't think the problem is at the web side. – Ηλεκτρολόγος Μηχανικός Nov 26 '18 at 13:17

Ηλεκτρολόγος Μηχανικός · Accepted Answer · 2018-11-27T16:57:22.460

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("%d\n", 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

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

2 Answers2