-----------------------------------------------------------------------------
-- |
-- Module      :  RawFilePath.Directory
-- Copyright   :  (C) 2004 The University of Glasgow. (C) 2017 XT et al.
-- License     :  BSD-style (see the LICENSE file)
--
-- Maintainer  :  e@xtendo.org
-- Stability   :  stable
-- Portability :  POSIX
--
-- This is the module for the 'RawFilePath' version of functions in the
-- @directory@ package.
--
-----------------------------------------------------------------------------

module RawFilePath.Directory
    ( RawFilePath
    -- ** Nondestructive (read-only)
    , doesPathExist
    , doesFileExist
    , doesDirectoryExist
    , getHomeDirectory
    , getTemporaryDirectory
    , listDirectory
    , getDirectoryFiles
    , getDirectoryFilesRecursive
    -- ** Destructive
    , createDirectory
    , createDirectoryIfMissing
    , removeFile
    , tryRemoveFile
    , removeDirectory
    , removeDirectoryRecursive
    ) where

import RawFilePath.Import

-- extra modules

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified System.Posix.ByteString as U -- U for Unix

-- local modules

import RawFilePath.Directory.Internal

-- | Test whether the given path points to an existing filesystem object.  If
-- the user lacks necessary permissions to search the parent directories, this
-- function may return false even if the file does actually exist.
doesPathExist :: RawFilePath -> IO Bool
doesPathExist :: RawFilePath -> IO Bool
doesPathExist RawFilePath
path = (Bool
True Bool -> IO FileStatus -> IO Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RawFilePath -> IO FileStatus
U.getFileStatus RawFilePath
path) IO Bool -> (IOError -> IO Bool) -> IO Bool
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError`
      IO Bool -> IOError -> IO Bool
forall a b. a -> b -> a
const (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

-- | Return 'True' if the argument file exists and is either a directory or a
-- symbolic link to a directory, and 'False' otherwise.
doesDirectoryExist :: RawFilePath -> IO Bool
doesDirectoryExist :: RawFilePath -> IO Bool
doesDirectoryExist RawFilePath
path = RawFilePath -> IO Bool
pathIsDirectory RawFilePath
path IO Bool -> (IOError -> IO Bool) -> IO Bool
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError`
    IO Bool -> IOError -> IO Bool
forall a b. a -> b -> a
const (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

-- | Return 'True' if the argument file exists and is not a directory, and
-- 'False' otherwise.
doesFileExist :: RawFilePath -> IO Bool
doesFileExist :: RawFilePath -> IO Bool
doesFileExist RawFilePath
path = (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawFilePath -> IO Bool
pathIsDirectory RawFilePath
path) IO Bool -> (IOError -> IO Bool) -> IO Bool
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError`
    IO Bool -> IOError -> IO Bool
forall a b. a -> b -> a
const (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

-- | Returns the current user's home directory. More specifically, the value
-- of the @HOME@ environment variable.
--
-- The directory returned is expected to be writable by the current user, but
-- note that it isn't generally considered good practice to store
-- application-specific data here; use 'getXdgDirectory' or
-- 'getAppUserDataDirectory' instead.
--
-- The operation may fail with:
--
-- * 'UnsupportedOperation'
-- The operating system has no notion of home directory.
--
-- * 'isDoesNotExistError'
-- The home directory for the current user does not exist, or
-- cannot be found.
getHomeDirectory :: IO (Maybe RawFilePath)
getHomeDirectory :: IO (Maybe RawFilePath)
getHomeDirectory = RawFilePath -> IO (Maybe RawFilePath)
U.getEnv RawFilePath
"HOME"

-- | Return the current directory for temporary files.  It first returns the
-- value of the @TMPDIR@ environment variable or \"\/tmp\" if the variable
-- isn\'t defined.
getTemporaryDirectory :: IO ByteString
getTemporaryDirectory :: IO RawFilePath
getTemporaryDirectory = RawFilePath -> Maybe RawFilePath -> RawFilePath
forall a. a -> Maybe a -> a
fromMaybe RawFilePath
"/tmp" (Maybe RawFilePath -> RawFilePath)
-> IO (Maybe RawFilePath) -> IO RawFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawFilePath -> IO (Maybe RawFilePath)
U.getEnv RawFilePath
"TMPDIR"

-- | Get a list of files in the specified directory, excluding "." and ".."
--
-- > ghci> listDirectory "/"
-- > ["home","sys","var","opt","lib64","sbin","usr","srv","dev","lost+found","bin","tmp","run","root","boot","proc","etc","lib"]
listDirectory
    :: RawFilePath -- ^ The path of directory to inspect
    -> IO [RawFilePath] -- ^ A list of files in the directory
listDirectory :: RawFilePath -> IO [RawFilePath]
listDirectory RawFilePath
dirPath = (RawFilePath -> Bool) -> [RawFilePath] -> [RawFilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter RawFilePath -> Bool
forall a. (Eq a, IsString a) => a -> Bool
f ([RawFilePath] -> [RawFilePath])
-> IO [RawFilePath] -> IO [RawFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawFilePath -> IO [RawFilePath]
getDirectoryFiles RawFilePath
dirPath
  where
    f :: a -> Bool
f a
p = a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
"." Bool -> Bool -> Bool
&& a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
".."

-- | Get a list of files in the specified directory, including "." and ".."
--
-- > ghci> getDirectoryFiles "/"
-- > ["home","sys","var","opt","..","lib64","sbin","usr","srv","dev","lost+found","mnt","bin","tmp","run","root","boot",".","proc","etc","lib"]
getDirectoryFiles
    :: RawFilePath -- ^ The path of directory to inspect
    -> IO [RawFilePath] -- ^ A list of files in the directory
getDirectoryFiles :: RawFilePath -> IO [RawFilePath]
getDirectoryFiles RawFilePath
dirPath = IO DirStream
-> (DirStream -> IO ())
-> (DirStream -> IO [RawFilePath])
-> IO [RawFilePath]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO DirStream
open DirStream -> IO ()
close DirStream -> IO [RawFilePath]
repeatRead
  where
    open :: IO DirStream
open = RawFilePath -> IO DirStream
U.openDirStream RawFilePath
dirPath
    close :: DirStream -> IO ()
close = DirStream -> IO ()
U.closeDirStream
    repeatRead :: DirStream -> IO [RawFilePath]
repeatRead DirStream
stream = do
        RawFilePath
d <- DirStream -> IO RawFilePath
U.readDirStream DirStream
stream
        if RawFilePath -> Int
B.length RawFilePath
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [RawFilePath] -> IO [RawFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else do
            [RawFilePath]
rest <- DirStream -> IO [RawFilePath]
repeatRead DirStream
stream
            [RawFilePath] -> IO [RawFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RawFilePath] -> IO [RawFilePath])
-> [RawFilePath] -> IO [RawFilePath]
forall a b. (a -> b) -> a -> b
$ RawFilePath
d RawFilePath -> [RawFilePath] -> [RawFilePath]
forall a. a -> [a] -> [a]
: [RawFilePath]
rest

-- | Recursively get all files in all subdirectories of the specified
-- directory.
--
-- > *System.RawFilePath> getDirectoryFilesRecursive "src"
-- > ["src/System/RawFilePath.hs"]
getDirectoryFilesRecursive
    :: RawFilePath -- ^ The path of directory to inspect
    -> IO [RawFilePath] -- ^ A list of relative paths
getDirectoryFilesRecursive :: RawFilePath -> IO [RawFilePath]
getDirectoryFilesRecursive RawFilePath
path = do
    [RawFilePath]
names <- (RawFilePath -> RawFilePath) -> [RawFilePath] -> [RawFilePath]
forall a b. (a -> b) -> [a] -> [b]
map (RawFilePath
path RawFilePath -> RawFilePath -> RawFilePath
+/+) ([RawFilePath] -> [RawFilePath])
-> ([RawFilePath] -> [RawFilePath])
-> [RawFilePath]
-> [RawFilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RawFilePath -> Bool) -> [RawFilePath] -> [RawFilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\RawFilePath
x -> RawFilePath
x RawFilePath -> RawFilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= RawFilePath
".." Bool -> Bool -> Bool
&& RawFilePath
x RawFilePath -> RawFilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= RawFilePath
".") ([RawFilePath] -> [RawFilePath])
-> IO [RawFilePath] -> IO [RawFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        RawFilePath -> IO [RawFilePath]
getDirectoryFiles RawFilePath
path
    [[RawFilePath]]
inspectedNames <- (RawFilePath -> IO [RawFilePath])
-> [RawFilePath] -> IO [[RawFilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RawFilePath -> IO [RawFilePath]
inspect [RawFilePath]
names
    [RawFilePath] -> IO [RawFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RawFilePath] -> IO [RawFilePath])
-> [RawFilePath] -> IO [RawFilePath]
forall a b. (a -> b) -> a -> b
$ [[RawFilePath]] -> [RawFilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[RawFilePath]]
inspectedNames
  where
    inspect :: RawFilePath -> IO [RawFilePath]
    inspect :: RawFilePath -> IO [RawFilePath]
inspect RawFilePath
p = (FileStatus -> Bool) -> IO FileStatus -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileStatus -> Bool
U.isDirectory (RawFilePath -> IO FileStatus
U.getFileStatus RawFilePath
p) IO Bool -> (Bool -> IO [RawFilePath]) -> IO [RawFilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
i -> if Bool
i
        then RawFilePath -> IO [RawFilePath]
getDirectoryFilesRecursive RawFilePath
p else [RawFilePath] -> IO [RawFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [RawFilePath
p]

-- | Create a new directory.
--
-- > ghci> createDirectory "/tmp/mydir"
-- > ghci> getDirectoryFiles "/tmp/mydir"
-- > [".",".."]
-- > ghci> createDirectory "/tmp/mydir/anotherdir"
-- > ghci> getDirectoryFiles "/tmp/mydir"
-- > [".","..","anotherdir"]
createDirectory :: RawFilePath -> IO ()
createDirectory :: RawFilePath -> IO ()
createDirectory RawFilePath
dir = RawFilePath -> FileMode -> IO ()
U.createDirectory RawFilePath
dir FileMode
0o755

-- | Create a new directory if it does not already exist.  If the first
-- argument is 'True' the function will also create all parent directories
-- when they are missing.
createDirectoryIfMissing
    :: Bool -- ^ Create parent directories or not
    -> RawFilePath -- ^ The path of the directory to create
    -> IO ()
createDirectoryIfMissing :: Bool -> RawFilePath -> IO ()
createDirectoryIfMissing Bool
willCreateParents RawFilePath
path
    | Bool
willCreateParents = [RawFilePath] -> IO ()
createDirs [RawFilePath]
parents
    | Bool
otherwise = RawFilePath -> (IOError -> IO ()) -> IO ()
createDir RawFilePath
path IOError -> IO ()
forall a. IOError -> IO a
ioError
  where
    createDirs :: [RawFilePath] -> IO ()
createDirs []         = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    createDirs [RawFilePath
dir]   = RawFilePath -> (IOError -> IO ()) -> IO ()
createDir RawFilePath
dir IOError -> IO ()
forall a. IOError -> IO a
ioError
    createDirs (RawFilePath
dir : [RawFilePath]
dirs) = RawFilePath -> (IOError -> IO ()) -> IO ()
createDir RawFilePath
dir ((IOError -> IO ()) -> IO ()) -> (IOError -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ IOError
_ ->
        -- Create parent directories (recursively) only when they are missing
        [RawFilePath] -> IO ()
createDirs [RawFilePath]
dirs IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RawFilePath -> (IOError -> IO ()) -> IO ()
createDir RawFilePath
dir IOError -> IO ()
forall a. IOError -> IO a
ioError
    createDir :: RawFilePath -> (IOError -> IO ()) -> IO ()
createDir RawFilePath
dir IOError -> IO ()
notExistHandler = IO () -> IO (Either IOError ())
forall a. IO a -> IO (Either IOError a)
tryIOError (RawFilePath -> IO ()
createDirectory RawFilePath
dir) IO (Either IOError ()) -> (Either IOError () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case 
        Right ()                   -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Left  IOError
e
          | IOError -> Bool
isDoesNotExistError  IOError
e -> IOError -> IO ()
notExistHandler IOError
e
          -- createDirectory (and indeed POSIX mkdir) does not distinguish
          -- between a dir already existing and a file already existing. So we
          -- check for it here. Unfortunately there is a slight race condition
          -- here, but we think it is benign. It could report an exeption in
          -- the case that the dir did exist but another process deletes the
          -- directory and creates a file in its place before we can check
          -- that the directory did indeed exist.  We also follow this path
          -- when we get a permissions error, as trying to create "." when in
          -- the root directory on Windows fails with
          --     CreateDirectory ".": permission denied (Access is denied.)
          -- This caused GHCi to crash when loading a module in the root
          -- directory.
          | IOError -> Bool
isAlreadyExistsError IOError
e
         Bool -> Bool -> Bool
|| IOError -> Bool
isPermissionError    IOError
e -> do
              Bool
canIgnore <- IO Bool -> (IOError -> IO Bool) -> IO Bool
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError (RawFilePath -> IO Bool
pathIsDirectory RawFilePath
dir) ((IOError -> IO Bool) -> IO Bool)
-> (IOError -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ IOError
_ ->
                Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (IOError -> Bool
isAlreadyExistsError IOError
e)
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
canIgnore (IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
e)
          | Bool
otherwise              -> IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
e
    parents :: [RawFilePath]
parents = [RawFilePath] -> [RawFilePath]
forall a. [a] -> [a]
reverse ([RawFilePath] -> [RawFilePath]) -> [RawFilePath] -> [RawFilePath]
forall a b. (a -> b) -> a -> b
$ (RawFilePath -> RawFilePath -> RawFilePath)
-> [RawFilePath] -> [RawFilePath]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 RawFilePath -> RawFilePath -> RawFilePath
(+/+) ([RawFilePath] -> [RawFilePath]) -> [RawFilePath] -> [RawFilePath]
forall a b. (a -> b) -> a -> b
$ Word8 -> RawFilePath -> [RawFilePath]
B.split (Char -> Word8
w8 Char
'/') (RawFilePath -> [RawFilePath]) -> RawFilePath -> [RawFilePath]
forall a b. (a -> b) -> a -> b
$ RawFilePath -> RawFilePath
stripSlash RawFilePath
path

-- | Remove a file. This function internally calls @unlink@. If the file does
-- not exist, an exception is thrown.
removeFile :: RawFilePath -> IO ()
removeFile :: RawFilePath -> IO ()
removeFile = RawFilePath -> IO ()
U.removeLink

-- | A function that "tries" to remove a file. If the file does not exist,
-- nothing happens.
tryRemoveFile :: RawFilePath -> IO ()
tryRemoveFile :: RawFilePath -> IO ()
tryRemoveFile RawFilePath
path = IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError (RawFilePath -> IO ()
U.removeLink RawFilePath
path) ((IOError -> IO ()) -> IO ()) -> (IOError -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    \ IOError
e -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (IOError -> Bool
isDoesNotExistError IOError
e) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
e

-- | Remove a directory. The target directory needs to be empty; Otherwise an
-- exception will be thrown.
removeDirectory :: RawFilePath -> IO ()
removeDirectory :: RawFilePath -> IO ()
removeDirectory = RawFilePath -> IO ()
U.removeDirectory

-- | Remove an existing directory /dir/ together with its contents and
-- subdirectories. Within this directory, symbolic links are removed without
-- affecting their targets.
removeDirectoryRecursive :: RawFilePath -> IO ()
removeDirectoryRecursive :: RawFilePath -> IO ()
removeDirectoryRecursive RawFilePath
path =
  (IOError -> String -> IOError
`ioeAddLocation` String
"removeDirectoryRecursive") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
    FileStatus
m <- RawFilePath -> IO FileStatus
U.getSymbolicLinkStatus RawFilePath
path
    case FileStatus -> FileType
fileTypeFromMetadata FileStatus
m of
      FileType
Directory ->
        RawFilePath -> IO ()
removeContentsRecursive RawFilePath
path
      FileType
DirectoryLink ->
        IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError
err IOError -> String -> IOError
`ioeSetErrorString` String
"is a directory symbolic link")
      FileType
_ ->
        IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError
err IOError -> String -> IOError
`ioeSetErrorString` String
"not a directory")
  where err :: IOError
err = IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
InappropriateType String
"" Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just (RawFilePath -> String
B8.unpack RawFilePath
path))

-- | Remove an existing file or directory at /path/ together with its contents
-- and subdirectories. Symbolic links are removed without affecting their the
-- targets.
removePathRecursive :: RawFilePath -> IO ()
removePathRecursive :: RawFilePath -> IO ()
removePathRecursive RawFilePath
path =
  (IOError -> String -> IOError
`ioeAddLocation` String
"removePathRecursive") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
    FileStatus
m <- RawFilePath -> IO FileStatus
U.getSymbolicLinkStatus RawFilePath
path
    case FileStatus -> FileType
fileTypeFromMetadata FileStatus
m of
      FileType
Directory     -> RawFilePath -> IO ()
removeContentsRecursive RawFilePath
path
      FileType
DirectoryLink -> RawFilePath -> IO ()
U.removeDirectory RawFilePath
path
      FileType
_             -> RawFilePath -> IO ()
U.removeLink RawFilePath
path

-- | Remove the contents of the directory /dir/ recursively. Symbolic links
-- are removed without affecting their the targets.
removeContentsRecursive :: RawFilePath -> IO ()
removeContentsRecursive :: RawFilePath -> IO ()
removeContentsRecursive RawFilePath
path =
  (IOError -> String -> IOError
`ioeAddLocation` String
"removeContentsRecursive") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
    [RawFilePath]
cont <- RawFilePath -> IO [RawFilePath]
listDirectory RawFilePath
path
    (RawFilePath -> IO ()) -> [RawFilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RawFilePath -> IO ()
removePathRecursive [RawFilePath
path RawFilePath -> RawFilePath -> RawFilePath
+/+ RawFilePath
x | RawFilePath
x <- [RawFilePath]
cont]
    RawFilePath -> IO ()
U.removeDirectory RawFilePath
path


w8 :: Char -> Word8
w8 :: Char -> Word8
w8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

stripSlash :: ByteString -> ByteString
stripSlash :: RawFilePath -> RawFilePath
stripSlash RawFilePath
p = if RawFilePath -> Word8
B.last RawFilePath
p Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
w8 Char
'/' then RawFilePath -> RawFilePath
B.init RawFilePath
p else RawFilePath
p

pathIsDirectory :: RawFilePath -> IO Bool
pathIsDirectory :: RawFilePath -> IO Bool
pathIsDirectory RawFilePath
path = FileStatus -> Bool
U.isDirectory (FileStatus -> Bool) -> IO FileStatus -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawFilePath -> IO FileStatus
U.getFileStatus RawFilePath
path


-- An extremely simplistic approach for path concatenation.
infixr 5  +/+
(+/+) :: RawFilePath -> RawFilePath -> RawFilePath
RawFilePath
a +/+ :: RawFilePath -> RawFilePath -> RawFilePath
+/+ RawFilePath
b = [RawFilePath] -> RawFilePath
forall a. Monoid a => [a] -> a
mconcat [RawFilePath
a, RawFilePath
"/", RawFilePath
b]