temporary (empty) → 1.0
raw patch · 6 files changed
+352/−0 lines, 6 filesdep +basedep +directorydep +filepathsetup-changed
Dependencies added: base, directory, filepath, unix
Files
- Distribution/Compat/Exception.hs +49/−0
- Distribution/Compat/TempFile.hs +204/−0
- LICENSE +22/−0
- Setup.lhs +3/−0
- System/IO/Temp.hs +46/−0
- temporary.cabal +28/−0
+ Distribution/Compat/Exception.hs view
@@ -0,0 +1,49 @@+{-# OPTIONS -cpp #-}+-- OPTIONS required for ghc-6.4.x compat, and must appear first+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -cpp #-}+{-# OPTIONS_NHC98 -cpp #-}+{-# OPTIONS_JHC -fcpp #-}++#if !(defined(__HUGS__) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 610))+#define NEW_EXCEPTION+#endif++module Distribution.Compat.Exception+ (onException, catchIO, catchExit, throwIOIO)+ where++import System.Exit+import qualified Control.Exception as Exception++onException :: IO a -> IO b -> IO a+#ifdef NEW_EXCEPTION+onException = Exception.onException+#else+onException io what = io `Exception.catch` \e -> do what+ Exception.throw e+#endif++throwIOIO :: Exception.IOException -> IO a+#ifdef NEW_EXCEPTION+throwIOIO = Exception.throwIO+#else+throwIOIO = Exception.throwIO . Exception.IOException+#endif++catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#ifdef NEW_EXCEPTION+catchIO = Exception.catch+#else+catchIO = Exception.catchJust Exception.ioErrors+#endif++catchExit :: IO a -> (ExitCode -> IO a) -> IO a+#ifdef NEW_EXCEPTION+catchExit = Exception.catch+#else+catchExit = Exception.catchJust exitExceptions+ where exitExceptions (Exception.ExitException ee) = Just ee+ exitExceptions _ = Nothing+#endif+
+ Distribution/Compat/TempFile.hs view
@@ -0,0 +1,204 @@+{-# OPTIONS -cpp #-}+-- OPTIONS required for ghc-6.4.x compat, and must appear first+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -cpp #-}+{-# OPTIONS_NHC98 -cpp #-}+{-# OPTIONS_JHC -fcpp #-}+-- #hide+module Distribution.Compat.TempFile (+ openTempFile,+ openBinaryTempFile,+ openNewBinaryFile,+ createTempDirectory,+ ) where+++import System.FilePath ((</>))+import Foreign.C (eEXIST)++#if __NHC__ || __HUGS__+import System.IO (openFile, openBinaryFile,+ Handle, IOMode(ReadWriteMode))+import System.Directory (doesFileExist)+import System.FilePath ((<.>), splitExtension)+import System.IO.Error (try, isAlreadyExistsError)+#else+import System.IO (Handle, openTempFile, openBinaryTempFile)+import Data.Bits ((.|.))+import System.Posix.Internals (c_open, c_close, o_CREAT, o_EXCL, o_RDWR,+ o_BINARY, o_NONBLOCK, o_NOCTTY)+import System.IO.Error (try, isAlreadyExistsError)+#if __GLASGOW_HASKELL__ >= 611+import System.Posix.Internals (withFilePath)+#else+import Foreign.C (withCString)+#endif+import Foreign.C (CInt)+#if __GLASGOW_HASKELL__ >= 611+import GHC.IO.Handle.FD (fdToHandle)+#else+import GHC.Handle (fdToHandle)+#endif+import Distribution.Compat.Exception (onException)+#endif+import Foreign.C (getErrno, errnoToIOError)++#if __NHC__+import System.Posix.Types (CPid(..))+foreign import ccall unsafe "getpid" c_getpid :: IO CPid+#else+import System.Posix.Internals (c_getpid)+#endif++#ifdef mingw32_HOST_OS+import System.Directory ( createDirectory )+#else+import qualified System.Posix+#endif++-- ------------------------------------------------------------+-- * temporary files+-- ------------------------------------------------------------++-- 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++#if __NHC__ || __HUGS__+-- 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+ = do x <- getProcessID+ findTempName x+ where+ (templateBase, templateExt) = splitExtension template+ findTempName :: Int -> IO (FilePath, Handle)+ findTempName x+ = do let path = tmp_dir </> (templateBase ++ "-" ++ show x) <.> templateExt+ b <- doesFileExist path+ if b then findTempName (x+1)+ else do hnd <- openFile path ReadWriteMode+ return (path, hnd)++openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)+openBinaryTempFile tmp_dir template+ = do x <- getProcessID+ findTempName x+ where+ (templateBase, templateExt) = splitExtension template+ findTempName :: Int -> IO (FilePath, Handle)+ findTempName x+ = do let path = tmp_dir </> (templateBase ++ show x) <.> templateExt+ b <- doesFileExist path+ if b then findTempName (x+1)+ else do hnd <- openBinaryFile path ReadWriteMode+ return (path, hnd)++openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle)+openNewBinaryFile = openBinaryTempFile++getProcessID :: IO Int+getProcessID = fmap fromIntegral c_getpid+#else+-- This is a copy/paste of the openBinaryTempFile definition, but+-- if uses 666 rather than 600 for the permissions. The base library+-- needs to be changed to make this better.+openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle)+openNewBinaryFile dir template = do+ pid <- c_getpid+ findTempName pid+ where+ -- We split off the last extension, so we can use .foo.ext files+ -- for temporary files (hidden on Unix OSes). Unfortunately we're+ -- below filepath in the hierarchy here.+ (prefix,suffix) =+ case break (== '.') $ reverse template of+ -- First case: template contains no '.'s. Just re-reverse it.+ (rev_suffix, "") -> (reverse rev_suffix, "")+ -- Second case: template contains at least one '.'. Strip the+ -- dot from the prefix and prepend it to the suffix (if we don't+ -- do this, the unique number will get added after the '.' and+ -- thus be part of the extension, which is wrong.)+ (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)+ -- Otherwise, something is wrong, because (break (== '.')) should+ -- always return a pair with either the empty string or a string+ -- beginning with '.' as the second component.+ _ -> error "bug in System.IO.openTempFile"++ oflags = rw_flags .|. o_EXCL .|. o_BINARY++#if __GLASGOW_HASKELL__ < 611+ withFilePath = withCString+#endif++ findTempName x = do+ fd <- withFilePath filepath $ \ f ->+ c_open f oflags 0o666+ if fd < 0+ then do+ errno <- getErrno+ if errno == eEXIST+ then findTempName (x+1)+ else ioError (errnoToIOError "openNewBinaryFile" errno Nothing (Just dir))+ else do+ -- TODO: We want to tell fdToHandle what the filepath is,+ -- as any exceptions etc will only be able to report the+ -- fd currently+ h <-+#if __GLASGOW_HASKELL__ >= 609+ fdToHandle fd+#elif __GLASGOW_HASKELL__ <= 606 && defined(mingw32_HOST_OS)+ -- fdToHandle is borked on Windows with ghc-6.6.x+ openFd (fromIntegral fd) Nothing False filepath+ ReadWriteMode True+#else+ fdToHandle (fromIntegral fd)+#endif+ `onException` c_close fd+ return (filepath, h)+ where+ filename = prefix ++ show x ++ suffix+ filepath = dir `combine` filename++ -- FIXME: bits copied from System.FilePath+ combine a b+ | null b = a+ | null a = b+ | last a == pathSeparator = a ++ b+ | otherwise = a ++ [pathSeparator] ++ b++-- FIXME: Should use filepath library+pathSeparator :: Char+#ifdef mingw32_HOST_OS+pathSeparator = '\\'+#else+pathSeparator = '/'+#endif++-- FIXME: Copied from GHC.Handle+std_flags, output_flags, rw_flags :: CInt+std_flags = o_NONBLOCK .|. o_NOCTTY+output_flags = std_flags .|. o_CREAT+rw_flags = output_flags .|. o_RDWR+#endif++createTempDirectory :: FilePath -> String -> IO FilePath+createTempDirectory dir template = do+ pid <- c_getpid+ findTempName pid+ where+ findTempName x = do+ let dirpath = dir </> template ++ show x+ r <- try $ mkPrivateDir dirpath+ case r of+ Right _ -> return dirpath+ Left e | isAlreadyExistsError e -> findTempName (x+1)+ | otherwise -> ioError e++mkPrivateDir :: String -> IO ()+#ifdef mingw32_HOST_OS+mkPrivateDir s = createDirectory s+#else+mkPrivateDir s = System.Posix.createDirectory s 0o700+#endif
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2008, Maximilian Bolingbroke+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.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ System/IO/Temp.hs view
@@ -0,0 +1,46 @@+module System.IO.Temp (+ module System.IO.Temp,+ module Distribution.Compat.TempFile+ ) where++-- NB: this module was extracted directly from "Distribution/Simple/Utils.hs"+-- in a Cabal tree whose most recent commit was on Sun Oct 10 22:00:26+--+-- The files in the Distribution/Compat tree are exact copies of the corresponding+-- file in the Cabal checkout.+++import qualified Control.Exception as Exception++import System.Directory+import System.IO++import Distribution.Compat.TempFile+++-- | Use a temporary filename that doesn't already exist.+--+withTempFile :: FilePath -- ^ Temp dir to create the file in+ -> String -- ^ File name template. See 'openTempFile'.+ -> (FilePath -> Handle -> IO a) -> IO a+withTempFile tmpDir template action =+ Exception.bracket+ (openTempFile tmpDir template)+ (\(name, handle) -> hClose handle >> removeFile name)+ (uncurry action)++-- | Create and use a temporary directory.+--+-- Creates a new temporary directory inside the given directory, making use+-- of the template. The temp directory is deleted after use. For example:+--+-- > withTempDirectory "src" "sdist." $ \tmpDir -> do ...+--+-- The @tmpDir@ will be a new subdirectory of the given directory, e.g.+-- @src/sdist.342@.+--+withTempDirectory :: FilePath -> String -> (FilePath -> IO a) -> IO a+withTempDirectory targetDir template =+ Exception.bracket+ (createTempDirectory targetDir template)+ (removeDirectoryRecursive)
+ temporary.cabal view
@@ -0,0 +1,28 @@+name: temporary+version: 1.0+cabal-version: >= 1.6+synopsis: Portable temporary file and directory support for Windows and Unix, based on code from Cabal+description: The functions for creating temporary files and directories in the base library are quite limited. The unixutils+ package contains some good ones, but they aren't portable to Windows.+ + This library just repackages the Cabal implementations of its own temporary file and folder functions so that+ you can use them without linking against Cabal or depending on it being installed.+category: System, Utils+license: BSD3+license-file: LICENSE+copyright: (c) 2003-2006, Isaac Jones+ (c) 2005-2009, Duncan Coutts+author: Isaac Jones <ijones@syntaxpolice.org>+ Duncan Coutts <duncan@haskell.org>+maintainer: Max Bolingbroke <batterseapower@hotmail.com>+homepage: http://www.github.com/batterseapower/temporary+build-type: Simple++Library+ exposed-modules: System.IO.Temp+ other-modules: Distribution.Compat.Exception+ Distribution.Compat.TempFile+ build-depends: base >= 3 && < 6, filepath >= 1.1 && < 1.2, directory >= 1.0 && < 1.1+ + if !os(windows)+ build-depends: unix >= 2.4 && < 2.5