uniform-io/test/Lazyness.hs

{-# LANGUAGE OverloadedStrings #-}

module Lazyness (tests) where

import Distribution.TestSuite
import Control.Concurrent(forkIO) 
import qualified System.IO.Uniform as U
import qualified System.IO.Uniform.Streamline as S
import System.Timeout (timeout)  

tests :: IO [Test]
tests = return [Test readLine]
  where
    readLine = TestInstance
      {run = testReadLine,
       name = "Lazyness of readLine",
       tags = [],
       options = [],
       setOption = \_ _ -> Right readLine
      }
      
testReadLine :: IO Progress
testReadLine = do
  recv <- U.bindPort 8888
  forkIO $ S.withClient (\_ _ -> do
                            l <- S.receiveLine
                            S.send l
                            S.send "\n"
                            return ()
                        ) recv
  r <- timeout 1000000 $ S.withServer (do
                                     S.send "A test\n"
                                     S.receiveLine
                                     return ()
                                 ) "127.0.0.1" 8888
  case r of
    Just _ -> return . Finished $ Pass
    Nothing -> return . Finished . Fail $ "Timeout on Streamline.readLine"