PortableIO.hs

{-# LANGUAGE CPP, RecordWildCards #-}
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)

{- For the reimplementation of handleToFd from System.Posix.IO -}
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

-- Opens, and possibly creates, the given file for writing
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 ({- _O_BINARY -} 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

-- Previously this was a ccall to '_open' in 'io.h'
-- TODO could this implementation work for the Unix version?
openWritableFile fp = openFile fp WriteMode >>= handleToFd

stdInput = 0
stdOutput = 1
stdError = 2

{- Copied from System.Posix.IO -}
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
  -- for a DuplexHandle, make sure we mark both sides as closed,
  -- otherwise a finalizer will come along later and close the other
  -- side. (#3914)

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
     -- converting a Handle into an Fd effectively means
     -- letting go of the Handle; it is put into a closed
     -- state as a result.
     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