{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude #-}
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.List
import Data.Maybe
import Foreign.C.Error
#ifdef mingw32_HOST_OS
import Foreign.C.String
#endif
import Foreign.C.Types
import System.Posix.Internals
import System.Posix.Types
import GHC.Base
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 GHC.Num
import Text.Read
import GHC.Show
import GHC.MVar
putChar :: Char -> IO ()
putChar c = hPutChar stdout c
putStr :: String -> IO ()
putStr s = hPutStr stdout s
putStrLn :: String -> IO ()
putStrLn s = hPutStrLn stdout s
print :: Show a => a -> IO ()
print x = putStrLn (show x)
getChar :: IO Char
getChar = hGetChar stdin
getLine :: IO String
getLine = hGetLine stdin
getContents :: IO String
getContents = hGetContents stdin
interact :: (String -> String) -> IO ()
interact f = do s <- getContents
putStr (f s)
readFile :: FilePath -> IO String
readFile name = openFile name ReadMode >>= hGetContents
writeFile :: FilePath -> String -> IO ()
writeFile f txt = withFile f WriteMode (\ hdl -> hPutStr hdl txt)
appendFile :: FilePath -> String -> IO ()
appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt)
readLn :: Read a => IO a
readLn = do l <- getLine
r <- readIO l
return r
readIO :: Read a => String -> IO a
readIO s = case (do { (x,t) <- reads s ;
("","") <- lex t ;
return x }) of
[x] -> return x
[] -> ioError (userError "Prelude.readIO: no parse")
_ -> ioError (userError "Prelude.readIO: ambiguous parse")
localeEncoding :: TextEncoding
localeEncoding = initLocaleEncoding
hReady :: Handle -> IO Bool
hReady h = hWaitForInput h 0
hPrint :: Show a => Handle -> a -> IO ()
hPrint hdl = hPutStrLn hdl . show
withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile name mode = bracket (openFile name mode) hClose
withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile name mode = bracket (openBinaryFile name mode) hClose
fixIO :: (a -> IO a) -> IO a
fixIO k = do
m <- newEmptyMVar
ans <- unsafeInterleaveIO (takeMVar m)
result <- k ans
putMVar m result
return result
openTempFile :: FilePath
-> String
-> IO (FilePath, Handle)
openTempFile tmp_dir template
= openTempFile' "openTempFile" tmp_dir template False 0o600
openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
openBinaryTempFile tmp_dir template
= openTempFile' "openBinaryTempFile" tmp_dir template True 0o600
openTempFileWithDefaultPermissions :: FilePath -> String
-> IO (FilePath, Handle)
openTempFileWithDefaultPermissions tmp_dir template
= openTempFile' "openBinaryTempFile" tmp_dir template False 0o666
openBinaryTempFileWithDefaultPermissions :: FilePath -> String
-> IO (FilePath, Handle)
openBinaryTempFileWithDefaultPermissions tmp_dir template
= openTempFile' "openBinaryTempFile" tmp_dir template True 0o666
openTempFile' :: String -> FilePath -> String -> Bool -> CMode
-> IO (FilePath, Handle)
openTempFile' loc tmp_dir template binary mode = do
pid <- c_getpid
findTempName pid
where
(prefix,suffix) =
case break (== '.') $ reverse template of
(rev_suffix, "") -> (reverse rev_suffix, "")
(rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)
_ -> error "bug in System.IO.openTempFile"
findTempName x = do
r <- openNewFile filepath binary mode
case r of
FileExists -> findTempName (x + 1)
OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
NewFileCreated fd -> do
(fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing
False
True
enc <- getLocaleEncoding
h <- mkHandleFromFD fD fd_type filepath ReadWriteMode False (Just enc)
return (filepath, h)
where
filename = prefix ++ show x ++ suffix
filepath = tmp_dir `combine` filename
combine a b
| null b = a
| null a = b
| last a == pathSeparator = a ++ b
| otherwise = a ++ [pathSeparator] ++ b
data OpenNewFileResult
= NewFileCreated CInt
| FileExists
| OpenNewError Errno
openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult
openNewFile filepath binary mode = do
let oflags1 = rw_flags .|. o_EXCL
binary_flags
| binary = o_BINARY
| otherwise = 0
oflags = oflags1 .|. binary_flags
fd <- withFilePath filepath $ \ f ->
c_open f oflags mode
if fd < 0
then do
errno <- getErrno
case errno of
_ | errno == eEXIST -> return FileExists
#ifdef mingw32_HOST_OS
_ | errno == eACCES -> do
withCString filepath $ \path -> do
exists <- c_fileExists path
return $ if exists
then FileExists
else OpenNewError errno
#endif
_ -> return (OpenNewError errno)
else return (NewFileCreated fd)
#ifdef mingw32_HOST_OS
foreign import ccall "file_exists" c_fileExists :: CString -> IO Bool
#endif
pathSeparator :: Char
#ifdef mingw32_HOST_OS
pathSeparator = '\\'
#else
pathSeparator = '/'
#endif
std_flags, output_flags, rw_flags :: CInt
std_flags = o_NONBLOCK .|. o_NOCTTY
output_flags = std_flags .|. o_CREAT
rw_flags = output_flags .|. o_RDWR