{-# INCLUDE <sys/poll.h> #-}
{-# LINE 1 "System/Posix/Poll.hsc" #-}
{-# OPTIONS -fffi -fglasgow-exts #-}
{-# LINE 2 "System/Posix/Poll.hsc" #-}
{- |
   Module      :  System.Posix.Poll
   Copyright   :  (c) 2006-04-08 by Peter Simons
   License     :  GPL2

   Maintainer  :  simons@cryp.to
   Stability   :  provisional
   Portability :  Haskell 2-pre

   A foreign function interface to the POSIX system call
   @poll(2)@. Your program should link the threaded
   runtime-system when using this module in blocking
   fashion.
 -}

module System.Posix.Poll where

import Foreign
import Foreign.C
import System.Posix.Types


{-# LINE 24 "System/Posix/Poll.hsc" #-}

-- |The marshaled version of:
--
-- > struct pollfd
-- >   {
-- >   int fd;           /* file descriptor */
-- >   short events;     /* requested events */
-- >   short revents;    /* returned events */
-- >   };

data Pollfd = Pollfd Fd CShort CShort
            deriving (Show)

instance Storable Pollfd where
    sizeOf _    = (8)
{-# LINE 39 "System/Posix/Poll.hsc" #-}
    alignment _ = alignment (undefined :: CInt)

    peek p = do
      fd <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 43 "System/Posix/Poll.hsc" #-}
      e  <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
{-# LINE 44 "System/Posix/Poll.hsc" #-}
      re <- (\hsc_ptr -> peekByteOff hsc_ptr 6) p
{-# LINE 45 "System/Posix/Poll.hsc" #-}
      return $ Pollfd fd e re

    poke p (Pollfd fd e re) = do
      (\hsc_ptr -> pokeByteOff hsc_ptr 0) p fd
{-# LINE 49 "System/Posix/Poll.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 4) p e
{-# LINE 50 "System/Posix/Poll.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 6) p re
{-# LINE 51 "System/Posix/Poll.hsc" #-}

-- |Marshaled 'Enum' representing the various @poll(2)@
-- flags.

data PollFlag
  = PollIn     -- ^ there is data to read
  | PollPri    -- ^ there is urgent data to read
  | PollOut    -- ^ writing now will not block
  | PollErr    -- ^ error condition
  | PollHup    -- ^ hung up
  | PollNVal   -- ^ invalid request: fd not open
  deriving (Eq, Bounded, Show)

instance Enum PollFlag where
  toEnum 1   = PollIn
{-# LINE 66 "System/Posix/Poll.hsc" #-}
  toEnum 2  = PollPri
{-# LINE 67 "System/Posix/Poll.hsc" #-}
  toEnum 4  = PollOut
{-# LINE 68 "System/Posix/Poll.hsc" #-}
  toEnum 8  = PollErr
{-# LINE 69 "System/Posix/Poll.hsc" #-}
  toEnum 16  = PollHup
{-# LINE 70 "System/Posix/Poll.hsc" #-}
  toEnum 32 = PollNVal
{-# LINE 71 "System/Posix/Poll.hsc" #-}
  toEnum i = error ("PollFlag cannot be mapped to value " ++ show i)

  fromEnum PollIn    = 1
{-# LINE 74 "System/Posix/Poll.hsc" #-}
  fromEnum PollPri   = 2
{-# LINE 75 "System/Posix/Poll.hsc" #-}
  fromEnum PollOut   = 4
{-# LINE 76 "System/Posix/Poll.hsc" #-}
  fromEnum PollErr   = 8
{-# LINE 77 "System/Posix/Poll.hsc" #-}
  fromEnum PollHup   = 16
{-# LINE 78 "System/Posix/Poll.hsc" #-}
  fromEnum PollNVal  = 32
{-# LINE 79 "System/Posix/Poll.hsc" #-}

-- |The system routine @poll(2)@ may block, obviously; so it
-- is declared as a \"safe\" FFI call. In the /threaded/
-- runtime-system, this means that a blocking invocation of
-- 'poll' will not block any other execution threads. Thus,
-- you should link your programs with @-threaded@ when you
-- use this module. Further details can be found at
-- <http://www.haskell.org//pipermail/glasgow-haskell-users/2005-February/007762.html>.
--
-- In the non-threaded runtime-system, using 'poll' in
-- blocking fashion /will/ block all other threads too.

foreign import ccall safe poll :: Ptr Pollfd -> CUInt -> CInt -> IO CInt