{-# LANGUAGE CPP #-}
module SocketIO(S.Socket,NetSocket,Fd,connectTo,listenOn,accept,
                select,sRead,sWrite,closeS,closeLs,closeFd,ls2fd,nls2ls,
                Net.PortID(..),s2fd,h2s) where
import System.IO.Error(catchIOError,isEOFError)
import System.Posix.IO.Select(select')
import System.Posix.IO.Select.Types
import Control.Concurrent(threadWaitRead,threadWaitWrite)
import qualified Network as Net
import qualified Network.Socket as N(fdSocket)
import System.Posix.IO.ByteString(handleToFd,closeFd)
import System.Posix.Types(Fd(..))
import Data.ByteString as BS(empty,length,drop)
import Sockets as S

#if MIN_VERSION_unix(2,8,0)
-- From the unix-2.8.0.0 release notes:
-- Add fdRead/fdWrite with ByteString payload and deprecate String based fdRead

import System.Posix.IO.ByteString(fdWrite,fdRead)

#else
-- Fallback implementations of rdRead and fdWrite for use with unix<2.8

import System.Posix.IO.ByteString(fdReadBuf,fdWriteBuf)
import Data.ByteString as BS(pack,unpack)
import Foreign(allocaArray,pokeArray,peekArray)

fdRead fd n =
  allocaArray n $ \ buf ->
  do n <- fromIntegral <$> fdReadBuf fd buf (fromIntegral n)
     pack <$> peekArray n buf

fdWrite fd bs =
  allocaArray n $ \ buf ->
  do pokeArray buf (unpack bs)
     fdWriteBuf fd buf (fromIntegral n)
  where n = BS.length bs
#endif

type NetSocket = Net.Socket

sRead = sRead' . s2fd

sRead' fd n = do threadWaitRead fd
                 catchEOF empty $ fdRead fd n

catchEOF r m = catchIOError m $ \ e -> if isEOFError e
                                       then return r
                                       else ioError e

sWrite = sWrite' . s2fd
sWrite' fd bs = do threadWaitWrite fd
                   n <- fi <$> fdWrite fd bs
                   let r=BS.length bs-n
                   if r>0
                     then sWrite' fd (BS.drop n bs)
                     else return ()

listenOn port = Net.listenOn port

connectTo host port = h2s =<< Net.connectTo host port {-
  do so@(So fd) <-
     let s = N.MkSocket (fi fd) u u u u where u = undefined
     N.setSocketOption s N.SendBuffer (256*1024)
     N.setSocketOption s N.RecvBuffer (256*1024)
     return so -}

closeS = closeFd . s2fd
closeLs = closeFd . ls2fd

accept ls = do (h,host,port) <- Net.accept ls
               so <- h2s h
               return (so,host,port)

select rfds wfds t =
    do Just (rs,ws,_) <- select' rfds wfds [] (maybe Never fin t)
       return (rs,ws)
  where
    fin t = finite (fi (t `quot` 1000000)) (fi (t `rem` 1000000))

h2s h = fd2s <$> handleToFd h
fd2s (Fd fd) = So (fi fd)
s2fd (So s) = Fd (fi s)
ls2fd (LSo s) = Fd (fi s)
fd2ls (Fd fd) = LSo (fi fd)
nls2ls = fd2ls . Fd . N.fdSocket

fi x = fromIntegral x