(original) (raw)

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

module System.IO (

[IO](../../ghc-prim-0.8.0/src/GHC-Types.html#IO),
[fixIO](System.IO.html#fixIO),


[FilePath](GHC.IO.html#FilePath),

[Handle](GHC.IO.Handle.Types.html#Handle),             


[stdin](GHC.IO.StdHandles.html#stdin), [stdout](GHC.IO.StdHandles.html#stdout), [stderr](GHC.IO.StdHandles.html#stderr),


[withFile](GHC.IO.StdHandles.html#withFile),
[openFile](GHC.IO.StdHandles.html#openFile),
[IOMode](GHC.IO.IOMode.html#IOMode)([ReadMode](GHC.IO.IOMode.html#ReadMode),[WriteMode](GHC.IO.IOMode.html#WriteMode),[AppendMode](GHC.IO.IOMode.html#AppendMode),[ReadWriteMode](GHC.IO.IOMode.html#ReadWriteMode)),


[hClose](GHC.IO.Handle.html#hClose),


[readFile](System.IO.html#readFile),
[readFile'](System.IO.html#readFile%27),
[writeFile](System.IO.html#writeFile),
[appendFile](System.IO.html#appendFile),


[hFileSize](GHC.IO.Handle.html#hFileSize),
[hSetFileSize](GHC.IO.Handle.html#hSetFileSize),


[hIsEOF](GHC.IO.Handle.html#hIsEOF),
[isEOF](GHC.IO.Handle.html#isEOF),


[BufferMode](GHC.IO.Handle.Types.html#BufferMode)([NoBuffering](GHC.IO.Handle.Types.html#NoBuffering),[LineBuffering](GHC.IO.Handle.Types.html#LineBuffering),[BlockBuffering](GHC.IO.Handle.Types.html#BlockBuffering)),
[hSetBuffering](GHC.IO.Handle.html#hSetBuffering),
[hGetBuffering](GHC.IO.Handle.html#hGetBuffering),
[hFlush](GHC.IO.Handle.html#hFlush),


[hGetPosn](GHC.IO.Handle.html#hGetPosn),
[hSetPosn](GHC.IO.Handle.html#hSetPosn),
[HandlePosn](GHC.IO.Handle.html#HandlePosn),                

[hSeek](GHC.IO.Handle.html#hSeek),
[SeekMode](GHC.IO.Device.html#SeekMode)([AbsoluteSeek](GHC.IO.Device.html#AbsoluteSeek),[RelativeSeek](GHC.IO.Device.html#RelativeSeek),[SeekFromEnd](GHC.IO.Device.html#SeekFromEnd)),
[hTell](GHC.IO.Handle.html#hTell),


[hIsOpen](GHC.IO.Handle.html#hIsOpen), [hIsClosed](GHC.IO.Handle.html#hIsClosed),
[hIsReadable](GHC.IO.Handle.html#hIsReadable), [hIsWritable](GHC.IO.Handle.html#hIsWritable),
[hIsSeekable](GHC.IO.Handle.html#hIsSeekable),


[hIsTerminalDevice](GHC.IO.Handle.html#hIsTerminalDevice),

[hSetEcho](GHC.IO.Handle.html#hSetEcho),
[hGetEcho](GHC.IO.Handle.html#hGetEcho),


[hShow](GHC.IO.Handle.html#hShow),


[hWaitForInput](GHC.IO.Handle.Text.html#hWaitForInput),
[hReady](System.IO.html#hReady),
[hGetChar](GHC.IO.Handle.Text.html#hGetChar),
[hGetLine](GHC.IO.Handle.Text.html#hGetLine),
[hLookAhead](GHC.IO.Handle.html#hLookAhead),
[hGetContents](GHC.IO.Handle.Text.html#hGetContents),
[hGetContents'](GHC.IO.Handle.Text.html#hGetContents%27),


[hPutChar](GHC.IO.Handle.Text.html#hPutChar),
[hPutStr](GHC.IO.Handle.Text.html#hPutStr),
[hPutStrLn](GHC.IO.Handle.Text.html#hPutStrLn),
[hPrint](System.IO.html#hPrint),


[interact](System.IO.html#interact),
[putChar](System.IO.html#putChar),
[putStr](System.IO.html#putStr),
[putStrLn](System.IO.html#putStrLn),
[print](System.IO.html#print),
[getChar](System.IO.html#getChar),
[getLine](System.IO.html#getLine),
[getContents](System.IO.html#getContents),
[getContents'](System.IO.html#getContents%27),
[readIO](System.IO.html#readIO),
[readLn](System.IO.html#readLn),


[withBinaryFile](GHC.IO.StdHandles.html#withBinaryFile),
[openBinaryFile](GHC.IO.StdHandles.html#openBinaryFile),
[hSetBinaryMode](GHC.IO.Handle.html#hSetBinaryMode),
[hPutBuf](GHC.IO.Handle.Text.html#hPutBuf),
[hGetBuf](GHC.IO.Handle.Text.html#hGetBuf),
[hGetBufSome](GHC.IO.Handle.Text.html#hGetBufSome),
[hPutBufNonBlocking](GHC.IO.Handle.Text.html#hPutBufNonBlocking),
[hGetBufNonBlocking](GHC.IO.Handle.Text.html#hGetBufNonBlocking),


[openTempFile](System.IO.html#openTempFile),
[openBinaryTempFile](System.IO.html#openBinaryTempFile),
[openTempFileWithDefaultPermissions](System.IO.html#openTempFileWithDefaultPermissions),
[openBinaryTempFileWithDefaultPermissions](System.IO.html#openBinaryTempFileWithDefaultPermissions),


[hSetEncoding](GHC.IO.Handle.html#hSetEncoding),
[hGetEncoding](GHC.IO.Handle.html#hGetEncoding),


[TextEncoding](GHC.IO.Encoding.Types.html#TextEncoding),
[latin1](GHC.IO.Encoding.html#latin1),
[utf8](GHC.IO.Encoding.html#utf8), [utf8_bom](GHC.IO.Encoding.html#utf8%5Fbom),
[utf16](GHC.IO.Encoding.html#utf16), [utf16le](GHC.IO.Encoding.html#utf16le), [utf16be](GHC.IO.Encoding.html#utf16be),
[utf32](GHC.IO.Encoding.html#utf32), [utf32le](GHC.IO.Encoding.html#utf32le), [utf32be](GHC.IO.Encoding.html#utf32be),
[localeEncoding](System.IO.html#localeEncoding),
[char8](GHC.IO.Encoding.html#char8),
[mkTextEncoding](GHC.IO.Encoding.html#mkTextEncoding),


[hSetNewlineMode](GHC.IO.Handle.html#hSetNewlineMode),
[Newline](GHC.IO.Handle.Types.html#Newline)(..), [nativeNewline](GHC.IO.Handle.Types.html#nativeNewline),
[NewlineMode](GHC.IO.Handle.Types.html#NewlineMode)(..),
[noNewlineTranslation](GHC.IO.Handle.Types.html#noNewlineTranslation), [universalNewlineMode](GHC.IO.Handle.Types.html#universalNewlineMode), [nativeNewlineMode](GHC.IO.Handle.Types.html#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.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) import Foreign.Marshal.Utils (new) #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

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

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

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

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)

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

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

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

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

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)

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

readFile' :: FilePath -> IO String

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'

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)

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)

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

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")

localeEncoding :: TextEncoding localeEncoding :: TextEncoding localeEncoding = TextEncoding initLocaleEncoding

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

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 :: (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

openTempFile :: FilePath
-> String

         -> [IO](../../ghc-prim-0.8.0/src/GHC-Types.html#IO) ([FilePath](GHC.IO.html#FilePath), [Handle](GHC.IO.Handle.Types.html#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

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

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

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

(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

     (String

rev_suffix, String "") -> (String -> String forall a. [a] -> [a] reverse String rev_suffix, String "")

     (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)

     (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 -> do
        c_ptr <- new nullPtr
        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
                   handleResultsWinIO filename ((fromIntegral mode .&. o_EXCL) == 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
                                 False
                                 True

         enc <- getLocaleEncoding
         h <- POSIX.mkHandleFromFD fD fd_type filename ReadWriteMode
                             False (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

  
  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 Bool False Bool True

      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 (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
    
    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 #-}

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)

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 */

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