diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## 1.3 + +* Initial release, matching `temporary-1.3`. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright + (c) 2003-2006, Isaac Jones + (c) 2005-2009, Duncan Coutts + (c) 2008, Maximilian Bolingbroke + ... and other contributors + +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, are permitted +provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, this list of + conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright notice, this list of + conditions and the following disclaimer in the documentation and/or other materials + provided with the distribution. + * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to + endorse or promote products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR +CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER +IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# temporary-ospath [![Hackage](http://img.shields.io/hackage/v/temporary-ospath.svg)](https://hackage.haskell.org/package/temporary-ospath) [![Stackage LTS](http://stackage.org/package/temporary-ospath/badge/lts)](http://stackage.org/lts/package/temporary-ospath) [![Stackage Nightly](http://stackage.org/package/temporary-ospath/badge/nightly)](http://stackage.org/nightly/package/temporary-ospath) + +Portable temporary file and directory support for Windows and Unix based on `OsPath`. Fork of [`temporary`](http://hackage.haskell.org/package/temporary). diff --git a/System/IO/Temp/OsPath.hs b/System/IO/Temp/OsPath.hs new file mode 100644 --- /dev/null +++ b/System/IO/Temp/OsPath.hs @@ -0,0 +1,337 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +{- HLINT ignore "Avoid restricted function" -} + +-- | Functions to create temporary files and directories. +-- +-- Most functions come in two flavours: those that create files/directories +-- under the system standard temporary directory and those that use the +-- user-supplied directory. +-- +-- The functions that create files/directories under the system standard +-- temporary directory will return canonical absolute paths (see +-- 'getCanonicalTemporaryDirectory'). The functions that use the user-supplied +-- directory will not canonicalize the returned path. +-- +-- The action inside 'withTempFile' or 'withTempDirectory' is allowed to +-- remove the temporary file/directory if it needs to. +-- +-- == Templates and file names +-- +-- You shouldn't rely on the specific form of file or directory names +-- generated by the library; it has changed in the past and may change in the future +-- without bumping a major version. +module System.IO.Temp.OsPath ( + withSystemTempFile, + withSystemTempDirectory, + withTempFile, + withTempDirectory, + openNewBinaryFile, + createTempDirectory, + writeTempFile, + writeSystemTempFile, + emptyTempFile, + emptySystemTempFile, + createTempFileName, + withTempFileName, + + -- * Re-exports from "System.File.OsPath" + openTempFile, + openBinaryTempFile, + + -- * Auxiliary functions + getCanonicalTemporaryDirectory, +) where + +import qualified Control.Monad.Catch as MC +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Bits (countLeadingZeros, shiftR) +import Data.ByteString.Lazy (LazyByteString) +import qualified Data.ByteString.Lazy as BL +import Data.Word (Word64) +import GHC.IORef (IORef, atomicModifyIORef'_, newIORef) +import Numeric (showHex) +import System.CPUTime (cpuTimePrecision, getCPUTime) +import System.Directory.OsPath ( + canonicalizePath, + getTemporaryDirectory, + removeDirectoryRecursive, + removeFile, + ) +import System.File.OsPath ( + openBinaryTempFile, + openBinaryTempFileWithDefaultPermissions, + openTempFile, + ) +import System.IO ( + Handle, + hClose, + ) +import System.IO.Error (isAlreadyExistsError) +import System.IO.Unsafe (unsafePerformIO) +import System.OsPath ( + OsPath, + OsString, + encodeFS, + isPathSeparator, + makeValid, + osp, + (), + ) +import System.OsString (filter) +import System.Posix.Internals (c_getpid) +import Prelude hiding (filter) + +#ifdef mingw32_HOST_OS +import System.Directory.OsPath (createDirectory) +#else +import qualified System.Posix.Directory.PosixPath +import System.OsString.Internal.Types (getOsString) +#endif + +-- | Create, open, and use a temporary file in the system standard temporary directory. +-- +-- The temporary file is deleted after use. +-- +-- Behaves exactly the same as 'withTempFile', except that the parent temporary directory +-- will be that returned by 'getCanonicalTemporaryDirectory'. +withSystemTempFile + :: (MonadIO m, MC.MonadMask m) + => OsString + -- ^ File name template + -> (OsPath -> Handle -> m a) + -- ^ Callback that can use the file + -> m a +withSystemTempFile template action = do + tmpDir <- liftIO getCanonicalTemporaryDirectory + withTempFile tmpDir template action + +-- | Create and use a temporary directory in the system standard temporary directory. +-- +-- Behaves exactly the same as 'withTempDirectory', except that the parent temporary directory +-- will be that returned by 'getCanonicalTemporaryDirectory'. +withSystemTempDirectory + :: (MonadIO m, MC.MonadMask m) + => OsString + -- ^ Directory name template + -> (OsPath -> m a) + -- ^ Callback that can use the directory + -> m a +withSystemTempDirectory template action = do + tmpDir <- liftIO getCanonicalTemporaryDirectory + withTempDirectory tmpDir template action + +-- | Create, open (in text mode) and use a temporary file in the given directory. +-- +-- The temporary file is deleted after use. +withTempFile + :: (MonadIO m, MC.MonadMask m) + => OsPath + -- ^ Parent directory to create the file in + -> OsString + -- ^ File name template + -> (OsPath -> Handle -> m a) + -- ^ Callback that can use the file + -> m a +withTempFile tmpDir template action = + MC.bracket + (liftIO (openTempFile tmpDir template)) + (\(name, handle) -> liftIO (hClose handle >> ignoringIOErrors (removeFile name))) + (uncurry action) + +-- | Create and use a temporary directory inside the given directory. +-- +-- The directory is deleted after use. +withTempDirectory + :: (MC.MonadMask m, MonadIO m) + => OsPath + -- ^ Parent directory to create the directory in + -> OsString + -- ^ Directory name template + -> (OsPath -> m a) + -- ^ Callback that can use the directory + -> m a +withTempDirectory targetDir template = + MC.bracket + (liftIO (createTempDirectory targetDir template)) + (liftIO . ignoringIOErrors . removeDirectoryRecursive) + +-- | Create a unique new file, write a given data string to it, +-- and close the handle again. The file will not be deleted automatically, +-- and only the current user will have permission to access the file. +writeTempFile + :: OsPath + -- ^ Parent directory to create the file in + -> OsString + -- ^ File name template + -> LazyByteString + -- ^ Data to store in the file + -> IO OsPath + -- ^ Path to the (written and closed) file +writeTempFile targetDir template content = + MC.bracket + (openBinaryTempFile targetDir template) + (\(_, handle) -> hClose handle) + (\(filePath, handle) -> BL.hPut handle content >> pure filePath) + +-- | Like 'writeTempFile', but use the system directory for temporary files. +writeSystemTempFile + :: OsString + -- ^ File name template + -> LazyByteString + -- ^ Data to store in the file + -> IO OsPath + -- ^ Path to the (written and closed) file +writeSystemTempFile template content = do + tmpDir <- getCanonicalTemporaryDirectory + writeTempFile tmpDir template content + +-- | Create a unique new empty file. (Equivalent to 'writeTempFile' with empty data string.) +-- This is useful if the actual content is provided by an external process. +emptyTempFile + :: OsPath + -- ^ Parent directory to create the file in + -> OsString + -- ^ File name template + -> IO OsPath + -- ^ Path to the (written and closed) file +emptyTempFile targetDir template = + MC.bracket + (openBinaryTempFile targetDir template) + (\(_, handle) -> hClose handle) + (\(filePath, _) -> pure filePath) + +-- | Like 'emptyTempFile', but use the system directory for temporary files. +emptySystemTempFile + :: OsString + -- ^ File name template + -> IO OsPath + -- ^ Path to the (written and closed) file +emptySystemTempFile template = do + tmpDir <- getCanonicalTemporaryDirectory + emptyTempFile tmpDir template + +ignoringIOErrors :: MC.MonadCatch m => m () -> m () +ignoringIOErrors ioe = ioe `MC.catch` (\(_ :: IOError) -> pure ()) + +-- | Legacy synonym for 'openBinaryTempFileWithDefaultPermissions'. +openNewBinaryFile :: OsPath -> OsString -> IO (OsPath, Handle) +openNewBinaryFile = openBinaryTempFileWithDefaultPermissions +{-# DEPRECATED openNewBinaryFile "Use 'openBinaryTempFileWithDefaultPermissions' instead" #-} + +-- | Create a temporary directory. +createTempDirectory + :: OsPath + -- ^ Parent directory to create the directory in + -> OsString + -- ^ Directory name template + -> IO OsPath +createTempDirectory dir template = findTempName + where + findTempName :: IO OsPath + findTempName = do + dirpath <- (dir ) <$> randomString (sanitizeAsDirName template) + r <- MC.try $ mkPrivateDir dirpath + case r of + Right _ -> pure dirpath + Left e + | isAlreadyExistsError e -> findTempName + | otherwise -> ioError e + +tempDirectoryCounter :: IORef Word +tempDirectoryCounter = unsafePerformIO $ newIORef 0 +{-# NOINLINE tempDirectoryCounter #-} + +randomString :: OsString -> IO OsPath +randomString template = do + r1 <- c_getpid + (r2, _) <- atomicModifyIORef'_ tempDirectoryCounter (+ 1) + r3 <- (`shiftR` logCpuTimePrecision) <$> getCPUTime + let suffix = showHex (abs r1) ('-' : showHex r2 ('-' : showHex (abs r3) "")) + pure $ template <> unsafePerformIO (encodeFS suffix) + +#ifdef netbsd_HOST_OS +-- cpuTimePrecision seems to fail on NetBSD +logCpuTimePrecision :: Int +logCpuTimePrecision = 0 +#else +logCpuTimePrecision :: Int +logCpuTimePrecision = + 64 - countLeadingZeros (fromInteger cpuTimePrecision :: Word64) +#endif + +sanitizeAsDirName :: OsString -> OsPath +sanitizeAsDirName = makeValid . filter (\c -> not (isPathSeparator c)) + +-- | Get a temporary file name without creating a file. +-- +-- If you merely want to create a temporary file or directory, +-- please use one of the functions above, such as 'withTempFile' or +-- 'withTempDirectory'. +-- +-- This function can be useful when: +-- +-- * you want to create a file of a special type, like a FIFO or a socket. +-- * you have a process/function that accepts a filename and then waits for it +-- to appear to do something, so you need to know the file name /before/ the +-- file is created. +-- * you need a target for an atomic rename operation. +-- +-- This function works by creating a temporary directory with +-- 'createTempDirectory' and then returning a fixed file name within that +-- directory. On UNIX, the directory is created with the mode 0700, which +-- ensures that a different user cannot make us overwrite an existing file. +-- This makes this function more secure than merely generating a random file +-- name. +-- +-- See also 'withTempFileName'. +createTempFileName + :: OsPath + -- ^ Parent directory to create the temporary directory in + -> OsString + -- ^ Directory name template + -> IO OsPath +createTempFileName dir template = do + tempDir <- createTempDirectory dir template + pure (tempDir [osp|temp_file|]) + +-- | Similarly to 'createTempFileName', this function creates a temporary +-- directory and constructs a fixed file name within it. The supplied callback is +-- called with the generated file name, and after it returns, the directory is +-- removed with all its contents. +-- +-- Please read the documentation for 'createTempFileName' carefully and make +-- sure this is the right function for your needs before using it. +withTempFileName + :: (MonadIO m, MC.MonadMask m) + => OsPath + -- ^ Parent directory to create the temporary directory in + -> OsString + -- ^ Directory name template + -> (OsPath -> m a) + -> m a +withTempFileName dir template k = withTempDirectory dir template $ \tempDir -> + k (tempDir [osp|temp_file|]) + +mkPrivateDir :: OsPath -> IO () +#ifdef mingw32_HOST_OS +mkPrivateDir = createDirectory +#else +mkPrivateDir s = + System.Posix.Directory.PosixPath.createDirectory (getOsString s) 0o700 +#endif + +-- | Return the absolute and canonical path to the system temporary +-- directory. +-- +-- >>> setCurrentDirectory "/home/username/" +-- >>> setEnv "TMPDIR" "." +-- >>> getTemporaryDirectory +-- "." +-- >>> getCanonicalTemporaryDirectory +-- "/home/username" +getCanonicalTemporaryDirectory :: IO OsPath +getCanonicalTemporaryDirectory = getTemporaryDirectory >>= canonicalizePath diff --git a/temporary-ospath.cabal b/temporary-ospath.cabal new file mode 100644 --- /dev/null +++ b/temporary-ospath.cabal @@ -0,0 +1,62 @@ +cabal-version: 2.2 +name: temporary-ospath +version: 1.3 +license: BSD-3-Clause +license-file: LICENSE +maintainer: Bodigrim +tested-with: + ghc ==9.14.1 ghc ==9.12.2 ghc ==9.10.3 ghc ==9.8.4 ghc ==9.6.7 + ghc ==9.4.8 ghc ==9.2.8 ghc ==9.0.2 ghc ==8.10.7 ghc ==8.8.4 + +synopsis: Portable temporary file and directory support +description: + Functions for creating temporary files and directories based on @OsPath@. + Fork of @temporary@. + +category: System, Utils +build-type: Simple +extra-doc-files: + CHANGELOG.md + README.md + +source-repository head + type: git + location: https://github.com/Bodigrim/temporary-ospath + +library + exposed-modules: System.IO.Temp.OsPath + default-language: Haskell2010 + ghc-options: -Wall + build-depends: + base >=4.13 && <5, + bytestring >=0.11.2 && <0.13, + directory >=1.3.8 && <1.4, + exceptions >=0.10 && <0.11, + file-io >=0.1.3 && <0.3, + filepath >=1.5 && <1.6, + os-string >=2.0 && <2.1 + + if !os(windows) + build-depends: unix >=2.8 && <2.9 + +test-suite tests + type: exitcode-stdio-1.0 + main-is: test.hs + hs-source-dirs: tests + default-language: Haskell2010 + ghc-options: -Wall + build-depends: + base <5, + directory, + file-io, + filepath, + os-string, + tasty >=1.5 && <2, + tasty-hunit >=0.10 && <1, + temporary-ospath + + if !arch(wasm32) + ghc-options: -threaded -with-rtsopts=-N2 + + if !os(windows) + build-depends: unix diff --git a/tests/test.hs b/tests/test.hs new file mode 100644 --- /dev/null +++ b/tests/test.hs @@ -0,0 +1,227 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE QuasiQuotes #-} +{-# OPTIONS_GHC -Wno-deprecations #-} + +{- HLINT ignore "Avoid restricted function" -} + +#include "HsBaseConfig.h" + +import Control.Concurrent ( + forkIO, + killThread, + newEmptyMVar, + putMVar, + readMVar, + threadDelay, + ) +import Control.Exception (bracket, bracket_, finally) +import Control.Monad (replicateM_, unless) +import Data.List (group, sort) +import Data.String (fromString) +import System.Directory.OsPath ( + createDirectoryIfMissing, + doesDirectoryExist, + doesFileExist, + removeDirectoryRecursive, + removeFile, + ) +import System.Environment (setEnv, unsetEnv) +import System.Exit (die) +import System.File.OsPath (readFile) +import System.IO (hClose, hIsClosed, hIsOpen, hPutStrLn) +import System.IO.Temp.OsPath ( + createTempFileName, + emptySystemTempFile, + emptyTempFile, + getCanonicalTemporaryDirectory, + openNewBinaryFile, + withSystemTempDirectory, + withSystemTempFile, + writeSystemTempFile, + ) +import System.IO.Unsafe (unsafePerformIO) +import System.OsPath ( + OsPath, + decodeFS, + equalFilePath, + isAbsolute, + osp, + takeBaseName, + takeDirectory, + takeFileName, + ) +import System.OsString (isPrefixOf, isSuffixOf) +import System.Posix.Types (FileMode) +import Test.Tasty (defaultMain, testGroup) +import Test.Tasty.HUnit (Assertion, assertBool, testCase, (@?=)) +import Prelude hiding (readFile) + +#ifndef mingw32_HOST_OS +import Data.Bits ((.&.)) +import Data.Functor (void) +import System.OsString.Internal.Types (getOsString) +import System.Posix.Files.PosixString ( + fileMode, + getFileStatus, + setFileCreationMask, + ) +#endif + +#if defined(mingw32_HOST_OS) || !defined(HAVE_UMASK) +setFileCreationMask0 :: IO () +setFileCreationMask0 = pure () +#else +setFileCreationMask0 :: IO () +setFileCreationMask0 = void $ setFileCreationMask 0 +#endif + +#if defined(mingw32_HOST_OS) || !defined(HAVE_UMASK) +checkFileStatus :: OsPath -> FileMode -> Assertion +checkFileStatus = const $ const $ pure () +#else +checkFileStatus :: OsPath -> FileMode -> Assertion +checkFileStatus fp expected = do + status <- getFileStatus (getOsString fp) + fileMode status .&. 0o777 @?= expected +#endif + +#if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ < 900 +oldGhcOnWin :: Bool +oldGhcOnWin = True +#else +oldGhcOnWin :: Bool +oldGhcOnWin = False +#endif + +#if defined(netbsd_HOST_OS) +-- NetBSD has issues with clock_getres, which is used by openTempFile from file-io +ignoreOnNetBSD :: Assertion -> Assertion +ignoreOnNetBSD = const $ pure () +#else +ignoreOnNetBSD :: Assertion -> Assertion +ignoreOnNetBSD = id +#endif + +main :: IO () +main = do + -- force single-thread execution, because changing TMPDIR in one of the + -- tests may leak to the other tests + setEnv "TASTY_NUM_THREADS" "1" + setFileCreationMask0 + sysTmpDir <- getCanonicalTemporaryDirectory + putStrLn $ "getCanonicalTemporaryDirectory = " ++ show sysTmpDir + createDirectoryIfMissing True sysTmpDir + doesSysTmpDirExist <- doesDirectoryExist sysTmpDir + unless doesSysTmpDirExist $ + die $ + show sysTmpDir ++ " does not exist" + defaultMain $ + testGroup + "Tests" + [ testCase "openNewBinaryFile" $ ignoreOnNetBSD $ do + (fp, fh) <- openNewBinaryFile sysTmpDir [osp|test.txt|] + let fn = takeFileName fp + assertBool ("Does not match template: " ++ decodeOsPath fn) $ + oldGhcOnWin || ([osp|test|] `isPrefixOf` fn) && ([osp|.txt|] `isSuffixOf` fn) + assertBool (decodeOsPath fp ++ " is not in the right directory " ++ decodeOsPath sysTmpDir) $ + takeDirectory fp `equalFilePath` sysTmpDir + hClose fh + assertBool "File does not exist" =<< doesFileExist fp + checkFileStatus fp 0o666 + removeFile fp + , testCase "withSystemTempFile" $ ignoreOnNetBSD $ do + (fp, fh) <- withSystemTempFile [osp|test.txt|] $ \fp fh -> do + let fn = takeFileName fp + assertBool ("Does not match template: " ++ decodeOsPath fn) $ + oldGhcOnWin || ([osp|test|] `isPrefixOf` fn) && ([osp|.txt|] `isSuffixOf` fn) + assertBool (decodeOsPath fp ++ " is not in the right directory " ++ decodeOsPath sysTmpDir) $ + takeDirectory fp `equalFilePath` sysTmpDir + assertBool "File not open" =<< hIsOpen fh + hPutStrLn fh "hi" + assertBool "File does not exist" =<< doesFileExist fp + checkFileStatus fp 0o600 + return (fp, fh) + assertBool "File still exists" . not =<< doesFileExist fp + assertBool "File not closed" =<< hIsClosed fh + , testCase "withSystemTempDirectory" $ do + fp <- withSystemTempDirectory [osp|test.dir|] $ \fp -> do + let fn = takeFileName fp + assertBool ("Does not match template: " ++ decodeOsPath fn) $ + [osp|test.dir|] `isPrefixOf` fn + assertBool (decodeOsPath fp ++ " is not in the right directory " ++ decodeOsPath sysTmpDir) $ + takeDirectory fp `equalFilePath` sysTmpDir + assertBool "Directory does not exist" =<< doesDirectoryExist fp + checkFileStatus fp 0o700 + pure fp + assertBool "Directory still exists" . not =<< doesDirectoryExist fp + , testCase "writeSystemTempFile" $ ignoreOnNetBSD $ do + fp <- writeSystemTempFile [osp|blah.txt|] (fromString "hello") + str <- readFile fp + fromString "hello" @?= str + removeFile fp + , testCase "emptySystemTempFile" $ ignoreOnNetBSD $ do + fp <- emptySystemTempFile [osp|empty.txt|] + assertBool "File doesn't exist" =<< doesFileExist fp + removeFile fp + , testCase "withSystemTempFile returns absolute path" $ ignoreOnNetBSD $ do + bracket_ (setEnv "TMPDIR" ".") (unsetEnv "TMPDIR") $ do + withSystemTempFile [osp|temp.txt|] $ \fp _ -> + assertBool "Not absolute" $ isAbsolute fp + , testCase "withSystemTempDirectory is not interrupted" $ ignoreOnNetBSD $ do + -- this mvar is both a channel to pass the name of the directory + -- and a signal that we finished creating files and are ready + -- to be killed + mvar1 <- newEmptyMVar + -- this mvar signals that the withSystemTempDirectory function + -- returned and we can check whether the directory has survived + mvar2 <- newEmptyMVar + threadId <- + forkIO $ + ( withSystemTempDirectory [osp|temp.test.|] $ \dir -> do + replicateM_ 100 $ emptyTempFile dir [osp|file.xyz|] + putMVar mvar1 dir + threadDelay 1000000 + ) + `finally` putMVar mvar2 () + dir <- readMVar mvar1 + -- start sending exceptions + replicateM_ 10 $ forkIO $ killThread threadId + -- wait for the thread to finish + readMVar mvar2 + -- check whether the directory was successfully removed + assertBool "Directory was not removed" . not =<< doesDirectoryExist dir + , testCase "createTempFileName" $ do + let template = [osp|testdir|] + -- createTempFileName with some tests + checkedCreateTempFileName = do + fp <- createTempFileName sysTmpDir template + let directParent = takeDirectory fp + assertBool ("Parent directory " ++ decodeOsPath directParent ++ " does not match template: " ++ decodeOsPath template) $ + template `isPrefixOf` takeBaseName directParent + assertBool "Parent directory does not exist" =<< doesDirectoryExist directParent + assertBool "File already exists" . not =<< doesFileExist fp + pure fp + + -- Helper for the test just to ensure we don't leave garbage lying + -- around when we run/abort tests. + withTempFileName = + bracket + checkedCreateTempFileName + (removeDirectoryRecursive . takeDirectory) + + -- Now make some filenames, check that they are all different. Note that + -- we run the tests we defined above on each one. We don't want to plug + -- a huge number here to not hit any file resource limits. + let checkDifferent 0 fns = + assertBool "Got duplicate temporary filenames" + . all ((== 1) . length) + . group + $ sort fns + checkDifferent n fns = withTempFileName $ \fp -> + checkDifferent (n - 1) (fp : fns) + + checkDifferent (50 :: Int) [] + ] + +decodeOsPath :: OsPath -> String +decodeOsPath = unsafePerformIO . decodeFS