{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module System.PosixCompat.Unistd (
SystemID(..)
, getSystemID
, sleep
, usleep
, nanosleep
) where
#ifndef mingw32_HOST_OS
import System.Posix.Unistd
#else
import Control.Concurrent (threadDelay)
import Foreign.C.String (CString, peekCString)
import Foreign.C.Types (CInt(..), CSize(..))
import Foreign.Marshal.Array (allocaArray)
data SystemID = SystemID {
systemName :: String
, nodeName :: String
, release :: String
, version :: String
, machine :: String
} deriving (Eq, Read, Show)
getSystemID :: IO SystemID
getSystemID = do
let bufSize = 256
let call f = allocaArray bufSize $ \buf -> do
ok <- f buf (fromIntegral bufSize)
if ok == 1
then peekCString buf
else return ""
display <- call c_os_display_string
vers <- call c_os_version_string
arch <- call c_os_arch_string
node <- call c_os_node_name
return SystemID {
systemName = "Windows"
, nodeName = node
, release = display
, version = vers
, machine = arch
}
sleep :: Int -> IO Int
sleep secs = threadDelay (secs * 1000000) >> return 0
usleep :: Int -> IO ()
usleep = threadDelay
nanosleep :: Integer -> IO ()
nanosleep nsecs = threadDelay (round (fromIntegral nsecs / 1000 :: Double))
foreign import ccall "unixcompat_os_display_string"
c_os_display_string :: CString -> CSize -> IO CInt
foreign import ccall "unixcompat_os_version_string"
c_os_version_string :: CString -> CSize -> IO CInt
foreign import ccall "unixcompat_os_arch_string"
c_os_arch_string :: CString -> CSize -> IO CInt
foreign import ccall "unixcompat_os_node_name"
c_os_node_name :: CString -> CSize -> IO CInt
#endif