{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} module Distribution.Compat.Internal.TempFile ( openTempFile , openBinaryTempFile , openNewBinaryFile , createTempDirectory ) where import Distribution.Compat.Exception import System.FilePath ((</>)) import System.IO (Handle, openBinaryTempFile, openBinaryTempFileWithDefaultPermissions, openTempFile) import System.IO.Error (isAlreadyExistsError) import System.Posix.Internals (c_getpid) #if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS) import System.Directory ( createDirectory ) #else import qualified System.Posix #endif openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle) openNewBinaryFile :: FilePath -> FilePath -> IO (FilePath, Handle) openNewBinaryFile = FilePath -> FilePath -> IO (FilePath, Handle) openBinaryTempFileWithDefaultPermissions createTempDirectory :: FilePath -> String -> IO FilePath createTempDirectory :: FilePath -> FilePath -> IO FilePath createTempDirectory FilePath dir FilePath template = do pid <- IO CPid c_getpid findTempName pid where findTempName :: t -> IO FilePath findTempName t x = do let relpath :: FilePath relpath = FilePath template FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ FilePath "-" FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ t -> FilePath forall a. Show a => a -> FilePath show t x dirpath :: FilePath dirpath = FilePath dir FilePath -> FilePath -> FilePath </> FilePath relpath r <- IO () -> IO (Either IOException ()) forall a. IO a -> IO (Either IOException a) tryIO (IO () -> IO (Either IOException ())) -> IO () -> IO (Either IOException ()) forall a b. (a -> b) -> a -> b $ FilePath -> IO () mkPrivateDir FilePath dirpath case r of Right () _ -> FilePath -> IO FilePath forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return FilePath relpath Left IOException e | IOException -> Bool isAlreadyExistsError IOException e -> t -> IO FilePath findTempName (t x t -> t -> t forall a. Num a => a -> a -> a + t 1) | Bool otherwise -> IOException -> IO FilePath forall a. IOException -> IO a ioError IOException e mkPrivateDir :: String -> IO () #if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS) mkPrivateDir s = createDirectory s #else mkPrivateDir :: FilePath -> IO () mkPrivateDir FilePath s = FilePath -> FileMode -> IO () System.Posix.createDirectory FilePath s FileMode 0o700 #endif