ref: 27165dac44e115db691d938428cefecc19226791
parent: 7f9db71a3aadbfdc65b740e8d59492f2b6d5cdc4
author: Lennart Augustsson <lennart@augustsson.net>
date: Sat Mar 23 10:50:35 EDT 2024
Add openTempFile
--- a/ghc/Compat.hs
+++ b/ghc/Compat.hs
@@ -127,7 +127,7 @@
res <- try $ openTempFile tmp tmplt
case res of
Right x -> return x
- Left (_::SomeException) -> openTempFile "" tmplt
+ Left (_::SomeException) -> openTempFile "." tmplt
usingMhs :: Bool
usingMhs = False
--- a/lib/System/IO.hs
+++ b/lib/System/IO.hs
@@ -22,7 +22,7 @@
mkTextEncoding, hSetEncoding, utf8,
getTimeMilli,
- openTmpFile,
+ openTmpFile, openTempFile,
withFile,
) where
@@ -290,6 +290,22 @@
--------
+-- XXX needs bracket
+withFile :: forall r . FilePath -> IOMode -> (Handle -> IO r) -> IO r
+withFile fn md io = do
+ h <- openFile fn md
+ r <- io h
+ hClose h
+ return r
+
+--------
+
+splitTmp :: String -> (String, String)
+splitTmp tmpl =
+ case span (/= '.') (reverse tmpl) of
+ (rsuf, "") -> (tmpl, "")
+ (rsuf, _:rpre) -> (reverse rpre, '.':reverse rsuf)
+
-- Create a temporary file, take a prefix and a suffix
-- and returns a malloc()ed string.
foreign import ccall "tmpname" c_tmpname :: CString -> CString -> IO CString
@@ -297,10 +313,7 @@
-- Create and open a temporary file.
openTmpFile :: String -> IO (String, Handle)
openTmpFile tmpl = do
- let (pre, suf) =
- case span (/= '.') (reverse tmpl) of
- (rsuf, "") -> (tmpl, "")
- (rsuf, _:rpre) -> (reverse rpre, '.':reverse rsuf)
+ let (pre, suf) = splitTmp tmpl
ctmp <- withCAString pre $ withCAString suf . c_tmpname
tmp <- peekCAString ctmp
free ctmp
@@ -307,10 +320,18 @@
h <- openFile tmp ReadWriteMode
return (tmp, h)
--- XXX needs bracket
-withFile :: forall r . FilePath -> IOMode -> (Handle -> IO r) -> IO r
-withFile fn md io = do
- h <- openFile fn md
- r <- io h
- hClose h
- return r
+-- Sloppy implementation of openTempFile
+openTempFile :: FilePath -> String -> IO (String, Handle)
+openTempFile tmp tmplt = do
+ let (pre, suf) = splitTmp tmplt
+ loop n = do
+ let fn = tmp ++ "/" ++ pre ++ show n ++ suf
+ mh <- openFileM fn ReadMode
+ case mh of
+ Just h -> do
+ hClose h
+ loop (n+1 :: Int)
+ Nothing -> do
+ h <- openFile fn ReadWriteMode
+ return (fn, h)
+ loop 0
--
⑨