TempFile.hs 1.48 KB
Newer Older
1
2
3
4
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -cpp #-}
{-# OPTIONS_NHC98 -cpp #-}
{-# OPTIONS_JHC -fcpp #-}
5
-- #hide
6
module Distribution.Compat.TempFile (openTempFile) where
7

8
9
10
#if __NHC__ || __HUGS__
import System.IO              (openFile, Handle, IOMode(ReadWriteMode))
import System.Directory       (doesFileExist)
Ross Paterson's avatar
Ross Paterson committed
11
import System.FilePath        ((</>), (<.>), splitExtension)
12
13
import System.Posix.Internals (c_getpid)
#else
14
import System.IO (openTempFile)
15
16
17
18
19
20
#endif

-- ------------------------------------------------------------
-- * temporary files
-- ------------------------------------------------------------

21
22
23
-- This is here for Haskell implementations that do not come with
-- System.IO.openTempFile. This includes nhc-1.20, hugs-2006.9.
-- TODO: Not sure about jhc
24

25
#if __NHC__ || __HUGS__
26
27
28
29
-- use a temporary filename that doesn't already exist.
-- NB. *not* secure (we don't atomically lock the tmp file we get)
openTempFile :: FilePath -> String -> IO (FilePath, Handle)
openTempFile tmp_dir template
30
31
32
  = do x <- getProcessID
       findTempName x
  where
33
34
    (templateBase, templateExt) = splitExtension template
    findTempName :: Int -> IO (FilePath, Handle)
35
    findTempName x
36
      = do let path = tmp_dir </> (templateBase ++ show x) <.> templateExt
37
38
           b  <- doesFileExist path
           if b then findTempName (x+1)
39
40
                else do hnd <- openFile path ReadWriteMode
                        return (path, hnd)
41

42
43
44
    getProcessID :: IO Int
    getProcessID = fmap fromIntegral c_getpid
#endif