{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}

module Distribution.Compat.Internal.TempFile
  ( openTempFile
  , openBinaryTempFile
  , openNewBinaryFile
  , createTempDirectory
  ) where

import Distribution.Compat.Exception

import GHC.IORef (IORef, atomicModifyIORef'_, newIORef)
import System.FilePath ((</>))
import System.IO (Handle, openBinaryTempFile, openBinaryTempFileWithDefaultPermissions, openTempFile)
import System.IO.Error (isAlreadyExistsError)
import System.IO.Unsafe (unsafePerformIO)
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
  CPid
pid <- IO CPid
c_getpid
  let findTempName :: IO FilePath
findTempName = do
        (Word
counter, Word
_) <- IORef Word -> (Word -> Word) -> IO (Word, Word)
forall a. IORef a -> (a -> a) -> IO (a, a)
atomicModifyIORef'_ IORef Word
tempDirectoryCounter (Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)
        let relpath :: FilePath
relpath = FilePath
template FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CPid -> FilePath
forall a. Show a => a -> FilePath
show CPid
pid FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Word -> FilePath
forall a. Show a => a -> FilePath
show Word
counter
            dirpath :: FilePath
dirpath = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
relpath
        Either IOException ()
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 Either IOException ()
r of
          Right ()
_ -> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
relpath
          Left IOException
e
            | IOException -> Bool
isAlreadyExistsError IOException
e -> IO FilePath
findTempName
            | Bool
otherwise -> IOException -> IO FilePath
forall a. IOException -> IO a
ioError IOException
e
  IO FilePath
findTempName

tempDirectoryCounter :: IORef Word
tempDirectoryCounter :: IORef Word
tempDirectoryCounter = IO (IORef Word) -> IORef Word
forall a. IO a -> a
unsafePerformIO (IO (IORef Word) -> IORef Word) -> IO (IORef Word) -> IORef Word
forall a b. (a -> b) -> a -> b
$ Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0
{-# NOINLINE tempDirectoryCounter #-}

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