    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  System.IO
    -- Copyright   :  (c) The University of Glasgow 2001
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  libraries@haskell.org
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- The standard IO library.
    --
    -----------------------------------------------------------------------------

    module System.IO (
        -- * The IO monad

        IO,
        fixIO,

        -- * Files and handles

        FilePath,

        Handle,             -- abstract, instance of: Eq, Show.

        -- | GHC note: a 'Handle' will be automatically closed when the garbage
        -- collector detects that it has become unreferenced by the program.
        -- However, relying on this behaviour is not generally recommended:
        -- the garbage collector is unpredictable.  If possible, use
        -- an explicit 'hClose' to close 'Handle's when they are no longer
        -- required.  GHC does not currently attempt to free up file
        -- descriptors when they have run out, it is your responsibility to
        -- ensure that this doesn't happen.

        -- ** Standard handles

        -- | Three handles are allocated during program initialisation,
        -- and are initially open.

        stdin, stdout, stderr,

        -- * Opening and closing files

        -- ** Opening files

        withFile,
        openFile,
        IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),

        -- ** Closing files

        hClose,

        -- ** Special cases

        -- | These functions are also exported by the "Prelude".

        readFile,
        readFile',
        writeFile,
        appendFile,

        -- ** File locking

        -- $locking

        -- * Operations on handles

        -- ** Determining and changing the size of a file

        hFileSize,
        hSetFileSize,

        -- ** Detecting the end of input

        hIsEOF,
        isEOF,

        -- ** Buffering operations

        BufferMode(NoBuffering,LineBuffering,BlockBuffering),
        hSetBuffering,
        hGetBuffering,
        hFlush,

        -- ** Repositioning handles

        hGetPosn,
        hSetPosn,
        HandlePosn,                -- abstract, instance of: Eq, Show.

        hSeek,
        SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
        hTell,

        -- ** Handle properties

        hIsOpen, hIsClosed,
        hIsReadable, hIsWritable,
        hIsSeekable,

        -- ** Terminal operations (not portable: GHC only)

        hIsTerminalDevice,

        hSetEcho,
        hGetEcho,

        -- ** Showing handle state (not portable: GHC only)

        hShow,

        -- * Text input and output

        -- ** Text input

        hWaitForInput,
        hReady,
        hGetChar,
        hGetLine,
        hLookAhead,
        hGetContents,
        hGetContents',

        -- ** Text output

        hPutChar,
        hPutStr,
        hPutStrLn,
        hPrint,

        -- ** Special cases for standard input and output

        -- | These functions are also exported by the "Prelude".

        interact,
        putChar,
        putStr,
        putStrLn,
        print,
        getChar,
        getLine,
        getContents,
        getContents',
        readIO,
        readLn,

        -- * Binary input and output

        withBinaryFile,
        openBinaryFile,
        hSetBinaryMode,
        hPutBuf,
        hGetBuf,
        hGetBufSome,
        hPutBufNonBlocking,
        hGetBufNonBlocking,

        -- * Temporary files

        openTempFile,
        openBinaryTempFile,
        openTempFileWithDefaultPermissions,
        openBinaryTempFileWithDefaultPermissions,

        -- * Unicode encoding\/decoding

        -- | A text-mode 'Handle' has an associated 'TextEncoding', which
        -- is used to decode bytes into Unicode characters when reading,
        -- and encode Unicode characters into bytes when writing.
        --
        -- The default 'TextEncoding' is the same as the default encoding
        -- on your system, which is also available as 'localeEncoding'.
        -- (GHC note: on Windows, we currently do not support double-byte
        -- encodings; if the console\'s code page is unsupported, then
        -- 'localeEncoding' will be 'latin1'.)
        --
        -- Encoding and decoding errors are always detected and reported,
        -- except during lazy I/O ('hGetContents', 'getContents', and
        -- 'readFile'), where a decoding error merely results in
        -- termination of the character stream, as with other I/O errors.

        hSetEncoding,
        hGetEncoding,

        -- ** Unicode encodings
        TextEncoding,
        latin1,
        utf8, utf8_bom,
        utf16, utf16le, utf16be,
        utf32, utf32le, utf32be,
        localeEncoding,
        char8,
        mkTextEncoding,

        -- * Newline conversion

        -- | In Haskell, a newline is always represented by the character
        -- @\'\\n\'@.  However, in files and external character streams, a
        -- newline may be represented by another character sequence, such
        -- as @\'\\r\\n\'@.
        --
        -- A text-mode 'Handle' has an associated 'NewlineMode' that
        -- specifies how to translate newline characters.  The
        -- 'NewlineMode' specifies the input and output translation
        -- separately, so that for instance you can translate @\'\\r\\n\'@
        -- to @\'\\n\'@ on input, but leave newlines as @\'\\n\'@ on output.
        --
        -- The default 'NewlineMode' for a 'Handle' is
        -- 'nativeNewlineMode', which does no translation on Unix systems,
        -- but translates @\'\\r\\n\'@ to @\'\\n\'@ and back on Windows.
        --
        -- Binary-mode 'Handle's do no newline translation at all.
        --
        hSetNewlineMode,
        Newline(..), nativeNewline,
        NewlineMode(..),
        noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
      ) where

    import Control.Exception.Base

    import Data.Bits
    import Data.Maybe
    import Foreign.C.Error
    #if defined(mingw32_HOST_OS)
    import Foreign.C.String
    import Foreign.Ptr
    import Foreign.Marshal.Alloc
    import Foreign.Marshal.Utils (with)
    import Foreign.Storable
    import GHC.IO.SubSystem
    import GHC.IO.Windows.Handle (openFileAsTemp)
    import GHC.IO.Handle.Windows (mkHandleFromHANDLE)
    import GHC.IO.Device as IODevice
    import GHC.Real (fromIntegral)
    #endif
    import Foreign.C.Types
    import System.Posix.Internals
    import System.Posix.Types

    import GHC.Base
    import GHC.List
    #if !defined(mingw32_HOST_OS)
    import GHC.IORef
    #endif
    import GHC.Num
    import GHC.IO hiding ( bracket, onException )
    import GHC.IO.IOMode
    import qualified GHC.IO.FD as FD
    import GHC.IO.Handle
    import qualified GHC.IO.Handle.FD as POSIX
    import GHC.IO.Handle.Text ( hGetBufSome, hPutStrLn )
    import GHC.IO.Exception ( userError )
    import GHC.IO.Encoding
    import Text.Read
    import GHC.IO.StdHandles
    import GHC.Show
    import GHC.MVar

    -- -----------------------------------------------------------------------------
    -- Standard IO

    -- | Write a character to the standard output device
    -- (same as 'hPutChar' 'stdout').

    putChar         :: Char -> IO ()
    putChar :: Char -> IO ()
    putChar Char
    c       =  Handle -> Char -> IO ()
    hPutChar Handle
    stdout Char
    c

    -- | Write a string to the standard output device
    -- (same as 'hPutStr' 'stdout').

    putStr          :: String -> IO ()
    putStr :: String -> IO ()
    putStr String
    s        =  Handle -> String -> IO ()
    hPutStr Handle
    stdout String
    s

    -- | The same as 'putStr', but adds a newline character.

    putStrLn        :: String -> IO ()
    putStrLn :: String -> IO ()
    putStrLn String
    s      =  Handle -> String -> IO ()
    hPutStrLn Handle
    stdout String
    s

    -- | The 'print' function outputs a value of any printable type to the
    -- standard output device.
    -- Printable types are those that are instances of class 'Show'; 'print'
    -- converts values to strings for output using the 'show' operation and
    -- adds a newline.
    --
    -- For example, a program to print the first 20 integers and their
    -- powers of 2 could be written as:
    --
    -- > main = print ([(n, 2^n) | n <- [0..19]])

    print           :: Show a => a -> IO ()
    print :: forall a. Show a => a -> IO ()
    print a
    x         =  String -> IO ()
    putStrLn (a -> String
    forall a. Show a => a -> String
    show a
    x)

    -- | Read a character from the standard input device
    -- (same as 'hGetChar' 'stdin').

    getChar         :: IO Char
    getChar :: IO Char
    getChar         =  Handle -> IO Char
    hGetChar Handle
    stdin

    -- | Read a line from the standard input device
    -- (same as 'hGetLine' 'stdin').

    getLine         :: IO String
    getLine :: IO String
    getLine         =  Handle -> IO String
    hGetLine Handle
    stdin

    -- | The 'getContents' operation returns all user input as a single string,
    -- which is read lazily as it is needed
    -- (same as 'hGetContents' 'stdin').

    getContents     :: IO String
    getContents :: IO String
    getContents     =  Handle -> IO String
    hGetContents Handle
    stdin

    -- | The 'getContents'' operation returns all user input as a single string,
    -- which is fully read before being returned
    -- (same as 'hGetContents'' 'stdin').
    --
    -- @since 4.15.0.0

    getContents'    :: IO String
    getContents' :: IO String
    getContents'    =  Handle -> IO String
    hGetContents' Handle
    stdin

    -- | The 'interact' function takes a function of type @String->String@
    -- as its argument.  The entire input from the standard input device is
    -- passed to this function as its argument, and the resulting string is
    -- output on the standard output device.

    interact        ::  (String -> String) -> IO ()
    interact :: (String -> String) -> IO ()
    interact String -> String
    f      =   do String
    s <- IO String
    getContents
                           String -> IO ()
    putStr (String -> String
    f String
    s)

    -- | The 'readFile' function reads a file and
    -- returns the contents of the file as a string.
    -- The file is read lazily, on demand, as with 'getContents'.

    readFile        :: FilePath -> IO String
    readFile :: String -> IO String
    readFile String
    name   =  String -> IOMode -> IO Handle
    openFile String
    name IOMode
    ReadMode IO Handle -> (Handle -> IO String) -> IO String
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Handle -> IO String
    hGetContents

    -- | The 'readFile'' function reads a file and
    -- returns the contents of the file as a string.
    -- The file is fully read before being returned, as with 'getContents''.
    --
    -- @since 4.15.0.0

    readFile'       :: FilePath -> IO String
    -- There's a bit of overkill here—both withFile and
    -- hGetContents' will close the file in the end.
    readFile' :: String -> IO String
    readFile' String
    name  =  String -> IOMode -> (Handle -> IO String) -> IO String
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withFile String
    name IOMode
    ReadMode Handle -> IO String
    hGetContents'

    -- | The computation 'writeFile' @file str@ function writes the string @str@,
    -- to the file @file@.
    writeFile :: FilePath -> String -> IO ()
    writeFile :: String -> String -> IO ()
    writeFile String
    f String
    txt = String -> IOMode -> (Handle -> IO ()) -> IO ()
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withFile String
    f IOMode
    WriteMode (\ Handle
    hdl -> Handle -> String -> IO ()
    hPutStr Handle
    hdl String
    txt)

    -- | The computation 'appendFile' @file str@ function appends the string @str@,
    -- to the file @file@.
    --
    -- Note that 'writeFile' and 'appendFile' write a literal string
    -- to a file.  To write a value of any printable type, as with 'print',
    -- use the 'show' function to convert the value to a string first.
    --
    -- > main = appendFile "squares" (show [(x,x*x) | x <- [0,0.1..2]])

    appendFile      :: FilePath -> String -> IO ()
    appendFile :: String -> String -> IO ()
    appendFile String
    f String
    txt = String -> IOMode -> (Handle -> IO ()) -> IO ()
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withFile String
    f IOMode
    AppendMode (\ Handle
    hdl -> Handle -> String -> IO ()
    hPutStr Handle
    hdl String
    txt)

    -- | The 'readLn' function combines 'getLine' and 'readIO'.

    readLn :: Read a => IO a
    readLn :: forall a. Read a => IO a
    readLn = IO String
    getLine IO String -> (String -> IO a) -> IO a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> IO a
    forall a. Read a => String -> IO a
    readIO

    -- | The 'readIO' function is similar to 'read' except that it signals
    -- parse failure to the 'IO' monad instead of terminating the program.

    readIO          :: Read a => String -> IO a
    readIO :: forall a. Read a => String -> IO a
    readIO String
    s        =  case (do { (a
    x,String
    t) <- ReadS a
    forall a. Read a => ReadS a
    reads String
    s ;
                                  (String
    "",String
    "") <- ReadS String
    lex String
    t ;
                                  a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x }) of
                            [a
    x]    -> a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
                            []     -> IOError -> IO a
    forall a. IOError -> IO a
    ioError (String -> IOError
    userError String
    "Prelude.readIO: no parse")
                            [a]
    _      -> IOError -> IO a
    forall a. IOError -> IO a
    ioError (String -> IOError
    userError String
    "Prelude.readIO: ambiguous parse")

    -- | The Unicode encoding of the current locale
    --
    -- This is the initial locale encoding: if it has been subsequently changed by
    -- 'GHC.IO.Encoding.setLocaleEncoding' this value will not reflect that change.
    localeEncoding :: TextEncoding
    localeEncoding :: TextEncoding
    localeEncoding = TextEncoding
    initLocaleEncoding

    -- | Computation 'hReady' @hdl@ indicates whether at least one item is
    -- available for input from handle @hdl@.
    --
    -- This operation may fail with:
    --
    --  * 'System.IO.Error.isEOFError' if the end of file has been reached.

    hReady          :: Handle -> IO Bool
    hReady :: Handle -> IO Bool
    hReady Handle
    h        =  Handle -> Int -> IO Bool
    hWaitForInput Handle
    h Int
    0

    -- | Computation 'hPrint' @hdl t@ writes the string representation of @t@
    -- given by the 'shows' function to the file or channel managed by @hdl@
    -- and appends a newline.
    --
    -- This operation may fail with:
    --
    --  * 'System.IO.Error.isFullError' if the device is full; or
    --
    --  * 'System.IO.Error.isPermissionError' if another system resource limit
    --    would be exceeded.

    hPrint          :: Show a => Handle -> a -> IO ()
    hPrint :: forall a. Show a => Handle -> a -> IO ()
    hPrint Handle
    hdl      =  Handle -> String -> IO ()
    hPutStrLn Handle
    hdl (String -> IO ()) -> (a -> String) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show

    -- ---------------------------------------------------------------------------
    -- fixIO

    -- | The implementation of 'Control.Monad.Fix.mfix' for 'IO'. If the function
    -- passed to 'fixIO' inspects its argument, the resulting action will throw
    -- 'FixIOException'.
    fixIO :: (a -> IO a) -> IO a
    fixIO :: forall a. (a -> IO a) -> IO a
    fixIO a -> IO a
    k = do
        MVar a
    m <- IO (MVar a)
    forall a. IO (MVar a)
    newEmptyMVar
        a
    ans <- IO a -> IO a
    forall a. IO a -> IO a
    unsafeDupableInterleaveIO
                 (MVar a -> IO a
    forall a. MVar a -> IO a
    readMVar MVar a
    m IO a -> (BlockedIndefinitelyOnMVar -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \BlockedIndefinitelyOnMVar
    BlockedIndefinitelyOnMVar ->
                                        FixIOException -> IO a
    forall e a. Exception e => e -> IO a
    throwIO FixIOException
    FixIOException)
        a
    result <- a -> IO a
    k a
    ans
        MVar a -> a -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar a
    m a
    result
        a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    result

    -- Note [Blackholing in fixIO]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- We do our own explicit black holing here, because GHC's lazy
    -- blackholing isn't enough.  In an infinite loop, GHC may run the IO
    -- computation a few times before it notices the loop, which is wrong.
    --
    -- NOTE2: the explicit black-holing with an IORef ran into trouble
    -- with multiple threads (see #5421), so now we use an MVar. We used
    -- to use takeMVar with unsafeInterleaveIO. This, however, uses noDuplicate#,
    -- which is not particularly cheap. Better to use readMVar, which can be
    -- performed in multiple threads safely, and to use unsafeDupableInterleaveIO
    -- to avoid the noDuplicate cost.
    --
    -- What we'd ideally want is probably an IVar, but we don't quite have those.
    -- STM TVars look like an option at first, but I don't think they are:
    -- we'd need to be able to write to the variable in an IO context, which can
    -- only be done using 'atomically', and 'atomically' is not allowed within
    -- unsafePerformIO. We can't know if someone will try to use the result
    -- of fixIO with unsafePerformIO!
    --
    -- See also System.IO.Unsafe.unsafeFixIO.
    --

    -- | The function creates a temporary file in ReadWrite mode.
    -- The created file isn\'t deleted automatically, so you need to delete it manually.
    --
    -- The file is created with permissions such that only the current
    -- user can read\/write it.
    --
    -- With some exceptions (see below), the file will be created securely
    -- in the sense that an attacker should not be able to cause
    -- openTempFile to overwrite another file on the filesystem using your
    -- credentials, by putting symbolic links (on Unix) in the place where
    -- the temporary file is to be created.  On Unix the @O_CREAT@ and
    -- @O_EXCL@ flags are used to prevent this attack, but note that
    -- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you
    -- rely on this behaviour it is best to use local filesystems only.
    --
    openTempFile :: FilePath   -- ^ Directory in which to create the file
                 -> String     -- ^ File name template. If the template is \"foo.ext\" then
                               -- the created file will be \"fooXXX.ext\" where XXX is some
                               -- random number. Note that this should not contain any path
                               -- separator characters.
                 -> IO (FilePath, Handle)
    openTempFile :: String -> String -> IO (String, Handle)
    openTempFile String
    tmp_dir String
    template
        = String -> String -> String -> Bool -> CMode -> IO (String, Handle)
    openTempFile' String
    "openTempFile" String
    tmp_dir String
    template Bool
    False CMode
    0o600

    -- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
    openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
    openBinaryTempFile :: String -> String -> IO (String, Handle)
    openBinaryTempFile String
    tmp_dir String
    template
        = String -> String -> String -> Bool -> CMode -> IO (String, Handle)
    openTempFile' String
    "openBinaryTempFile" String
    tmp_dir String
    template Bool
    True CMode
    0o600

    -- | Like 'openTempFile', but uses the default file permissions
    openTempFileWithDefaultPermissions :: FilePath -> String
                                       -> IO (FilePath, Handle)
    openTempFileWithDefaultPermissions :: String -> String -> IO (String, Handle)
    openTempFileWithDefaultPermissions String
    tmp_dir String
    template
        = String -> String -> String -> Bool -> CMode -> IO (String, Handle)
    openTempFile' String
    "openTempFileWithDefaultPermissions" String
    tmp_dir String
    template Bool
    False CMode
    0o666

    -- | Like 'openBinaryTempFile', but uses the default file permissions
    openBinaryTempFileWithDefaultPermissions :: FilePath -> String
                                             -> IO (FilePath, Handle)
    openBinaryTempFileWithDefaultPermissions :: String -> String -> IO (String, Handle)
    openBinaryTempFileWithDefaultPermissions String
    tmp_dir String
    template
        = String -> String -> String -> Bool -> CMode -> IO (String, Handle)
    openTempFile' String
    "openBinaryTempFileWithDefaultPermissions" String
    tmp_dir String
    template Bool
    True CMode
    0o666

    openTempFile' :: String -> FilePath -> String -> Bool -> CMode
                  -> IO (FilePath, Handle)
    openTempFile' :: String -> String -> String -> Bool -> CMode -> IO (String, Handle)
    openTempFile' String
    loc String
    tmp_dir String
    template Bool
    binary CMode
    mode
        | String -> Bool
    pathSeparator String
    template
        = String -> IO (String, Handle)
    forall a. String -> IO a
    failIO (String -> IO (String, Handle)) -> String -> IO (String, Handle)
    forall a b. (a -> b) -> a -> b
    $ String
    "openTempFile': Template string must not contain path separator characters: "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    template
        | Bool
    otherwise = IO (String, Handle)
    findTempName
      where
        -- We split off the last extension, so we can use .foo.ext files
        -- for temporary files (hidden on Unix OSes). Unfortunately we're
        -- below filepath in the hierarchy here.
        (String
    prefix, String
    suffix) =
           case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.') (String -> (String, String)) -> String -> (String, String)
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. [a] -> [a]
    reverse String
    template of
             -- First case: template contains no '.'s. Just re-reverse it.
             (String
    rev_suffix, String
    "")       -> (String -> String
    forall a. [a] -> [a]
    reverse String
    rev_suffix, String
    "")
             -- Second case: template contains at least one '.'. Strip the
             -- dot from the prefix and prepend it to the suffix (if we don't
             -- do this, the unique number will get added after the '.' and
             -- thus be part of the extension, which is wrong.)
             (String
    rev_suffix, Char
    '.':String
    rest) -> (String -> String
    forall a. [a] -> [a]
    reverse String
    rest, Char
    '.'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String -> String
    forall a. [a] -> [a]
    reverse String
    rev_suffix)
             -- Otherwise, something is wrong, because (break (== '.')) should
             -- always return a pair with either the empty string or a string
             -- beginning with '.' as the second component.
             (String, String)
    _                      -> String -> (String, String)
    forall a. String -> a
    errorWithoutStackTrace String
    "bug in System.IO.openTempFile"
    #if defined(mingw32_HOST_OS)
        findTempName = findTempNamePosix <!> findTempNameWinIO

        findTempNameWinIO = do
          let label = if null prefix then "ghc" else prefix
          withCWString tmp_dir $ \c_tmp_dir ->
            withCWString label $ \c_template ->
              withCWString suffix $ \c_suffix ->
                with nullPtr $ \c_ptr -> do
                  res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr
                  if not res
                     then do errno <- getErrno
                             ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
                     else do c_p <- peek c_ptr
                             filename <- peekCWString c_p
                             free c_p
                             let flags = fromIntegral mode .&. o_EXCL
                             handleResultsWinIO filename (flags == o_EXCL)

        findTempNamePosix = do
          let label = if null prefix then "ghc" else prefix
          withCWString tmp_dir $ \c_tmp_dir ->
            withCWString label $ \c_template ->
              withCWString suffix $ \c_suffix ->
                allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \c_str -> do
                res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0
                                                c_str
                if not res
                   then do errno <- getErrno
                           ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
                   else do filename <- peekCWString c_str
                           handleResultsPosix filename

        handleResultsPosix filename = do
          let oflags1 = rw_flags .|. o_EXCL
              binary_flags
                  | binary    = o_BINARY
                  | otherwise = 0
              oflags = oflags1 .|. binary_flags
          fd <- withFilePath filename $ \ f -> c_open f oflags mode
          case fd < 0 of
            True -> do errno <- getErrno
                       ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
            False ->
              do (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
                                         False{-is_socket-}
                                         True{-is_nonblock-}

                 enc <- getLocaleEncoding
                 h <- POSIX.mkHandleFromFD fD fd_type filename ReadWriteMode
                                     False{-set non-block-} (Just enc)

                 return (filename, h)

        handleResultsWinIO filename excl = do
          (hwnd, hwnd_type) <- openFileAsTemp filename True excl
          mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding

          -- then use it to make a Handle
          h <- mkHandleFromHANDLE hwnd hwnd_type filename ReadWriteMode mb_codec
                    `onException` IODevice.close hwnd
          return (filename, h)

    foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo
      :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool

    foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo
      :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool

    pathSeparator :: String -> Bool
    pathSeparator template = any (\x-> x == '/' || x == '\\') template

    output_flags = std_flags
    #else /* else mingw32_HOST_OS */
        findTempName :: IO (String, Handle)
    findTempName = do
          String
    rs <- IO String
    rand_string
          let filename :: String
    filename = String
    prefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    rs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    suffix
              filepath :: String
    filepath = String
    tmp_dir String -> String -> String
    `combine` String
    filename
          OpenNewFileResult
    r <- String -> Bool -> CMode -> IO OpenNewFileResult
    openNewFile String
    filepath Bool
    binary CMode
    mode
          case OpenNewFileResult
    r of
            OpenNewFileResult
    FileExists -> IO (String, Handle)
    findTempName
            OpenNewError Errno
    errno -> IOError -> IO (String, Handle)
    forall a. IOError -> IO a
    ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
    errnoToIOError String
    loc Errno
    errno Maybe Handle
    forall a. Maybe a
    Nothing (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    tmp_dir))
            NewFileCreated CInt
    fd -> do
              (FD
    fD,IODeviceType
    fd_type) <- CInt
    -> IOMode
    -> Maybe (IODeviceType, CDev, CIno)
    -> Bool
    -> Bool
    -> IO (FD, IODeviceType)
    FD.mkFD CInt
    fd IOMode
    ReadWriteMode Maybe (IODeviceType, CDev, CIno)
    forall a. Maybe a
    Nothing{-no stat-}
                                   Bool
    False{-is_socket-}
                                   Bool
    True{-is_nonblock-}

              TextEncoding
    enc <- IO TextEncoding
    getLocaleEncoding
              Handle
    h <- FD
    -> IODeviceType
    -> String
    -> IOMode
    -> Bool
    -> Maybe TextEncoding
    -> IO Handle
    POSIX.mkHandleFromFD FD
    fD IODeviceType
    fd_type String
    filepath IOMode
    ReadWriteMode Bool
    False{-set non-block-} (TextEncoding -> Maybe TextEncoding
    forall a. a -> Maybe a
    Just TextEncoding
    enc)

              (String, Handle) -> IO (String, Handle)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    filepath, Handle
    h)

          where
            -- XXX bits copied from System.FilePath, since that's not available here
            combine :: String -> String -> String
    combine String
    a String
    b
                      | String -> Bool
    forall a. [a] -> Bool
    null String
    b = String
    a
                      | String -> Bool
    forall a. [a] -> Bool
    null String
    a = String
    b
                      | String -> Bool
    pathSeparator [String -> Char
    forall a. [a] -> a
    last String
    a] = String
    a String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    b
                      | Bool
    otherwise = String
    a String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    pathSeparatorChar] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    b

    tempCounter :: IORef Int
    tempCounter :: IORef Int
    tempCounter = IO (IORef Int) -> IORef Int
    forall a. IO a -> a
    unsafePerformIO (IO (IORef Int) -> IORef Int) -> IO (IORef Int) -> IORef Int
    forall a b. (a -> b) -> a -> b
    $ Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef Int
    0
    {-# NOINLINE tempCounter #-}

    -- build large digit-alike number
    rand_string :: IO String
    rand_string :: IO String
    rand_string = do
      CPid
    r1 <- IO CPid
    c_getpid
      (Int
    r2, Int
    _) <- IORef Int -> (Int -> Int) -> IO (Int, Int)
    forall a. IORef a -> (a -> a) -> IO (a, a)
    atomicModifyIORef'_ IORef Int
    tempCounter (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
      String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ CPid -> String
    forall a. Show a => a -> String
    show CPid
    r1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    r2

    data OpenNewFileResult
      = NewFileCreated CInt
      | FileExists
      | OpenNewError Errno

    openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult
    openNewFile :: String -> Bool -> CMode -> IO OpenNewFileResult
    openNewFile String
    filepath Bool
    binary CMode
    mode = do
      let oflags1 :: CInt
    oflags1 = CInt
    rw_flags CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. CInt
    o_EXCL

          binary_flags :: CInt
    binary_flags
            | Bool
    binary    = CInt
    o_BINARY
            | Bool
    otherwise = CInt
    0

          oflags :: CInt
    oflags = CInt
    oflags1 CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. CInt
    binary_flags
      CInt
    fd <- String -> (CString -> IO CInt) -> IO CInt
    forall a. String -> (CString -> IO a) -> IO a
    withFilePath String
    filepath ((CString -> IO CInt) -> IO CInt)
    -> (CString -> IO CInt) -> IO CInt
    forall a b. (a -> b) -> a -> b
    $ \ CString
    f ->
              CString -> CInt -> CMode -> IO CInt
    c_open CString
    f CInt
    oflags CMode
    mode
      if CInt
    fd CInt -> CInt -> Bool
    forall a. Ord a => a -> a -> Bool
    < CInt
    0
        then do
          Errno
    errno <- IO Errno
    getErrno
          case Errno
    errno of
            Errno
    _ | Errno
    errno Errno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    == Errno
    eEXIST -> OpenNewFileResult -> IO OpenNewFileResult
    forall (m :: * -> *) a. Monad m => a -> m a
    return OpenNewFileResult
    FileExists
            Errno
    _ -> OpenNewFileResult -> IO OpenNewFileResult
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Errno -> OpenNewFileResult
    OpenNewError Errno
    errno)
        else OpenNewFileResult -> IO OpenNewFileResult
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CInt -> OpenNewFileResult
    NewFileCreated CInt
    fd)

    -- XXX Should use filepath library
    pathSeparatorChar :: Char
    pathSeparatorChar :: Char
    pathSeparatorChar = Char
    '/'

    pathSeparator :: String -> Bool
    pathSeparator :: String -> Bool
    pathSeparator String
    template = Char
    pathSeparatorChar Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    `elem` String
    template

    output_flags :: CInt
    output_flags = CInt
    std_flags    CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. CInt
    o_CREAT
    #endif /* mingw32_HOST_OS */

    -- XXX Copied from GHC.Handle
    std_flags, output_flags, rw_flags :: CInt
    std_flags :: CInt
    std_flags    = CInt
    o_NONBLOCK   CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. CInt
    o_NOCTTY
    rw_flags :: CInt
    rw_flags     = CInt
    output_flags CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. CInt
    o_RDWR

    -- $locking
    -- Implementations should enforce as far as possible, at least locally to the
    -- Haskell process, multiple-reader single-writer locking on files.
    -- That is, /there may either be many handles on the same file which manage input, or just one handle on the file which manages output/.  If any
    -- open or semi-closed handle is managing a file for output, no new
    -- handle can be allocated for that file.  If any open or semi-closed
    -- handle is managing a file for input, new handles can only be allocated
    -- if they do not manage output.  Whether two files are the same is
    -- implementation-dependent, but they should normally be the same if they
    -- have the same absolute path name and neither has been renamed, for
    -- example.
    --
    -- /Warning/: the 'readFile' operation holds a semi-closed handle on
    -- the file until the entire contents of the file have been consumed.
    -- It follows that an attempt to write to a file (using 'writeFile', for
    -- example) that was earlier opened by 'readFile' will usually result in
    -- failure with 'System.IO.Error.isAlreadyInUseError'.