module IdeSession.Util.PortableIO where
import System.IO (Handle, IOMode(..))
#ifdef VERSION_unix
import System.Posix.Types (Fd)
import qualified System.Posix.IO as Posix
import System.Posix.Files
#else
import Foreign.C.Error (throwErrnoIfMinus1_, throwErrnoIfMinus1)
import Foreign.C.Types (CInt(..), CUInt(..))
import Foreign.Ptr (Ptr)
import Foreign.Marshal.Array (allocaArray)
import Foreign.Storable (peek, peekElemOff)
import GHC.IO.FD (mkFD)
import GHC.IO.Device (IODeviceType(Stream))
import GHC.IO.Handle.FD (mkHandleFromFD)
import System.IO (openFile)
import System.IO.Error
import GHC.IO.Handle.Internals
import GHC.IO.Handle.Types hiding (Handle)
import qualified GHC.IO.FD as FD
import GHC.IO.Exception
import Data.Typeable (cast)
#endif
#ifdef VERSION_unix
type FileDescriptor = Fd
#else
type FileDescriptor = CInt
#endif
createPipe :: IO (FileDescriptor, FileDescriptor)
fdToHandle :: FileDescriptor -> IOMode -> IO Handle
handleToFd :: Handle -> IO FileDescriptor
closeFd :: FileDescriptor -> IO ()
dup :: FileDescriptor -> IO FileDescriptor
dupTo :: FileDescriptor -> FileDescriptor -> IO FileDescriptor
openWritableFile :: FilePath -> IO FileDescriptor
stdInput, stdOutput, stdError :: FileDescriptor
#ifdef VERSION_unix
createPipe = Posix.createPipe
fdToHandle fd _ = Posix.fdToHandle fd
handleToFd = Posix.handleToFd
closeFd = Posix.closeFd
dup = Posix.dup
dupTo = Posix.dupTo
openWritableFile fp = Posix.openFd fp Posix.WriteOnly (Just mode) Posix.defaultFileFlags
where
mode = unionFileModes ownerReadMode ownerWriteMode
stdInput = Posix.stdInput
stdOutput = Posix.stdOutput
stdError = Posix.stdError
#else
createPipe = allocaArray 2 $ \pfds -> do
throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 ( 32768)
readfd <- peek pfds
writefd <- peekElemOff pfds 1
return (readfd, writefd)
fdToHandle fd mode = do
(fd', deviceType) <- mkFD fd mode (Just (Stream, 0, 0)) False False
mkHandleFromFD fd' deviceType "" mode False Nothing
closeFd = throwErrnoIfMinus1_ "_close" . c__close
dup = throwErrnoIfMinus1 "_dup" . c__dup
dupTo fd1 fd2 = throwErrnoIfMinus1 "_dup2" $ c__dup2 fd1 fd2
openWritableFile fp = openFile fp WriteMode >>= handleToFd
stdInput = 0
stdOutput = 1
stdError = 2
handleToFd h@(FileHandle _ m) =
withHandle' "handleToFd" h m $ handleToFd' h
handleToFd h@(DuplexHandle _ r w) = do
_ <- withHandle' "handleToFd" h r $ handleToFd' h
withHandle' "handleToFd" h w $ handleToFd' h
handleToFd' :: Handle -> Handle__ -> IO (Handle__, FileDescriptor)
handleToFd' h h_@Handle__{haType=_,..} =
case cast haDevice of
Nothing -> ioError (ioeSetErrorString (mkIOError IllegalOperation
"handleToFd" (Just h) Nothing)
"handle is not a file descriptor")
Just fd -> do
flushWriteBuffer h_
FD.release fd
return (Handle__{haType=ClosedHandle,..}, FD.fdFD fd)
foreign import ccall "io.h _pipe" c__pipe ::
Ptr CInt -> CUInt -> CInt -> IO CInt
foreign import ccall "io.h _close" c__close ::
CInt -> IO CInt
foreign import ccall "io.h _dup" c__dup ::
CInt -> IO CInt
foreign import ccall "io.h _dup2" c__dup2 ::
CInt -> CInt -> IO CInt
#endif