Search code examples
haskellio

How to get results forwarded in an IO function as early as possible?


I created a chain of process "steps" that are implemented in a way that makes it possible to output information as early as possible.

e.g.

mainFromSettings :: Settings -> IO ()
...
mainFromSettings ... =
    do
        Sys.setInputEcho False
        Sys.hSetBuffering Sys.stdout Sys.NoBuffering
        sContent <- getContents
        let
            records :: [[String]]
            records = Rcr.fromContent rcrConfig sContent
...
        print records

The code snippet above prints a record each time a record is build out of the lazy IO stream 'sContent'.

I suppose this works like that because 'print records' takes the head of the list which is ready to print, as soon as a line has been entered. I also assume that this will not work when the order of the list is reverse.

Unfortunately, in one of the process steps it doesn't work like this. For this process step, the list of records has to be complete before a single character will be displayed. The difference of this function is an extra IO function that contributes to extra information for each record.

In order to understand the problem, I created the following code that simulates this extra IO function. The code is also mimicking the records are already available (to avoid conflicts regarding open handles).

import qualified System.IO as Sys
import qualified System.IO.Echo as Sys

main :: IO ()

main =
    Sys.setInputEcho False >>
    Sys.hSetBuffering Sys.stdout Sys.NoBuffering >>
    Sys.hSetBuffering Sys.stdin Sys.NoBuffering >>
    checkAll ["12","34","56"] >>=
    print

checkAll :: [String] -> IO [String]
checkAll [] = return []
checkAll (s:lrs) =
    do
        l <- getLine
        let
            symbol = if l == s then "==" else "/="
            p1 = l ++ symbol ++ s
        p2 <- checkAll lrs
        return (p1 : p2)

The code above only completes when all three lines are completed.

I tried also an 'foldrM' alternative, but it didn't work and actually:

import qualified System.IO as Sys
import qualified System.IO.Echo as Sys
import qualified Data.Foldable as Fld

main :: IO ()
main =
    Sys.setInputEcho False >>
    Sys.hSetBuffering Sys.stdout Sys.NoBuffering >>
    Sys.hSetBuffering Sys.stdin Sys.NoBuffering >>
    checkAll [] ["12","34","56"] >>= 
    print

checkAll :: [String] -> [String] -> IO [String]
checkAll = Fld.foldrM f
    where
        f :: String -> [String] -> IO [String]
        f s ls =
            do
                l <- getLine
                if l == s
                    then return (ls ++ [l ++ "==" ++ s])
                    else return (ls ++ [l ++ "/=" ++ s])

Also this, it only completes when all three lines are completed.

As soon as I remove the IO function in between, like here:

import qualified System.IO as Sys
import qualified System.IO.Echo as Sys

main :: IO ()
main = 
    Sys.setInputEcho False >> 
    Sys.hSetBuffering Sys.stdout Sys.NoBuffering >>
    Sys.hSetBuffering Sys.stdin Sys.NoBuffering >> 
    getContents >>= 
    print . lines

...it works as expected, even thou the function lines is in between.

So what can I do to achieve this behaviour? Is that even possible with this lazy IO approach? Do I even need conduits to achieve that?

The following topic has already been considered:

Haskell - Read Lines from Handle without blocking


Solution

  • checkAll does literally say to do getLine and then recursively do checkAll before returning any data. "Lazy" IO is not a natural consequence of lazy evaluation (that normal code gets for free). It's a magic behavior introduced by unsafeInterleaveIO. Calls to this function are hidden inside library functions like getContents.

    You can make checkAll participate in lazy IO by calling unsafeInterleaveIO yourself.

    import qualified System.IO as Sys
    import qualified System.IO.Echo as Sys
    import qualified System.IO.Unsafe as Sys
    
    main :: IO ()
    main = do
        Sys.setInputEcho False
        Sys.hSetBuffering Sys.stdout Sys.NoBuffering
        Sys.hSetBuffering Sys.stdin Sys.NoBuffering
        print =<< checkAll ["12", "34", "56"]
    
    checkAll :: [String] -> IO [String]
    checkAll [] = return []
    checkAll (s : lrs) = do
        l <- getLine
        let symbol = if l == s then "==" else "/="
            p1 = l ++ symbol ++ s
        p2 <- Sys.unsafeInterleaveIO $ checkAll lrs -- just added a call here
        return (p1 : p2)
    

    I do strongly recommend using a proper streaming library instead of lazy IO. Lazy IO is a neat trick that can make really simple programs a bit more responsive than they "should" be but should never be relied on. In that vein I will point out that the conduit package you suggest is really overkill. You don't need any more than streaming's Stream, a.k.a. the free monad transformer FreeT.

    When using the package streaming it looks like this:

    import qualified System.IO as Sys
    import qualified System.IO.Echo as Sys
    import Streaming.Prelude as S
    import Streaming as S
    
    main :: IO ()
    main = do
        Sys.setInputEcho False
        Sys.hSetBuffering Sys.stdout Sys.NoBuffering
        -- may be not needed:
        -- Sys.hSetBuffering Sys.stdin Sys.NoBuffering
        S.mapM_ putChar $ showStream $ S.mapM check $ S.each ["12", "34", "56"]
        putStrLn ""
    
    check :: String -> IO String
    check s =  do
        l <- getLine
        pure (l ++ (if l == s then "==" else "/=") ++ s)
    
    showStream :: (Show a, Monad m) => Stream (Of a) m r -> Stream (Of Char) m r
    showStream xs = do
        S.yield '['
        r <- S.intercalates (S.each ", ") $ S.maps (\(x :> r) -> r <$ S.each (Prelude.show x)) xs
        S.yield ']'
        pure r