{-# LINE 1 "System/Posix/Unistd.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE Safe #-}
module System.Posix.Unistd (
SystemID(..),
getSystemID,
SysVar(..),
getSysVar,
sleep, usleep, nanosleep,
fileSynchronise,
fileSynchroniseDataOnly,
) where
import Foreign.C.Error
import Foreign.C.String ( peekCString )
import Foreign.C.Types
import Foreign
import System.Posix.Types
import System.Posix.Internals
{-# LINE 68 "System/Posix/Unistd.hsc" #-}
data SystemID =
SystemID { systemName :: String
, nodeName :: String
, release :: String
, version :: String
, machine :: String
}
getSystemID :: IO SystemID
getSystemID = do
allocaBytes (390) $ \p_sid -> do
{-# LINE 83 "System/Posix/Unistd.hsc" #-}
throwErrnoIfMinus1_ "getSystemID" (c_uname p_sid)
sysN <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 0)) p_sid)
{-# LINE 85 "System/Posix/Unistd.hsc" #-}
node <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 65)) p_sid)
{-# LINE 86 "System/Posix/Unistd.hsc" #-}
rel <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 130)) p_sid)
{-# LINE 87 "System/Posix/Unistd.hsc" #-}
ver <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 195)) p_sid)
{-# LINE 88 "System/Posix/Unistd.hsc" #-}
mach <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 260)) p_sid)
{-# LINE 89 "System/Posix/Unistd.hsc" #-}
return (SystemID { systemName = sysN,
nodeName = node,
release = rel,
version = ver,
machine = mach
})
foreign import ccall unsafe "uname"
c_uname :: Ptr CUtsname -> IO CInt
sleep :: Int -> IO Int
sleep 0 = return 0
sleep secs = do r <- c_sleep (fromIntegral secs); return (fromIntegral r)
{-# WARNING sleep "This function has several shortcomings (see documentation). Please consider using Control.Concurrent.threadDelay instead." #-}
foreign import ccall safe "sleep"
c_sleep :: CUInt -> IO CUInt
usleep :: Int -> IO ()
{-# LINE 132 "System/Posix/Unistd.hsc" #-}
usleep usecs = nanosleep (fromIntegral usecs * 1000)
{-# LINE 149 "System/Posix/Unistd.hsc" #-}
nanosleep :: Integer -> IO ()
{-# LINE 158 "System/Posix/Unistd.hsc" #-}
nanosleep 0 = return ()
nanosleep nsecs = do
allocaBytes (16) $ \pts1 -> do
{-# LINE 161 "System/Posix/Unistd.hsc" #-}
allocaBytes (16) $ \pts2 -> do
{-# LINE 162 "System/Posix/Unistd.hsc" #-}
let (tv_sec0, tv_nsec0) = nsecs `divMod` 1000000000
let
loop tv_sec tv_nsec = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) pts1 tv_sec
{-# LINE 166 "System/Posix/Unistd.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) pts1 tv_nsec
{-# LINE 167 "System/Posix/Unistd.hsc" #-}
res <- c_nanosleep pts1 pts2
if res == 0
then return ()
else do errno <- getErrno
if errno == eINTR
then do
tv_sec' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pts2
{-# LINE 174 "System/Posix/Unistd.hsc" #-}
tv_nsec' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) pts2
{-# LINE 175 "System/Posix/Unistd.hsc" #-}
loop tv_sec' tv_nsec'
else throwErrno "nanosleep"
loop (fromIntegral tv_sec0 :: CTime) (fromIntegral tv_nsec0 :: CTime)
data {-# CTYPE "struct timespec" #-} CTimeSpec
foreign import capi safe "HsUnix.h nanosleep"
c_nanosleep :: Ptr CTimeSpec -> Ptr CTimeSpec -> IO CInt
{-# LINE 184 "System/Posix/Unistd.hsc" #-}
data SysVar = ArgumentLimit
| ChildLimit
| ClockTick
| GroupLimit
| OpenFileLimit
| PosixVersion
| HasSavedIDs
| HasJobControl
getSysVar :: SysVar -> IO Integer
getSysVar v =
case v of
ArgumentLimit -> sysconf (0)
{-# LINE 202 "System/Posix/Unistd.hsc" #-}
ChildLimit -> sysconf (1)
{-# LINE 203 "System/Posix/Unistd.hsc" #-}
ClockTick -> sysconf (2)
{-# LINE 204 "System/Posix/Unistd.hsc" #-}
GroupLimit -> sysconf (3)
{-# LINE 205 "System/Posix/Unistd.hsc" #-}
OpenFileLimit -> sysconf (4)
{-# LINE 206 "System/Posix/Unistd.hsc" #-}
PosixVersion -> sysconf (29)
{-# LINE 207 "System/Posix/Unistd.hsc" #-}
HasSavedIDs -> sysconf (8)
{-# LINE 208 "System/Posix/Unistd.hsc" #-}
HasJobControl -> sysconf (7)
{-# LINE 209 "System/Posix/Unistd.hsc" #-}
sysconf :: CInt -> IO Integer
sysconf n = do
r <- throwErrnoIfMinus1 "getSysVar" (c_sysconf n)
return (fromIntegral r)
foreign import ccall unsafe "sysconf"
c_sysconf :: CInt -> IO CLong
fileSynchronise :: Fd -> IO ()
{-# LINE 230 "System/Posix/Unistd.hsc" #-}
fileSynchronise fd = do
throwErrnoIfMinus1_ "fileSynchronise" (c_fsync fd)
foreign import capi safe "unistd.h fsync"
c_fsync :: Fd -> IO CInt
{-# LINE 241 "System/Posix/Unistd.hsc" #-}
fileSynchroniseDataOnly :: Fd -> IO ()
{-# LINE 251 "System/Posix/Unistd.hsc" #-}
fileSynchroniseDataOnly fd = do
throwErrnoIfMinus1_ "fileSynchroniseDataOnly" (c_fdatasync fd)
foreign import capi safe "unistd.h fdatasync"
c_fdatasync :: Fd -> IO CInt
{-# LINE 262 "System/Posix/Unistd.hsc" #-}