{-# LANGUAGE CPP #-}
{- arch-tag: Path utilities main file
Copyright (C) 2004-2011 John Goerzen <jgoerzen@complete.org>

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  : stable
   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.Utils ( startswith, alwaysElemRIndex )
#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
import System.Directory
    ( getCurrentDirectory, removeFile, setCurrentDirectory )
import System.Posix.Directory ( createDirectory )
import System.Posix.Temp ( mkstemp )
#else
import System.Directory
import System.IO ( openTempFile )
#endif
import Control.Exception ( finally )
import System.FilePath ( pathSeparator )
import System.IO ( hClose )
import System.IO.HVFS.Utils
    ( SystemFS(SystemFS), recurseDir, recurseDirStat, recursiveRemove )
import System.Path.NameManip
    ( normalise_path, absolute_path_by, guess_dotdot )

{- | 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 :: String -> (String, String)
splitExt String
path =
    let dotindex :: Int
dotindex = Char -> String -> Int
forall a. Eq a => a -> [a] -> Int
alwaysElemRIndex Char
'.' String
path
        slashindex :: Int
slashindex = Char -> String -> Int
forall a. Eq a => a -> [a] -> Int
alwaysElemRIndex Char
pathSeparator String
path
        in
        if Int
dotindex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
slashindex
           then (String
path, String
"")
           else ((Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
dotindex String
path), (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
dotindex String
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 :: String -> String -> Maybe String
absNormPath String
base String
thepath =
    let path :: String
path = String -> String -> String
absolute_path_by String
base String
thepath
        in case String -> Maybe String
guess_dotdot (String -> String
normalise_path String
path) of
                Just String
"." -> String -> Maybe String
forall a. a -> Maybe a
Just [Char
pathSeparator]
                Maybe String
x        -> Maybe String
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 :: String -> String -> Maybe String
secureAbsNormPath String
base String
s = do String
p <- String -> String -> Maybe String
absNormPath String
base String
s
                              if String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
startswith String
base String
p
                                 then String -> Maybe String
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
                                 else String -> Maybe String
forall a. String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""

{- | 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 :: String -> IO String
mktmpdir String
x =
    do (String, Handle)
y <- String -> IO (String, Handle)
mkstemp String
x
       let (String
dirname, Handle
h) = (String, Handle)
y
       Handle -> IO ()
hClose Handle
h
       String -> IO ()
removeFile String
dirname
       String -> FileMode -> IO ()
createDirectory String
dirname FileMode
0o700
       String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
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 :: forall a. String -> (String -> IO a) -> IO a
brackettmpdir String
x String -> IO a
action = do String
tmpdir <- String -> IO String
mktmpdir String
x
                            IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
finally (String -> IO a
action String
tmpdir)
                                    (SystemFS -> String -> IO ()
forall a. HVFS a => a -> String -> IO ()
recursiveRemove SystemFS
SystemFS String
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 :: forall a. String -> IO a -> IO a
bracketCWD String
fp IO a
action =
    do String
oldcwd <- IO String
getCurrentDirectory
       String -> IO ()
setCurrentDirectory String
fp
       IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
finally IO a
action (String -> IO ()
setCurrentDirectory String
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 :: forall a. String -> IO a -> IO a
brackettmpdirCWD String
template IO a
action =
    String -> (String -> IO a) -> IO a
forall a. String -> (String -> IO a) -> IO a
brackettmpdir String
template (\String
newdir -> String -> IO a -> IO a
forall a. String -> IO a -> IO a
bracketCWD String
newdir IO a
action)