{-# LANGUAGE CPP, ForeignFunctionInterface,
    MultiParamTypeClasses, FunctionalDependencies#-}

module Network.Generic 
    where

#include <sys/socket.h>

import Foreign
import Foreign.C.Types
import Foreign.C.Error.Errno
import System.Posix.Types (Fd(..))
import System.Posix.IO (fdToHandle)
import System.IO
import Control.Monad.Error

type Network = ErrorT String IO

class (Storable a, Port p) => Socket s a p | s -> a, s -> p
    where
    mkSocket :: Network s
    toFd :: s -> Fd
    fdToSock :: Fd -> s

class Port p 
    where
  toNetwork :: (Integral a) => a -> p
  fromNetwork :: (Integral a) => p -> a

connect :: (Socket s a p) => s -> a -> Network Handle
connect sock addr = do
  connect' sock addr
  liftIO . fdToHandle . toFd $ sock

connect' :: (Socket s a p) => s -> a -> Network CInt
connect' sock addr = do
  p <- liftIO . newPoly $ addr
  withErrno $ {#call connect as _connect #} 
                (fromIntegral . toFd $ sock) 
                 p (fromIntegral $ sizeOf addr)
  

bind :: (Socket s a p) => s -> a -> Network ()
bind sock addr = do
  p <- liftIO . newPoly $ addr
  withErrno $ {#call bind as _bind#} 
                (fromIntegral . toFd $ sock) 
                 p (fromIntegral $ sizeOf addr)
  return ()

listen :: (Socket s a p) => s -> p -> Network ()
listen sock port = do
  withErrno ({#call listen as _listen#} (fromIntegral . toFd $ sock) (fromNetwork port))
  return ()

listenOn :: (Socket s a p) => p -> Network s
listenOn i = do
  s <- mkSocket
  listen s i
  return s

accept :: (Socket s a p) => s -> Network Handle
accept sock = do
  (sock',_) <- accept' sock
  liftIO . fdToHandle . toFd $ sock'

accept' :: (Socket s a p) => s -> Network (s,a)
accept' sock = do
  p <- liftIO malloc
  temp <- liftIO (peek p)
  psize <- liftIO . newPoly $ sizeOf temp
  fd' <- withErrno $ {#call accept as _accept#} 
         (fromIntegral . toFd $ sock) (castPtr p) psize
  addr <- liftIO $ peek p
  return (fdToSock (Fd fd'),addr)

newPoly :: (Storable a) => a -> IO (Ptr b)
newPoly a = fmap castPtr . new $ a