{-# 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.-------------------------------------------------------------------------------moduleSystem.IO(-- * The IO monadIO ,fixIO ,-- * Files and handlesFilePath ,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 fileswithFile ,openFile ,IOMode (ReadMode ,WriteMode ,AppendMode ,ReadWriteMode ),-- ** Closing fileshClose ,-- ** 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 filehFileSize ,hSetFileSize ,-- ** Detecting the end of inputhIsEOF ,isEOF ,-- ** Buffering operationsBufferMode (NoBuffering ,LineBuffering ,BlockBuffering ),hSetBuffering ,hGetBuffering ,hFlush ,-- ** Repositioning handleshGetPosn ,hSetPosn ,HandlePosn ,-- abstract, instance of: Eq, Show.hSeek ,SeekMode (AbsoluteSeek ,RelativeSeek ,SeekFromEnd ),hTell ,-- ** Handle propertieshIsOpen ,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 inputhWaitForInput ,hReady ,hGetChar ,hGetLine ,hLookAhead ,hGetContents ,hGetContents' ,-- ** Text outputhPutChar ,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 outputwithBinaryFile ,openBinaryFile ,hSetBinaryMode ,hPutBuf ,hGetBuf ,hGetBufSome ,hPutBufNonBlocking ,hGetBufNonBlocking ,-- * Temporary filesopenTempFile ,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 encodingsTextEncoding ,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 ,)whereimportControl.Exception.Base importData.Bits importData.Maybe importForeign.C.Error 
#if defined(mingw32_HOST_OS)
importForeign.C.StringimportForeign.PtrimportForeign.Marshal.AllocimportForeign.Marshal.Utils(with)importForeign.StorableimportGHC.IO.SubSystemimportGHC.IO.Windows.Handle(openFileAsTemp)importGHC.IO.Handle.Windows(mkHandleFromHANDLE)importGHC.IO.DeviceasIODeviceimportGHC.Real(fromIntegral)
#endif
importForeign.C.Types importSystem.Posix.Internals importSystem.Posix.Types importGHC.Base importGHC.List 
#if !defined(mingw32_HOST_OS)
importGHC.IORef 
#endif
importGHC.Num importGHC.IO hiding(bracket ,onException )importGHC.IO.IOMode importqualifiedGHC.IO.FD asFDimportGHC.IO.Handle importqualifiedGHC.IO.Handle.FD asPOSIXimportGHC.IO.Handle.Text (hGetBufSome ,hPutStrLn )importGHC.IO.Exception (userError )importGHC.IO.Encoding importText.Read importGHC.IO.StdHandles importGHC.Show importGHC.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.0getContents' ::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 =doString
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 a b. IO a -> (a -> IO b) -> IO b
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.0readFile' ::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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return a
x })of[a
x ]->a -> IO a
forall a. 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 =doMVar 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 a. 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. On Windows, the template prefix may-- be truncated to 3 chars, e.g. \"foobar.ext\" will be-- \"fooXXX.ext\".->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 permissionsopenTempFileWithDefaultPermissions ::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 permissionsopenBinaryTempFileWithDefaultPermissions ::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
0o666openTempFile' ::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<!>findTempNameWinIOfindTempNameWinIO=doletlabel=ifnullprefixthen"ghc"elseprefixwithCWStringtmp_dir$\c_tmp_dir->withCWStringlabel$\c_template->withCWStringsuffix$\c_suffix->withnullPtr$\c_ptr->dores<-c_createUUIDTempFileErrNoc_tmp_dirc_templatec_suffixc_ptrifnotresthendoerrno<-getErrnoioError(errnoToIOErrorlocerrnoNothing(Justtmp_dir))elsedoc_p<-peekc_ptrfilename<-peekCWStringc_pfreec_pletflags=fromIntegralmode.&.o_EXCLhandleResultsWinIOfilename(flags==o_EXCL)findTempNamePosix=doletlabel=ifnullprefixthen"ghc"elseprefixwithCWStringtmp_dir$\c_tmp_dir->withCWStringlabel$\c_template->withCWStringsuffix$\c_suffix->allocaBytes(sizeOf(undefined::CWchar)*260)$\c_str->dores<-c_getTempFileNameErrorNoc_tmp_dirc_templatec_suffix0c_strifnotresthendoerrno<-getErrnoioError(errnoToIOErrorlocerrnoNothing(Justtmp_dir))elsedofilename<-peekCWStringc_strhandleResultsPosixfilenamehandleResultsPosixfilename=doletoflags1=rw_flags.|.o_EXCLbinary_flags|binary=o_BINARY|otherwise=0oflags=oflags1.|.binary_flagsfd<-withFilePathfilename$\f->c_openfoflagsmodecasefd<0ofTrue->doerrno<-getErrnoioError(errnoToIOErrorlocerrnoNothing(Justtmp_dir))False->do(fD,fd_type)<-FD.mkFDfdReadWriteModeNothing{-no stat-}False{-is_socket-}True{-is_nonblock-}enc<-getLocaleEncodingh<-POSIX.mkHandleFromFDfDfd_typefilenameReadWriteModeFalse{-set non-block-}(Justenc)return(filename,h)handleResultsWinIOfilenameexcl=do(hwnd,hwnd_type)<-openFileAsTempfilenameTrueexclmb_codec<-ifbinarythenreturnNothingelsefmapJustgetLocaleEncoding-- then use it to make a Handleh<-mkHandleFromHANDLEhwndhwnd_typefilenameReadWriteModemb_codec`onException`IODevice.closehwndreturn(filename,h)foreignimportccall"getTempFileNameErrorNo"c_getTempFileNameErrorNo::CWString->CWString->CWString->CUInt->PtrCWchar->IOBoolforeignimportccall"__createUUIDTempFileErrNo"c_createUUIDTempFileErrNo::CWString->CWString->CWString->PtrCWString->IOBoolpathSeparator::String->BoolpathSeparatortemplate=any(\x->x=='/'||x=='\\')templateoutput_flags=std_flags
#else /* else mingw32_HOST_OS */
findTempName :: IO (String, Handle)
findTempName =doString
rs <-IO String
rand_string letfilename :: 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 caseOpenNewFileResult
r ofOpenNewFileResult
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 a. a -> IO a
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 herecombine :: 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. HasCallStack => [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{-# NOINLINEtempCounter #-}-- build large digit-alike numberrand_string ::IO String rand_string :: IO String
rand_string =doCPid
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 a. a -> IO a
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 dataOpenNewFileResult =NewFileCreated CInt |FileExists |OpenNewError Errno openNewFile ::FilePath ->Bool ->CMode ->IO OpenNewFileResult openNewFile :: String -> Bool -> CMode -> IO OpenNewFileResult
openNewFile String
filepath Bool
binary CMode
mode =doletoflags1 :: 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
0oflags :: 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 ifCInt
fd CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0thendoErrno
errno <-IO Errno
getErrno caseErrno
errno ofErrno
_|Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eEXIST ->OpenNewFileResult -> IO OpenNewFileResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return OpenNewFileResult
FileExists Errno
_->OpenNewFileResult -> IO OpenNewFileResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Errno -> OpenNewFileResult
OpenNewError Errno
errno )elseOpenNewFileResult -> IO OpenNewFileResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> OpenNewFileResult
NewFileCreated CInt
fd )-- XXX Should use filepath librarypathSeparatorChar ::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.Handlestd_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'.