{-# LINE 1 "System/FAM.hsc" #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LINE 2 "System/FAM.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

-- | @System.FAM@ is a low-level binding to the libfam library
-- The @libfam@ documentation is available here:
-- <http://oss.sgi.com/projects/fam/>.

module System.FAM 
    ( -- FAM API
      open
    , open2
    , close
    , monitorDirectory
    , monitorFile
    , monitorCollection
    , suspendMonitor
    , resumeMonitor
    , cancelMonitor
    , nextEvent
    , pending

    -- FAM Types
    , Connection(..)
    , Request(..)
    , Event(..)

    -- FAM Codes
    , changed
    , deleted
    , startexecuting
    , stopexecuting
    , created
    , moved
    , acknowledge
    , exists
    , endexist
    ) 
where

import Foreign
import Foreign.C


{-# LINE 44 "System/FAM.hsc" #-}
data Void
type VoidPtr       = Ptr Void

data Connection    = Connection { fd :: CInt }
type ConnectionPtr = Ptr Connection

data Request       = Request { reqnum :: CInt }
type RequestPtr    = Ptr Request

type FamCodes      = CInt

changed          :: FamCodes
changed          =  1
deleted          :: FamCodes
deleted          =  2
startexecuting   :: FamCodes
startexecuting   =  3
stopexecuting    :: FamCodes
stopexecuting    =  4
created          :: FamCodes
created          =  5
moved            :: FamCodes
moved            =  6
acknowledge      :: FamCodes
acknowledge      =  7
exists           :: FamCodes
exists           =  8
endexist         :: FamCodes
endexist         =  9

{-# LINE 66 "System/FAM.hsc" #-}

data Event         = Event { connection :: ConnectionPtr
                           , request    :: Request
                           , hostname   :: Ptr CString
                           , filename   :: CString
                           , userdata   :: VoidPtr
                           , code       :: FamCodes
                           }
type EventPtr      = Ptr Event

instance Storable Connection where
    sizeOf _     = ((8))
{-# LINE 78 "System/FAM.hsc" #-}
    alignment _  = alignment (undefined :: CInt)
    peek ptr     = do
      fd'        <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 81 "System/FAM.hsc" #-}
      return Connection { fd = fd' }
    poke ptr (Connection fd') = do
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr fd'
{-# LINE 84 "System/FAM.hsc" #-}

instance Storable Request where
    sizeOf _     = ((4))
{-# LINE 87 "System/FAM.hsc" #-}
    alignment _  = alignment (undefined :: CInt)
    peek ptr     = do
      rn'        <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 90 "System/FAM.hsc" #-}
      return Request { reqnum = rn' }
    poke ptr (Request rn') = do
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr rn'
{-# LINE 93 "System/FAM.hsc" #-}

instance Storable Event where
    sizeOf _      = ((4116))
{-# LINE 96 "System/FAM.hsc" #-}
    alignment _   = alignment (undefined :: CInt)
    peek ptr      = do
      connection' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 99 "System/FAM.hsc" #-}
      request'    <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 100 "System/FAM.hsc" #-}
      hostname'   <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 101 "System/FAM.hsc" #-}
      filename'   <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 102 "System/FAM.hsc" #-}
      userdata'   <- ((\hsc_ptr -> peekByteOff hsc_ptr 4108)) ptr
{-# LINE 103 "System/FAM.hsc" #-}
      code'       <- ((\hsc_ptr -> peekByteOff hsc_ptr 4112)) ptr
{-# LINE 104 "System/FAM.hsc" #-}
      return Event { connection = connection'
                   , request    = request'
                   , hostname   = hostname'
                   , filename   = filename' 
                   , userdata   = userdata'
                   , code       = code'
                   }

foreign import ccall unsafe "fam.h FAMOpen" open :: ConnectionPtr -> IO CInt
foreign import ccall unsafe "fam.h FAMOpen2" open2 :: ConnectionPtr -> CString -> IO CInt
foreign import ccall unsafe "fam.h FAMClose" close :: ConnectionPtr -> IO CInt
foreign import ccall unsafe "fam.h FAMMonitorDirectory" monitorDirectory :: ConnectionPtr -> Ptr CString -> RequestPtr -> VoidPtr -> IO CInt
foreign import ccall unsafe "fam.h FAMMonitorFile" monitorFile :: ConnectionPtr -> Ptr CString -> RequestPtr -> VoidPtr -> IO CInt
foreign import ccall unsafe "fam.h FAMMonitorCollection" monitorCollection :: ConnectionPtr -> Ptr CString -> RequestPtr -> VoidPtr -> CInt -> Ptr String -> IO CInt
foreign import ccall unsafe "fam.h FAMSuspendMonitor" suspendMonitor :: ConnectionPtr -> RequestPtr -> IO CInt
foreign import ccall unsafe "fam.h FAMResumeMonitor" resumeMonitor :: ConnectionPtr -> RequestPtr -> IO CInt
foreign import ccall unsafe "fam.h FAMCancelMonitor" cancelMonitor :: ConnectionPtr -> RequestPtr -> IO CInt
foreign import ccall unsafe "fam.h FAMNextEvent" nextEvent :: ConnectionPtr -> EventPtr -> IO CInt
foreign import ccall unsafe "fam.h FAMPending" pending :: ConnectionPtr -> IO CInt