hIsReadable, hIsWritable, -- :: Handle -> IO Bool
hIsSeekable, -- :: Handle -> IO Bool
- -- ** Terminal operations
+ -- ** Terminal operations (not portable: GHC\/Hugs only)
#if !defined(__NHC__)
hIsTerminalDevice, -- :: Handle -> IO Bool
hGetEcho, -- :: Handle -> IO Bool
#endif
- -- ** Showing handle state
+ -- ** Showing handle state (not portable: GHC only)
#ifdef __GLASGOW_HASKELL__
hShow, -- :: Handle -> IO String
hGetBufNonBlocking, -- :: Handle -> Ptr a -> Int -> IO Int
#endif
- -- * Temporary files (not portable: GHC only)
+ -- * Temporary files (not portable: GHC\/Hugs only)
-#ifdef __GLASGOW_HASKELL__
+#if !defined(__NHC__)
openTempFile,
openBinaryTempFile,
#endif
) where
+#ifndef __NHC__
import Data.Bits
import Data.List
import Data.Maybe
import Foreign.C.Error
import Foreign.C.String
import System.Posix.Internals
+#endif
+
+#ifdef __GLASGOW_HASKELL__
+import GHC.Exception as ExceptionBase hiding (catch)
+#endif
+#ifdef __HUGS__
+import Hugs.Exception as ExceptionBase
+#endif
#ifdef __GLASGOW_HASKELL__
import GHC.Base
hSetBinaryMode _ _ = return ()
#endif
+#ifndef __NHC__
-- | The function creates a temporary file in ReadWrite mode.
-- The created file isn\'t deleted automatically, so you need to delete it manually.
openTempFile :: FilePath -- ^ Directory in which to create the file
-> String -- ^ File name template. If the template is \"foo.ext\" then
- -- the create file will be \"fooXXX.ext\" where XXX is some
+ -- 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
pid <- c_getpid
findTempName pid
where
- (prefix,suffix) = break (=='.') template
+ -- 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.
+ (prefix,suffix) =
+ case break (== '.') $ reverse template of
+ -- First case: template contains no '.'s. Just re-reverse it.
+ (rev_suffix, "") -> (reverse rev_suffix, "")
+ -- 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.)
+ (rev_suffix, '.':rest) -> (reverse rest, '.':reverse 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.
+ _ -> error "bug in System.IO.openTempFile"
oflags1 = rw_flags .|. o_EXCL
then findTempName (x+1)
else ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
else do
- h <- fdToHandle' fd Nothing False filepath ReadWriteMode True
- `catchException` \e -> do c_close fd; throw e
+ -- 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
return (filepath, h)
where
filename = prefix ++ show x ++ suffix
filepath = tmp_dir ++ [pathSeparator] ++ filename
+#if __HUGS__
+ fdToHandle fd = openFd (fromIntegral fd) False ReadWriteMode binary
+#endif
-- XXX Should use filepath library
pathSeparator :: Char
write_flags = output_flags .|. o_WRONLY
rw_flags = output_flags .|. o_RDWR
append_flags = write_flags .|. o_APPEND
+#endif
-- $locking
-- Implementations should enforce as far as possible, at least locally to the