{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}
module System.IO (
IO,
fixIO,
FilePath,
Handle,
stdin, stdout, stderr,
withFile,
openFile,
IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
hClose,
readFile,
writeFile,
appendFile,
hFileSize,
hSetFileSize,
hIsEOF,
isEOF,
BufferMode(NoBuffering,LineBuffering,BlockBuffering),
hSetBuffering,
hGetBuffering,
hFlush,
hGetPosn,
hSetPosn,
HandlePosn,
hSeek,
SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
hTell,
hIsOpen, hIsClosed,
hIsReadable, hIsWritable,
hIsSeekable,
hIsTerminalDevice,
hSetEcho,
hGetEcho,
hShow,
hWaitForInput,
hReady,
hGetChar,
hGetLine,
hLookAhead,
hGetContents,
hPutChar,
hPutStr,
hPutStrLn,
hPrint,
interact,
putChar,
putStr,
putStrLn,
print,
getChar,
getLine,
getContents,
readIO,
readLn,
withBinaryFile,
openBinaryFile,
hSetBinaryMode,
hPutBuf,
hGetBuf,
hGetBufSome,
hPutBufNonBlocking,
hGetBufNonBlocking,
openTempFile,
openBinaryTempFile,
openTempFileWithDefaultPermissions,
openBinaryTempFileWithDefaultPermissions,
hSetEncoding,
hGetEncoding,
TextEncoding,
latin1,
utf8, utf8_bom,
utf16, utf16le, utf16be,
utf32, utf32le, utf32be,
localeEncoding,
char8,
mkTextEncoding,
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.Storable
#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 GHC.IO.Handle.FD
import qualified GHC.IO.FD as FD
import GHC.IO.Handle
import GHC.IO.Handle.Text ( hGetBufSome, hPutStrLn )
import GHC.IO.Exception ( userError )
import GHC.IO.Encoding
import Text.Read
import GHC.Show
import GHC.MVar
putChar :: Char -> IO ()
putChar :: Char -> IO ()
putChar c :: Char
c = Handle -> Char -> IO ()
hPutChar Handle
stdout Char
c
putStr :: String -> IO ()
putStr :: String -> IO ()
putStr s :: String
s = Handle -> String -> IO ()
hPutStr Handle
stdout String
s
putStrLn :: String -> IO ()
putStrLn :: String -> IO ()
putStrLn s :: String
s = Handle -> String -> IO ()
hPutStrLn Handle
stdout String
s
print :: Show a => a -> IO ()
print :: a -> IO ()
print x :: 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
interact :: (String -> String) -> IO ()
interact :: (String -> String) -> IO ()
interact f :: 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 name :: 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
writeFile :: FilePath -> String -> IO ()
writeFile :: String -> String -> IO ()
writeFile f :: String
f txt :: String
txt = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
f IOMode
WriteMode (\ hdl :: Handle
hdl -> Handle -> String -> IO ()
hPutStr Handle
hdl String
txt)
appendFile :: FilePath -> String -> IO ()
appendFile :: String -> String -> IO ()
appendFile f :: String
f txt :: String
txt = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
f IOMode
AppendMode (\ hdl :: Handle
hdl -> Handle -> String -> IO ()
hPutStr Handle
hdl String
txt)
readLn :: Read a => IO a
readLn :: IO a
readLn = do String
l <- IO String
getLine
a
r <- String -> IO a
forall a. Read a => String -> IO a
readIO String
l
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
readIO :: Read a => String -> IO a
readIO :: String -> IO a
readIO s :: String
s = case (do { (x :: a
x,t :: String
t) <- ReadS a
forall a. Read a => ReadS a
reads String
s ;
("","") <- ReadS String
lex String
t ;
a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return a
x }) of
[x :: 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 "Prelude.readIO: no parse")
_ -> IOError -> IO a
forall a. IOError -> IO a
ioError (String -> IOError
userError "Prelude.readIO: ambiguous parse")
localeEncoding :: TextEncoding
localeEncoding :: TextEncoding
localeEncoding = TextEncoding
initLocaleEncoding
hReady :: Handle -> IO Bool
hReady :: Handle -> IO Bool
hReady h :: Handle
h = Handle -> Int -> IO Bool
hWaitForInput Handle
h 0
hPrint :: Show a => Handle -> a -> IO ()
hPrint :: Handle -> a -> IO ()
hPrint hdl :: 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
withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile :: String -> IOMode -> (Handle -> IO r) -> IO r
withFile name :: String
name mode :: IOMode
mode = IO Handle -> (Handle -> IO ()) -> (Handle -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IOMode -> IO Handle
openFile String
name IOMode
mode) Handle -> IO ()
hClose
withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile :: String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile name :: String
name mode :: IOMode
mode = IO Handle -> (Handle -> IO ()) -> (Handle -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IOMode -> IO Handle
openBinaryFile String
name IOMode
mode) Handle -> IO ()
hClose
fixIO :: (a -> IO a) -> IO a
fixIO :: (a -> IO a) -> IO a
fixIO k :: 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 ->
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 (FilePath, Handle)
openTempFile :: String -> String -> IO (String, Handle)
openTempFile tmp_dir :: String
tmp_dir template :: String
template
= String -> String -> String -> Bool -> CMode -> IO (String, Handle)
openTempFile' "openTempFile" String
tmp_dir String
template Bool
False 0o600
openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
openBinaryTempFile :: String -> String -> IO (String, Handle)
openBinaryTempFile tmp_dir :: String
tmp_dir template :: String
template
= String -> String -> String -> Bool -> CMode -> IO (String, Handle)
openTempFile' "openBinaryTempFile" String
tmp_dir String
template Bool
True 0o600
openTempFileWithDefaultPermissions :: FilePath -> String
-> IO (FilePath, Handle)
openTempFileWithDefaultPermissions :: String -> String -> IO (String, Handle)
openTempFileWithDefaultPermissions tmp_dir :: String
tmp_dir template :: String
template
= String -> String -> String -> Bool -> CMode -> IO (String, Handle)
openTempFile' "openTempFileWithDefaultPermissions" String
tmp_dir String
template Bool
False 0o666
openBinaryTempFileWithDefaultPermissions :: FilePath -> String
-> IO (FilePath, Handle)
openBinaryTempFileWithDefaultPermissions :: String -> String -> IO (String, Handle)
openBinaryTempFileWithDefaultPermissions tmp_dir :: String
tmp_dir template :: String
template
= String -> String -> String -> Bool -> CMode -> IO (String, Handle)
openTempFile' "openBinaryTempFileWithDefaultPermissions" String
tmp_dir String
template Bool
True 0o666
openTempFile' :: String -> FilePath -> String -> Bool -> CMode
-> IO (FilePath, Handle)
openTempFile' :: String -> String -> String -> Bool -> CMode -> IO (String, Handle)
openTempFile' loc :: String
loc tmp_dir :: String
tmp_dir template :: String
template binary :: Bool
binary mode :: 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
$ "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
(prefix :: String
prefix, suffix :: 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
== '.') (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
template of
(rev_suffix :: String
rev_suffix, "") -> (String -> String
forall a. [a] -> [a]
reverse String
rev_suffix, "")
(rev_suffix :: String
rev_suffix, '.':rest :: String
rest) -> (String -> String
forall a. [a] -> [a]
reverse String
rest, '.'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
forall a. [a] -> [a]
reverse String
rev_suffix)
_ -> String -> (String, String)
forall a. String -> a
errorWithoutStackTrace "bug in System.IO.openTempFile"
#if defined(mingw32_HOST_OS)
findTempName = 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
handleResults filename
handleResults 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 <- mkHandleFromFD fD fd_type filename ReadWriteMode
False (Just enc)
return (filename, h)
foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo
:: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> 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
FileExists -> IO (String, Handle)
findTempName
OpenNewError errno :: 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 fd :: CInt
fd -> do
(fD :: FD
fD,fd_type :: 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
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 a :: String
a b :: 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 0
{-# NOINLINE tempCounter #-}
rand_string :: IO String
rand_string :: IO String
rand_string = do
CPid
r1 <- IO CPid
c_getpid
(r2 :: Int
r2, _) <- 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
+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
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 filepath :: String
filepath binary :: Bool
binary mode :: 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 = 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
$ \ f :: 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
< 0
then do
Errno
errno <- IO Errno
getErrno
case Errno
errno of
_ | 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
_ -> 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 = '/'
pathSeparator :: String -> Bool
pathSeparator :: String -> Bool
pathSeparator template :: 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