{-# LINE 1 "libraries/unix/System/Posix/Unistd.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LINE 4 "libraries/unix/System/Posix/Unistd.hsc" #-}
{-# LANGUAGE Safe #-}
{-# LINE 8 "libraries/unix/System/Posix/Unistd.hsc" #-}
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 72 "libraries/unix/System/Posix/Unistd.hsc" #-}
data SystemID =
SystemID { SystemID -> String
systemName :: String
, SystemID -> String
nodeName :: String
, SystemID -> String
release :: String
, SystemID -> String
version :: String
, SystemID -> String
machine :: String
}
getSystemID :: IO SystemID
getSystemID :: IO SystemID
getSystemID = do
Int -> (Ptr CUtsname -> IO SystemID) -> IO SystemID
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
390) ((Ptr CUtsname -> IO SystemID) -> IO SystemID)
-> (Ptr CUtsname -> IO SystemID) -> IO SystemID
forall a b. (a -> b) -> a -> b
$ \Ptr CUtsname
p_sid -> do
{-# LINE 87 "libraries/unix/System/Posix/Unistd.hsc" #-}
throwErrnoIfMinus1_ "getSystemID" (c_uname p_sid)
sysN <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 0)) p_sid)
{-# LINE 89 "libraries/unix/System/Posix/Unistd.hsc" #-}
node <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 65)) p_sid)
{-# LINE 90 "libraries/unix/System/Posix/Unistd.hsc" #-}
rel <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 130)) p_sid)
{-# LINE 91 "libraries/unix/System/Posix/Unistd.hsc" #-}
ver <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 195)) p_sid)
{-# LINE 92 "libraries/unix/System/Posix/Unistd.hsc" #-}
mach <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 260)) p_sid)
{-# LINE 93 "libraries/unix/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 :: Int -> IO Int
sleep Int
0 = Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
sleep Int
secs = do CUInt
r <- CUInt -> IO CUInt
c_sleep (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
secs); Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
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 136 "libraries/unix/System/Posix/Unistd.hsc" #-}
usleep usecs = nanosleep (fromIntegral usecs * 1000)
{-# LINE 153 "libraries/unix/System/Posix/Unistd.hsc" #-}
nanosleep :: Integer -> IO ()
{-# LINE 161 "libraries/unix/System/Posix/Unistd.hsc" #-}
nanosleep :: Integer -> IO ()
nanosleep Integer
0 = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
nanosleep Integer
nsecs = do
Int -> (Ptr CTimeSpec -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
16) ((Ptr CTimeSpec -> IO ()) -> IO ())
-> (Ptr CTimeSpec -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CTimeSpec
pts1 -> do
{-# LINE 164 "libraries/unix/System/Posix/Unistd.hsc" #-}
allocaBytes (16) $ \pts2 -> do
{-# LINE 165 "libraries/unix/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 169 "libraries/unix/System/Posix/Unistd.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) pts1 tv_nsec
{-# LINE 170 "libraries/unix/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 177 "libraries/unix/System/Posix/Unistd.hsc" #-}
tv_nsec' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) pts2
{-# LINE 178 "libraries/unix/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 187 "libraries/unix/System/Posix/Unistd.hsc" #-}
data SysVar = ArgumentLimit
| ChildLimit
| ClockTick
| GroupLimit
| OpenFileLimit
| PosixVersion
| HasSavedIDs
| HasJobControl
getSysVar :: SysVar -> IO Integer
getSysVar :: SysVar -> IO Integer
getSysVar SysVar
v =
case SysVar
v of
SysVar
ArgumentLimit -> CInt -> IO Integer
sysconf (CInt
0)
{-# LINE 205 "libraries/unix/System/Posix/Unistd.hsc" #-}
ChildLimit -> sysconf (1)
{-# LINE 206 "libraries/unix/System/Posix/Unistd.hsc" #-}
ClockTick -> sysconf (2)
{-# LINE 207 "libraries/unix/System/Posix/Unistd.hsc" #-}
GroupLimit -> sysconf (3)
{-# LINE 208 "libraries/unix/System/Posix/Unistd.hsc" #-}
OpenFileLimit -> sysconf (4)
{-# LINE 209 "libraries/unix/System/Posix/Unistd.hsc" #-}
PosixVersion -> sysconf (29)
{-# LINE 210 "libraries/unix/System/Posix/Unistd.hsc" #-}
HasSavedIDs -> sysconf (8)
{-# LINE 211 "libraries/unix/System/Posix/Unistd.hsc" #-}
HasJobControl -> sysconf (7)
{-# LINE 212 "libraries/unix/System/Posix/Unistd.hsc" #-}
sysconf :: CInt -> IO Integer
sysconf :: CInt -> IO Integer
sysconf CInt
n = do
CLong
r <- String -> IO CLong -> IO CLong
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"getSysVar" (CInt -> IO CLong
c_sysconf CInt
n)
Integer -> IO Integer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
r)
foreign import ccall unsafe "sysconf"
c_sysconf :: CInt -> IO CLong
fileSynchronise :: Fd -> IO ()
{-# LINE 233 "libraries/unix/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 244 "libraries/unix/System/Posix/Unistd.hsc" #-}
fileSynchroniseDataOnly :: Fd -> IO ()
{-# LINE 254 "libraries/unix/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 265 "libraries/unix/System/Posix/Unistd.hsc" #-}