{-# LINE 1 "Network/Libev.hsc" #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LINE 2 "Network/Libev.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

-- | @Network.Libev@ is a low-level binding to the libev library
-- (<http://libev.schmorp.de/>). The @libev@ documentation is available here:
-- <http://pod.tst.eu/http://cvs.schmorp.de/libev/ev.pod>.
module Network.Libev
    ( 
    -- * Event loops
    -- | see <http://pod.tst.eu/http://cvs.schmorp.de/libev/ev.pod#FUNCTIONS_CONTROLLING_THE_EVENT_LOOP>

      EvLoopPtr
    , evDefaultLoop
    , evLoopNew
    , evLoop
    , evUnloop
    , evLoopDestroy

    -- ** EVLOOP_*, EVUNLOOP_* flags
    , CEvLoopFlagType
    , evloop_nonblock
    , evloop_oneshot
    , CEvUnloopFlagType
    , evunloop_cancel
    , evunloop_one
    , evunloop_all

    -- ** EVFLAG_* flags
    , CEvFlagType
    , evRecommendedBackends
    , evflag_auto
    , evflag_noenv
    , evflag_forkcheck
    , evflag_noinotify
    , evflag_nosigfd
    , evflag_signalfd

    -- ** EVBACKEND_* flags
    , CEvBackendFlagType
    , evbackend_select
    , evbackend_poll
    , evbackend_epoll
    , evbackend_kqueue
    , evbackend_devpoll
    , evbackend_port
    , evbackend_all

    -- ** Locking for event loops
    , MutexCallback
    , setupLockingForLoop
    , freeMutexCallback

    -- ** Event flags
    , CEventType
    , ev_undef
    , ev_none
    , ev_read
    , ev_write
    , ev__iofdset
    , ev_io
    , ev_timeout
    , ev_timer
    , ev_periodic
    , ev_signal
    , ev_child
    , ev_stat
    , ev_idle
    , ev_prepare
    , ev_check
    , ev_embed
    , ev_fork
    , ev_async
    , ev_custom
    , ev_error

    -- * @ev\_io@
    -- | See libev docs:  <http://pod.tst.eu/http://cvs.schmorp.de/libev/ev.pod#code_ev_io_code_is_this_file_descrip>

    , EvIoPtr
    , IoCallback
    , mkEvIo
    , freeEvIo
    , mkIoCallback
    , freeIoCallback
    , evIoInit
    , evIoStart
    , evIoStop

    -- * @ev\_timer@
    -- | See libev docs: <http://pod.tst.eu/http://cvs.schmorp.de/libev/ev.pod#code_ev_timer_code_relative_and_opti>
    , EvTimer
    , EvTimerPtr
    , TimerCallback
    , mkEvTimer
    , freeEvTimer
    , mkTimerCallback
    , freeTimerCallback
    , evTimerInit
    , evTimerStart
    , evTimerStop
    , evTimerAgain
    , evTimerRemaining
    , evTimerSetRepeat

    -- * @ev\_async@@
    -- | See libev docs: <http://pod.tst.eu/http://cvs.schmorp.de/libev/ev.pod#code_ev_async_code_how_to_wake_up_an>
    , EvAsyncPtr
    , AsyncCallback
    , mkEvAsync
    , freeEvAsync
    , evAsyncInit
    , evAsyncSend
    , evAsyncStart
    , evAsyncStop
    , mkAsyncCallback
    , freeAsyncCallback

    -- * Time functions
    , EvTimestamp
    , evNow
    , evTime

    -- * C utility functions
    , c_accept
    , c_close
    , c_read
    , c_write
    , c_setnonblocking
    )
    where

import Control.Concurrent.MVar
import Prelude hiding (repeat)
import Foreign
import Foreign.C


{-# LINE 138 "Network/Libev.hsc" #-}

-- | 'CEventType' is a bitfield used to flag whether a file descriptor is
-- readable, writable, or both. Valid values are 'ev_read' and
-- 'ev_write'. TODO: deprecate and replace by a datatype
type CEventType = CInt

-- | eventmask, revents, events...
ev_undef     :: CEventType
ev_undef     =  (-1)
ev_none      :: CEventType
ev_none      =  0
ev_read      :: CEventType
ev_read      =  1
ev_write     :: CEventType
ev_write     =  2
ev__iofdset  :: CEventType
ev__iofdset  =  128
ev_io        :: CEventType
ev_io        =  1
ev_timeout   :: CEventType
ev_timeout   =  256
ev_timer     :: CEventType
ev_timer     =  256
ev_periodic  :: CEventType
ev_periodic  =  512
ev_signal    :: CEventType
ev_signal    =  1024
ev_child     :: CEventType
ev_child     =  2048
ev_stat      :: CEventType
ev_stat      =  4096
ev_idle      :: CEventType
ev_idle      =  8192
ev_prepare   :: CEventType
ev_prepare   =  16384
ev_check     :: CEventType
ev_check     =  32768
ev_embed     :: CEventType
ev_embed     =  65536
ev_fork      :: CEventType
ev_fork      =  131072
ev_async     :: CEventType
ev_async     =  262144
ev_custom    :: CEventType
ev_custom    =  16777216
ev_error     :: CEventType
ev_error     =  2147483648

{-# LINE 167 "Network/Libev.hsc" #-}

-- | 'CEvFlagType' is a bitfield used to pass flags into
-- 'evDefaultLoop'. Values ('evflag_auto', 'evflag_noenv', etc.) are combined
-- with bitwise or. TODO: replace with a newtype with a monoid instance
type CEvFlagType = CInt

evflag_auto        :: CEvFlagType
evflag_auto        =  0
evflag_noenv       :: CEvFlagType
evflag_noenv       =  16777216
evflag_forkcheck   :: CEvFlagType
evflag_forkcheck   =  33554432
evflag_noinotify   :: CEvFlagType
evflag_noinotify   =  1048576
evflag_nosigfd     :: CEvFlagType
evflag_nosigfd     =  0
evflag_signalfd    :: CEvFlagType
evflag_signalfd    =  2097152

{-# LINE 181 "Network/Libev.hsc" #-}

type CEvBackendFlagType = CInt

evbackend_select   :: CEvBackendFlagType
evbackend_select   =  1
evbackend_poll     :: CEvBackendFlagType
evbackend_poll     =  2
evbackend_epoll    :: CEvBackendFlagType
evbackend_epoll    =  4
evbackend_kqueue   :: CEvBackendFlagType
evbackend_kqueue   =  8
evbackend_devpoll  :: CEvBackendFlagType
evbackend_devpoll  =  16
evbackend_port     :: CEvBackendFlagType
evbackend_port     =  32
evbackend_all      :: CEvBackendFlagType
evbackend_all      =  63

{-# LINE 193 "Network/Libev.hsc" #-}

type CEvLoopFlagType = CInt
evloop_nonblock  :: CEvLoopFlagType
evloop_nonblock  =  1
evloop_oneshot   :: CEvLoopFlagType
evloop_oneshot   =  2

{-# LINE 199 "Network/Libev.hsc" #-}

type CEvUnloopFlagType = CInt
evunloop_cancel  :: CEvUnloopFlagType
evunloop_cancel  =  0
evunloop_one     :: CEvUnloopFlagType
evunloop_one     =  1
evunloop_all     :: CEvUnloopFlagType
evunloop_all     =  2

{-# LINE 206 "Network/Libev.hsc" #-}


data EvLoop
type EvLoopPtr    = Ptr EvLoop

data EvWatcher
type EvWatcherPtr = Ptr EvWatcher

data EvIo         = EvIo { fd :: CInt, events :: CInt }
type EvIoPtr      = Ptr EvIo

data EvTimer      = EvTimer { repeat :: Double }
type EvTimerPtr   = Ptr EvTimer

data EvAsync
type EvAsyncPtr   = Ptr EvAsync

instance Storable EvWatcher where
    sizeOf    _ = ((20))
{-# LINE 225 "Network/Libev.hsc" #-}
    alignment _ = alignment (undefined :: CInt)

instance Storable EvIo where
    sizeOf    _ = (32)
{-# LINE 229 "Network/Libev.hsc" #-}
    alignment _ = alignment (undefined :: CInt)
    peek ptr    = do
      fd'       <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 232 "Network/Libev.hsc" #-}
      events'   <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
{-# LINE 233 "Network/Libev.hsc" #-}
      return EvIo { fd = fd', events = events' }
    poke ptr (EvIo fd' events') = do
      ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr fd'
{-# LINE 236 "Network/Libev.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) ptr events'
{-# LINE 237 "Network/Libev.hsc" #-}

instance Storable EvTimer where
    sizeOf    _ = ((36))
{-# LINE 240 "Network/Libev.hsc" #-}
    alignment _ = alignment (undefined :: CInt)
    peek ptr    = do
      repeat'   <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
{-# LINE 243 "Network/Libev.hsc" #-}
      return EvTimer { repeat = repeat' }
    poke ptr (EvTimer repeat') = do
      ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) ptr repeat'
{-# LINE 246 "Network/Libev.hsc" #-}

instance Storable EvAsync where
    sizeOf    _ = ((24))
{-# LINE 249 "Network/Libev.hsc" #-}
    alignment _ = alignment (undefined :: CInt)


-- | An 'IoCallback' is called when a file descriptor becomes readable or
-- writable. It takes a pointer to an @ev\_loop@ structure, a pointer to an
-- @ev\_io@ structure, and an event mask.
type IoCallback = EvLoopPtr -> EvIoPtr -> CEventType -> IO ()

-- | A 'TimerCallback' is called when a timer expires. It takes a pointer to an
-- @ev\_loop@ structure, a pointer to an @ev\_timer@ structure, and an (unused?)
-- event mask.
type TimerCallback = EvLoopPtr -> EvTimerPtr -> CEventType -> IO ()

-- | An 'AsyncCallback' is called when you wakeup an event loop with
-- @ev_async_send@
type AsyncCallback = EvLoopPtr -> EvAsyncPtr -> CEventType -> IO ()

-- | 'MutexCallback' is called by @ev\_set\_loop\_release\_cb@
type MutexCallback = EvLoopPtr -> IO ()

-- | Libev timestamp values are C doubles containing the (floating) number of
-- seconds since Jan 1, 1970.
type EvTimestamp = CDouble

-- | Set up the given loop for mutex locking from haskell-land -- if you want
-- to touch the loop from other Haskell threads, you'll need to do this. The
-- two FunPtr objects returned need to be explicitly freed with
-- 'freeMutexCallback'.
--
-- IMPORTANT: if you want multithreaded access to an 'EvLoopPtr', you'll have
-- to acquire the 'MVar' returned here (using 'withMVar') whenever you call any
-- of the @ev@ functions. Very bad C-land crash\/bang\/boom could otherwise
-- result.
--
-- ALSO IMPORTANT: any changes you make to an 'EvLoopPtr' from another thread
-- while the event loop thread is blocked inside @ev\_loop()@ will NOT take
-- effect until the the event loop thread unblocks. You'll need to set up an
-- @ev\_async@ watcher in order to wake up the event loop thread.
setupLockingForLoop :: EvLoopPtr
                    -> IO (FunPtr MutexCallback, FunPtr MutexCallback, MVar ())
setupLockingForLoop loop = do
    mvar <- newMVar ()

    acq <- mkMutexCallback $ acquire mvar
    rel <- mkMutexCallback $ release mvar

    evSetLoopReleaseCB loop rel acq

    return (rel, acq, mvar)
  where
    release mvar _ = putMVar mvar ()
    acquire mvar _ = takeMVar mvar


foreign import ccall safe "ev_set_loop_release_cb"
        evSetLoopReleaseCB :: EvLoopPtr
                           -> FunPtr MutexCallback
                           -> FunPtr MutexCallback
                           -> IO ()

-- | Returns the default set of 'CEvFlagType' flags
foreign import ccall unsafe "ev.h ev_recommended_backends" evRecommendedBackends :: IO CEvFlagType

foreign import ccall unsafe "wev_default_loop" evDefaultLoop :: CInt -> IO EvLoopPtr
foreign import ccall "wev_loop" evLoop :: EvLoopPtr -> CInt -> IO ()
foreign import ccall "wev_unloop" evUnloop :: EvLoopPtr -> CInt -> IO ()
foreign import ccall unsafe "wev_loop_new" evLoopNew :: CUInt -> IO EvLoopPtr
foreign import ccall unsafe "wev_loop_destroy" evLoopDestroy :: EvLoopPtr -> IO ()

foreign import ccall unsafe "wev_io_init" evIoInit :: EvIoPtr -> FunPtr IoCallback -> CInt -> CEventType -> IO ()
foreign import ccall unsafe "wev_io_start" evIoStart :: EvLoopPtr -> EvIoPtr -> IO ()
foreign import ccall unsafe "wev_io_stop" evIoStop :: EvLoopPtr -> EvIoPtr -> IO ()

foreign import ccall unsafe "wev_async_init" evAsyncInit :: EvAsyncPtr
                                                         -> FunPtr AsyncCallback
                                                         -> IO ()

foreign import ccall unsafe "wev_async_send" evAsyncSend :: EvLoopPtr
                                                         -> EvAsyncPtr
                                                         -> IO ()

foreign import ccall unsafe "wev_async_start" evAsyncStart :: EvLoopPtr
                                                           -> EvAsyncPtr
                                                           -> IO ()

foreign import ccall unsafe "wev_async_stop" evAsyncStop :: EvLoopPtr
                                                         -> EvAsyncPtr
                                                         -> IO ()

foreign import ccall unsafe "wev_timer_init" evTimerInit :: EvTimerPtr -> FunPtr TimerCallback -> EvTimestamp -> EvTimestamp -> IO ()
foreign import ccall unsafe "wev_timer_set" evTimerSet :: EvTimerPtr -> EvTimestamp -> EvTimestamp -> IO ()
foreign import ccall unsafe "wev_timer_start" evTimerStart :: EvLoopPtr -> EvTimerPtr -> IO ()
foreign import ccall unsafe "wev_timer_stop" evTimerStop :: EvLoopPtr -> EvTimerPtr -> IO ()
foreign import ccall unsafe "wev_timer_again" evTimerAgain :: EvLoopPtr -> EvTimerPtr -> IO ()
foreign import ccall unsafe "wev_timer_remaining" evTimerRemaining :: EvLoopPtr -> EvTimerPtr -> IO (EvTimestamp)

foreign import ccall unsafe "unistd.h close" c_close :: CInt -> IO (CInt)
foreign import ccall unsafe "unistd.h read" c_read :: CInt -> CString -> CSize -> IO (CSize)
foreign import ccall unsafe "unistd.h write" c_write :: CInt -> CString -> CSize -> IO (CSize)

-- | Calls @accept()@ and sets the socket non-blocking.
foreign import ccall unsafe "c_accept" c_accept :: CInt -> IO (CInt)
foreign import ccall unsafe "set_nonblocking" c_setnonblocking :: CInt -> IO ()

-- | Fetches the current time from the operating system. Usually 'evNow' is
-- preferred since it avoids a context switch by returning a cached value.
foreign import ccall unsafe "ev.h ev_time" evTime :: IO EvTimestamp

-- | Fetch a the cached copy of the current time from a loop.
foreign import ccall unsafe "ev.h ev_now"  evNow  :: EvLoopPtr -> IO EvTimestamp

-----------------------
-- callback wrappers --
-----------------------

-- | Wrap up an 'IoCallback' so it can be delivered into C-land. This resource
-- is not garbage-collected, you are responsible for freeing it with
-- 'freeIoCallback'.
foreign import ccall "wrapper" mkIoCallback :: IoCallback
                                            -> IO (FunPtr IoCallback)

-- | Wrap up a 'TimerCallback' so it can be delivered into C-land. This
-- resource is not garbage-collected, you are responsible for freeing it with
-- 'freeTimerCallback'.
foreign import ccall "wrapper" mkTimerCallback :: TimerCallback
                                               -> IO (FunPtr TimerCallback)

-- | Wrap up an 'AsyncCallback' so it can be delivered into C-land. This
-- resource is not garbage-collected, you are responsible for freeing it with
-- 'freeAsyncCallback'.
foreign import ccall "wrapper" mkAsyncCallback :: AsyncCallback
                                               -> IO (FunPtr AsyncCallback)


foreign import ccall "wrapper" mkMutexCallback :: MutexCallback
                                               -> IO (FunPtr MutexCallback)

freeIoCallback :: FunPtr IoCallback -> IO ()
freeIoCallback = freeHaskellFunPtr

freeMutexCallback :: FunPtr MutexCallback -> IO ()
freeMutexCallback = freeHaskellFunPtr

freeTimerCallback :: FunPtr TimerCallback -> IO ()
freeTimerCallback = freeHaskellFunPtr

freeAsyncCallback :: FunPtr AsyncCallback -> IO ()
freeAsyncCallback = freeHaskellFunPtr

-- mem allocators
-- foreign import ccall unsafe "wmkevio" mkEvIo :: IO (EvIoPtr)
-- foreign import ccall unsafe "wfreeevio" freeEvIo :: EvIoPtr -> IO ()

-- | Makes a new @ev_io@ struct using 'malloc'. You are responsible for freeing
-- it with 'freeEvIo'.
mkEvIo :: IO (EvIoPtr)
mkEvIo = malloc

-- | free() an 'EvIoPtr'
freeEvIo :: EvIoPtr -> IO ()
freeEvIo = free

-- | Makes a new @ev_timer@ struct using 'malloc'. You are responsible for freeing
-- it with 'freeEvTimer'.
mkEvTimer :: IO (EvTimerPtr)
mkEvTimer = malloc

evTimerSetRepeat :: EvTimerPtr -> Double -> IO ()
evTimerSetRepeat p t = do
  evtimer <- peek p
  poke p evtimer { repeat = t }

-- | free() an 'EvTimer'
freeEvTimer :: EvTimerPtr -> IO ()
freeEvTimer = free

-- | Makes a new @ev_async@ struct using 'malloc'. You are responsible for
-- freeing it with 'freeEvAsync'.
mkEvAsync :: IO (EvAsyncPtr)
mkEvAsync = malloc

-- | free() an 'EvAsync'
freeEvAsync :: EvAsyncPtr -> IO ()
freeEvAsync = free