X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FIO.hs;h=c6a11dd38c5f643c180e5ee4ad539d5df2d775ea;hb=389cd8738c0b402ebce69e7a7c2f0cc0eee2300e;hp=b68ff96f7145a591db250b335020cd8c53d2b4d2;hpb=10de2c656f74562b662c22928be85e1b3ccda796;p=ghc-base.git diff --git a/System/IO.hs b/System/IO.hs index b68ff96..c6a11dd 100644 --- a/System/IO.hs +++ b/System/IO.hs @@ -159,32 +159,90 @@ 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, + 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 + #ifndef __NHC__ 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 -#endif - -#ifdef __GLASGOW_HASKELL__ -import GHC.Exception as ExceptionBase hiding (catch) -#endif -#ifdef __HUGS__ -import Hugs.Exception as ExceptionBase +import System.Posix.Types #endif #ifdef __GLASGOW_HASKELL__ import GHC.Base -import GHC.IOBase -- Together these four Prelude modules define -import GHC.Handle -- all the stuff exported by IO for the GHC version -import GHC.IO -import GHC.Exception +import GHC.IO hiding ( onException ) +import GHC.IO.IOMode +import GHC.IO.Handle.FD +import GHC.IO.Handle +import GHC.IORef +import GHC.IO.Exception ( userError ) +import GHC.IO.Encoding import GHC.Num -import GHC.Read +import Text.Read import GHC.Show #endif @@ -192,8 +250,6 @@ import GHC.Show import Hugs.IO import Hugs.IOExts import Hugs.IORef -import Hugs.Prelude ( throw, Exception(NonTermination) ) -import Control.Exception ( bracket ) import System.IO.Unsafe ( unsafeInterleaveIO ) #endif @@ -434,14 +490,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 @@ -477,8 +548,8 @@ openTempFile' loc tmp_dir template binary = do return (filepath, h) #else 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 @@ -489,8 +560,7 @@ openTempFile' loc tmp_dir template binary = do -- XXX We want to tell fdToHandle what the filepath is, -- as any exceptions etc will only be able to report the -- fd currently - h <- fdToHandle fd - `ExceptionBase.catchException` \e -> do c_close fd; throw e + h <- fdToHandle fd `onException` c_close fd return (filepath, h) #endif where @@ -518,12 +588,10 @@ pathSeparator = '/' #ifndef __NHC__ -- XXX Copied from GHC.Handle +std_flags, output_flags, rw_flags :: CInt std_flags = o_NONBLOCK .|. o_NOCTTY output_flags = std_flags .|. o_CREAT -read_flags = std_flags .|. o_RDONLY -write_flags = output_flags .|. o_WRONLY rw_flags = output_flags .|. o_RDWR -append_flags = write_flags .|. o_APPEND #endif #ifdef __NHC__ @@ -548,24 +616,3 @@ foreign import ccall "getpid" c_getpid :: IO Int -- 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'. - --- ----------------------------------------------------------------------------- --- Utils - -#ifdef __GLASGOW_HASKELL__ --- Copied here to avoid recursive dependency with Control.Exception -bracket - :: IO a -- ^ computation to run first (\"acquire resource\") - -> (a -> IO b) -- ^ computation to run last (\"release resource\") - -> (a -> IO c) -- ^ computation to run in-between - -> IO c -- returns the value from the in-between computation -bracket before after thing = - block (do - a <- before - r <- catchException - (unblock (thing a)) - (\e -> do { after a; throw e }) - after a - return r - ) -#endif