X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FIO.hs;h=bf26835eef628b0335ae9246723e0852295577aa;hb=HEAD;hp=f6d1b75b1fdf607e2ff5d45dadc3b31ab35a3d39;hpb=d2063b5b0be014545b21819172c87756efcb0b0c;p=ghc-base.git diff --git a/System/IO.hs b/System/IO.hs index f6d1b75..bf26835 100644 --- a/System/IO.hs +++ b/System/IO.hs @@ -1,4 +1,5 @@ -{-# OPTIONS_GHC -XNoImplicitPrelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude #-} + ----------------------------------------------------------------------------- -- | -- Module : System.IO @@ -25,6 +26,15 @@ module System.IO ( 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, @@ -151,6 +161,7 @@ module System.IO ( hPutBuf, -- :: Handle -> Ptr a -> Int -> IO () hGetBuf, -- :: Handle -> Ptr a -> Int -> IO Int #if !defined(__NHC__) && !defined(__HUGS__) + hGetBufSome, -- :: Handle -> Ptr a -> Int -> IO Int hPutBufNonBlocking, -- :: Handle -> Ptr a -> Int -> IO Int hGetBufNonBlocking, -- :: Handle -> Ptr a -> Int -> IO Int #endif @@ -159,6 +170,66 @@ module System.IO ( openTempFile, openBinaryTempFile, + openTempFileWithDefaultPermissions, + openBinaryTempFileWithDefaultPermissions, + +#if !defined(__NHC__) && !defined(__HUGS__) + -- * 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, +#endif + +#if !defined(__NHC__) && !defined(__HUGS__) + -- * 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 transate 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, +#endif ) where import Control.Exception.Base @@ -168,20 +239,22 @@ import Data.Bits import Data.List import Data.Maybe import Foreign.C.Error -import Foreign.C.String import Foreign.C.Types import System.Posix.Internals +import System.Posix.Types #endif #ifdef __GLASGOW_HASKELL__ import GHC.Base -import GHC.IO hiding ( onException ) +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.IORef import GHC.IO.Exception ( userError ) -import GHC.Exception +import GHC.IO.Encoding import GHC.Num import Text.Read import GHC.Show @@ -254,8 +327,7 @@ putStr s = hPutStr stdout s -- | The same as 'putStr', but adds a newline character. putStrLn :: String -> IO () -putStrLn s = do putStr s - putChar '\n' +putStrLn s = hPutStrLn stdout s -- | The 'print' function outputs a value of any printable type to the -- standard output device. @@ -353,13 +425,6 @@ readIO s = case (do { (x,t) <- reads s ; hReady :: Handle -> IO Bool hReady h = hWaitForInput h 0 --- | The same as 'hPutStr', but adds a newline character. - -hPutStrLn :: Handle -> String -> IO () -hPutStrLn hndl str = do - hPutStr hndl str - hPutChar hndl '\n' - -- | 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. @@ -377,7 +442,9 @@ hPrint hdl = hPutStrLn hdl . show -- | @'withFile' name mode act@ opens a file using 'openFile' and passes -- the resulting handle to the computation @act@. The handle will be -- closed on exit from 'withFile', whether by normal termination or by --- raising an exception. +-- raising an exception. If closing the handle raises an exception, then +-- this exception will be raised by 'withFile' rather than any exception +-- raised by 'act'. withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r withFile name mode = bracket (openFile name mode) hClose @@ -409,6 +476,8 @@ fixIO k = do -- Assume a unix platform, where text and binary I/O are identical. openBinaryFile = openFile hSetBinaryMode _ _ = return () + +type CMode = Int #endif -- | The function creates a temporary file in ReadWrite mode. @@ -431,14 +500,29 @@ openTempFile :: FilePath -- ^ Directory in which to create the file -- the created file will be \"fooXXX.ext\" where XXX is some -- random number. -> IO (FilePath, Handle) -openTempFile tmp_dir template = openTempFile' "openTempFile" tmp_dir template False +openTempFile tmp_dir template + = openTempFile' "openTempFile" tmp_dir template False 0o600 -- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments. openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle) -openBinaryTempFile tmp_dir template = openTempFile' "openBinaryTempFile" tmp_dir template True - -openTempFile' :: String -> FilePath -> String -> Bool -> IO (FilePath, Handle) -openTempFile' loc tmp_dir template binary = do +openBinaryTempFile tmp_dir template + = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600 + +-- | Like 'openTempFile', but uses the default file permissions +openTempFileWithDefaultPermissions :: FilePath -> String + -> IO (FilePath, Handle) +openTempFileWithDefaultPermissions tmp_dir template + = openTempFile' "openBinaryTempFile" tmp_dir template False 0o666 + +-- | Like 'openBinaryTempFile', but uses the default file permissions +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 @@ -469,13 +553,13 @@ openTempFile' loc tmp_dir template binary = do oflags = oflags1 .|. binary_flags #endif -#ifdef __NHC__ +#if defined(__NHC__) findTempName x = do h <- openFile filepath ReadWriteMode return (filepath, h) -#else +#elif defined(__GLASGOW_HASKELL__) findTempName x = do - fd <- withCString filepath $ \ f -> - c_open f oflags 0o600 + fd <- withFilePath filepath $ \ f -> + c_open f oflags mode if fd < 0 then do errno <- getErrno @@ -483,12 +567,20 @@ openTempFile' loc tmp_dir template binary = do then findTempName (x+1) else ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) else do - -- XXX We want to tell fdToHandle what the filepath is, - -- as any exceptions etc will only be able to report the - -- fd currently + + (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-} + False{-is_socket-} + True{-is_nonblock-} + + h <- mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} + (Just localeEncoding) + + return (filepath, h) +#else h <- fdToHandle fd `onException` c_close fd return (filepath, h) #endif + where filename = prefix ++ show x ++ suffix filepath = tmp_dir `combine` filename @@ -527,8 +619,7 @@ foreign import ccall "getpid" c_getpid :: IO Int -- $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 +-- 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