module Main where

import Control.Concurrent (forkIO)
import Control.Monad (forever)
import GHC.Conc		(threadWaitRead, threadWaitWrite)
import Network (PortID(PortNumber), Socket, listenOn, sClose)
import Network.Socket (accept, socketToHandle, send, fdSocket, setSocketOption, SocketOption(KeepAlive))
import System.IO
import System.Posix.IO
import System.Posix.Types
    
listen' :: PortID -> (Socket -> IO ()) -> IO ()     
listen' port handler =
  do socket <- listenOn port
     forever $ do (s,sa) <- accept socket
                  setSocketOption s KeepAlive 1
                  forkIO $ handler s
                  
main :: IO ()
main =
  listen' (PortNumber (toEnum 2525)) $ \s ->
    do -- h <- socketToHandle s ReadWriteMode
       let fd = Fd (fdSocket s)
       writeLoop fd (10^6)
      where 
        writeLoop :: Fd -> ByteCount -> IO ()
        writeLoop fd count | count <= 0 = 
          do putStrLn "done."
             return ()
        writeLoop fd count =
          do putStrLn "threadWaitWrite"
             threadWaitWrite fd
             putStrLn "writing..."
             n <- fdWrite fd $ take (fromIntegral count) (repeat 'a')
             putStrLn ("wrote: "  ++ show n)
             writeLoop fd (count - n)