{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module System.PosixCompat.Temp (
mkstemp
) where
#ifndef mingw32_HOST_OS
import System.Posix.Temp
#elif defined(__GLASGOW_HASKELL__)
import System.IO (Handle)
import Foreign.C (CInt(..), CString, withCString, peekCString, throwErrnoIfMinus1)
import GHC.IO.Handle.FD (fdToHandle)
mkstemp :: String -> IO (FilePath, Handle)
mkstemp template = do
withCString template $ \ ptr -> do
fd <- throwErrnoIfMinus1 "mkstemp" (c_mkstemp ptr)
name <- peekCString ptr
h <- fdToHandle (fromIntegral fd)
return (name, h)
foreign import ccall unsafe "unixcompat_mkstemp"
c_mkstemp :: CString -> IO CInt
#else
import System.IO (Handle)
import System.IO.Error (mkIOError, illegalOperationErrorType)
mkstemp :: String -> IO (FilePath, Handle)
mkstemp _ = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
where
x = "System.PosixCompat.Temp.mkstemp: not supported"
#endif