{-# LANGUAGE CPP #-} {- arch-tag: Path utilities main file Copyright (C) 2004-2011 John Goerzen All rights reserved. For license and copyright information, see the file LICENSE -} {- | Module : System.Path Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause Stability : provisional Portability: portable This module provides various helpful utilities for dealing with path and file names, directories, and related support. Written by John Goerzen, jgoerzen\@complete.org -} module System.Path(-- * Name processing splitExt, absNormPath, secureAbsNormPath, -- * Directory Processing recurseDir, recurseDirStat, recursiveRemove, bracketCWD, -- * Temporary Directories mktmpdir, brackettmpdir, brackettmpdirCWD ) where import Data.List import Data.List.Utils #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) import System.Directory hiding (createDirectory) import System.Posix.Directory (createDirectory) import System.Posix.Files import System.Posix.Temp #else import System.Directory #endif import Control.Exception import System.FilePath (isPathSeparator, pathSeparator, ()) import System.IO import System.IO.HVFS.Utils import System.Path.NameManip {- | Splits a pathname into a tuple representing the root of the name and the extension. The extension is considered to be all characters from the last dot after the last slash to the end. Either returned string may be empty. -} -- FIXME: See 6.4 API when released. splitExt :: String -> (String, String) splitExt path = let dotindex = alwaysElemRIndex '.' path slashindex = alwaysElemRIndex pathSeparator path in if dotindex <= slashindex then (path, "") else ((take dotindex path), (drop dotindex path)) {- | Make an absolute, normalized version of a path with all double slashes, dot, and dotdot entries removed. The first parameter is the base for the absolut calculation; in many cases, it would correspond to the current working directory. The second parameter is the pathname to transform. If it is already absolute, the first parameter is ignored. Nothing may be returned if there's an error; for instance, too many @..@ entries for the given path. -} absNormPath :: String -- ^ Absolute path for use with starting directory -> String -- ^ The path name to make absolute -> Maybe String -- ^ Result absNormPath base thepath = let abs = absolute_path_by base thepath in case guess_dotdot (normalise_path abs) of Just "." -> Just [pathSeparator] x -> x {- | Like absNormPath, but returns Nothing if the generated result is not the passed base path or a subdirectory thereof. -} secureAbsNormPath :: String -- ^ Absolute path for use with starting directory -> String -- ^ The path to make absolute -> Maybe String secureAbsNormPath base s = do p <- absNormPath base s if startswith base p then return p else fail "" {- | Creates a temporary directory for your use. The passed string should be a template suitable for mkstemp; that is, end with @\"XXXXXX\"@. Your string should probably start with the value returned from System.Directory.getTemporaryDirectory. The name of the directory created will be returned. -} mktmpdir :: String -> IO String #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) mktmpdir x = do y <- mkstemp x let (dirname, h) = y hClose h removeFile dirname createDirectory dirname 0o700 return dirname #else mktmpdir x = do (fp, h) <- openTempFile "" x hClose h removeFile fp createDirectory fp return fp #endif {- | Creates a temporary directory for your use via 'mktmpdir', runs the specified action (passing in the directory name), then removes the directory and all its contents when the action completes (or raises an exception. -} brackettmpdir :: String -> (String -> IO a) -> IO a brackettmpdir x action = do tmpdir <- mktmpdir x finally (action tmpdir) (recursiveRemove SystemFS tmpdir) {- | Changes the current working directory to the given path, executes the given I\/O action, then changes back to the original directory, even if the I\/O action raised an exception. -} bracketCWD :: FilePath -> IO a -> IO a bracketCWD fp action = do oldcwd <- getCurrentDirectory setCurrentDirectory fp finally action (setCurrentDirectory oldcwd) {- | Runs the given I\/O action with the CWD set to the given tmp dir, removing the tmp dir and changing CWD back afterwards, even if there was an exception. -} brackettmpdirCWD :: String -> IO a -> IO a brackettmpdirCWD template action = brackettmpdir template (\newdir -> bracketCWD newdir action)