Ticket #5843: hGetSome.hs

File hGetSome.hs, 967 bytes (added by joeyadams, 2 years ago)
Line 
1import Control.Concurrent
2import Data.ByteString (hGetSome)
3import Network
4import System.IO
5
6main :: IO ()
7main = do
8    let port = PortNumber 1234
9    hSetBuffering stdout LineBuffering
10    serverListening <- newEmptyMVar
11    serverSent      <- newEmptyMVar
12
13    _ <- forkIO $ do
14        sock <- listenOn port
15        putMVar serverListening ()
16
17        (h, _, _) <- accept sock
18        hSetBuffering h LineBuffering
19        hPutStrLn h "One"
20        hPutStrLn h "Two"
21
22        putMVar serverSent ()
23
24        -- Prevent handle from being garbage collected
25        threadDelay 100000000
26        hPutStrLn h "Bye"
27
28    takeMVar serverListening
29
30    putStrLn "Connecting and getting first line"
31    h <- connectTo "localhost" port
32    hGetLine h >>= putStrLn
33
34    takeMVar serverSent
35
36    putStrLn "hWaitForInput"
37    ready <- hWaitForInput h 1000
38    putStrLn $ "ready: " ++ show ready
39
40    putStrLn "hGetSome"
41    s <- hGetSome h 4096
42    putStrLn $ "Got " ++ show s