{-# LINE 1 "System/Syscall/Linux.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# LINE 2 "System/Syscall/Linux.hsc" #-}
-- | Linux System Calls
-- http://www.kernel.org/doc/man-pages/online/pages/man2/syscalls.2.html
module System.Syscall.Linux 
       ( c_open, c_close,
         c_read, c_write,
         c_fcntl,
         StructStat(..), c_stat, c_fstat, c_lstat,
         c_sendfile
       )
       where

import Foreign
import Foreign.C

{-# LINE 16 "System/Syscall/Linux.hsc" #-}


{-# LINE 18 "System/Syscall/Linux.hsc" #-}

-- | Open, Close
-- int open(const char *pathname, int flags);
-- int close(int fd);

{-# LINE 23 "System/Syscall/Linux.hsc" #-}
newtype FcntlFlags = FcntlFlags { unFcntlFlags :: CInt } deriving (Eq, Ord)

o_rdonly  :: FcntlFlags
o_rdonly  = FcntlFlags 0
o_wronly  :: FcntlFlags
o_wronly  = FcntlFlags 1
o_rdwr    :: FcntlFlags
o_rdwr    = FcntlFlags 2
o_creat   :: FcntlFlags
o_creat   = FcntlFlags 64
o_append  :: FcntlFlags
o_append  = FcntlFlags 1024

{-# LINE 32 "System/Syscall/Linux.hsc" #-}
  
instance Show FcntlFlags where
  show f | f == o_rdonly = "O_RDONLY"
         | f == o_wronly = "O_WRONLY"
         | f == o_rdwr   = "O_RDWR"
         | f == o_creat  = "O_CREAT"
         | f == o_append = "O_APPEND"
         | otherwise = show $ unFcntlFlags f

foreign import ccall unsafe "unistd.h open" c_open 
  :: CString -> CInt -> IO CInt
foreign import ccall unsafe "unistd.h close" c_close 
  :: CInt -> IO CInt

-- | Read, Write

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

-- | Fcntl

foreign import ccall unsafe "fcntl.h fcntl" c_fcntl 
  :: CInt -> CInt -> CLong -> IO CInt

-- | Stat
-- int stat(const char *path, struct stat *buf);
-- int fstat(int fd, struct stat *buf);
-- int lstat(const char *path, struct stat *buf);

{-# LINE 63 "System/Syscall/Linux.hsc" #-}

data StructStat = StructStat {
  stSize :: ! Int64
{-# LINE 66 "System/Syscall/Linux.hsc" #-}
  }

type StructStatPtr = Ptr StructStat

instance Storable StructStat where
  alignment _ = 4
{-# LINE 72 "System/Syscall/Linux.hsc" #-}
  sizeOf _    = (96)
{-# LINE 73 "System/Syscall/Linux.hsc" #-}
  peek p = do
    size <- (\hsc_ptr -> peekByteOff hsc_ptr 44) p
{-# LINE 75 "System/Syscall/Linux.hsc" #-}
    return (StructStat size)
  poke p (StructStat size) = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 44) p size
{-# LINE 78 "System/Syscall/Linux.hsc" #-}

foreign import ccall unsafe "stat" c_stat 
  :: CString -> StructStatPtr -> IO CInt
foreign import ccall unsafe "fstat" c_fstat 
  :: CInt -> StructStatPtr -> IO CInt
foreign import ccall unsafe "lstat" c_lstat 
  :: CString -> StructStatPtr -> IO CInt

-- | Sendfile
-- ssize_t sendfile(int out_fd, int in_fd, off_t * offset ", size_t" " count" );


{-# LINE 90 "System/Syscall/Linux.hsc" #-}
foreign import ccall unsafe "sendfile" c_sendfile 
  :: CInt -> CInt -> Ptr (Int64) -> (Word32) -> IO (Int32)
{-# LINE 92 "System/Syscall/Linux.hsc" #-}