{-# LANGUAGE CPP #-}
module Darcs.Util.File
    (
    -- * Files and directories
      getFileStatus
    , withCurrentDirectory
    , doesDirectoryReallyExist
    , removeFileMayNotExist
    , getRecursiveContents
    , getRecursiveContentsFullPath
    -- * OS-dependent special directories
    , xdgCacheDir
    , osxCacheDir
    ) where

import Darcs.Prelude

import Control.Exception ( bracket )
import Control.Monad ( when, unless, forM )

import Data.List ( lookup )

import System.Environment ( getEnvironment )
import System.Directory ( removeFile, getHomeDirectory,
                          getAppUserDataDirectory, doesDirectoryExist,
                          createDirectory, listDirectory )
import System.IO.Error ( catchIOError )
import System.Posix.Files( getSymbolicLinkStatus, FileStatus, isDirectory )
#ifndef WIN32
import System.Posix.Files( setFileMode, ownerModes )
#endif
import System.FilePath.Posix ( (</>) )

import Darcs.Util.Exception ( catchall, catchNonExistence )
import Darcs.Util.Path( FilePathLike, getCurrentDirectory, setCurrentDirectory, toFilePath )

withCurrentDirectory :: FilePathLike p
                     => p
                     -> IO a
                     -> IO a
withCurrentDirectory :: p -> IO a -> IO a
withCurrentDirectory p
name IO a
m =
    IO AbsolutePath
-> (AbsolutePath -> IO ()) -> (AbsolutePath -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (do AbsolutePath
cwd <- IO AbsolutePath
getCurrentDirectory
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (p -> FilePath
forall a. FilePathLike a => a -> FilePath
toFilePath p
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"") (p -> IO ()
forall p. FilePathLike p => p -> IO ()
setCurrentDirectory p
name)
            AbsolutePath -> IO AbsolutePath
forall (m :: * -> *) a. Monad m => a -> m a
return AbsolutePath
cwd)
        (\AbsolutePath
oldwd -> AbsolutePath -> IO ()
forall p. FilePathLike p => p -> IO ()
setCurrentDirectory AbsolutePath
oldwd IO () -> IO () -> IO ()
forall a. IO a -> IO a -> IO a
`catchall` () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        (IO a -> AbsolutePath -> IO a
forall a b. a -> b -> a
const IO a
m)

getFileStatus :: FilePath -> IO (Maybe FileStatus)
getFileStatus :: FilePath -> IO (Maybe FileStatus)
getFileStatus FilePath
f =
  FileStatus -> Maybe FileStatus
forall a. a -> Maybe a
Just (FileStatus -> Maybe FileStatus)
-> IO FileStatus -> IO (Maybe FileStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO FileStatus
getSymbolicLinkStatus FilePath
f IO (Maybe FileStatus)
-> (IOError -> IO (Maybe FileStatus)) -> IO (Maybe FileStatus)
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\IOError
_-> Maybe FileStatus -> IO (Maybe FileStatus)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileStatus
forall a. Maybe a
Nothing)

doesDirectoryReallyExist :: FilePath -> IO Bool
doesDirectoryReallyExist :: FilePath -> IO Bool
doesDirectoryReallyExist FilePath
f =
    IO Bool -> Bool -> IO Bool
forall a. IO a -> a -> IO a
catchNonExistence (FileStatus -> Bool
isDirectory (FileStatus -> Bool) -> IO FileStatus -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO FileStatus
getSymbolicLinkStatus FilePath
f) Bool
False

removeFileMayNotExist :: FilePathLike p => p -> IO ()
removeFileMayNotExist :: p -> IO ()
removeFileMayNotExist p
f = IO () -> () -> IO ()
forall a. IO a -> a -> IO a
catchNonExistence (FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ p -> FilePath
forall a. FilePathLike a => a -> FilePath
toFilePath p
f) ()

-- |osxCacheDir assumes @~/Library/Caches/@ exists.
osxCacheDir :: IO (Maybe FilePath)
osxCacheDir :: IO (Maybe FilePath)
osxCacheDir = do
    FilePath
home <- IO FilePath
getHomeDirectory
    Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
home FilePath -> FilePath -> FilePath
</> FilePath
"Library" FilePath -> FilePath -> FilePath
</> FilePath
"Caches"
    IO (Maybe FilePath) -> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a. IO a -> IO a -> IO a
`catchall` Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing

-- |xdgCacheDir returns the $XDG_CACHE_HOME environment variable,
-- or @~/.cache@ if undefined. See the FreeDesktop specification:
-- http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
xdgCacheDir :: IO (Maybe FilePath)
xdgCacheDir :: IO (Maybe FilePath)
xdgCacheDir = do
    [(FilePath, FilePath)]
env <- IO [(FilePath, FilePath)]
getEnvironment
    FilePath
d <- case FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
"XDG_CACHE_HOME" [(FilePath, FilePath)]
env of
           Just FilePath
d  -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
d
           Maybe FilePath
Nothing -> FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"cache"
    Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
d

    -- If directory does not exist, create it with permissions 0700
    -- as specified by the FreeDesktop standard.
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do FilePath -> IO ()
createDirectory FilePath
d
#ifndef WIN32
    -- see http://bugs.darcs.net/issue2334
                       FilePath -> FileMode -> IO ()
setFileMode FilePath
d FileMode
ownerModes
#endif
    Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
d
    IO (Maybe FilePath) -> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a. IO a -> IO a -> IO a
`catchall` Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing

-- |getRecursiveContents returns all files under topdir that aren't
-- directories.
getRecursiveContents :: FilePath -> IO [FilePath]
getRecursiveContents :: FilePath -> IO [FilePath]
getRecursiveContents FilePath
topdir = do
  [FilePath]
entries <- FilePath -> IO [FilePath]
listDirectory FilePath
topdir
  [[FilePath]]
paths <- [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
entries ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall a b. (a -> b) -> a -> b
$ \FilePath
name -> do
    let path :: FilePath
path = FilePath
topdir FilePath -> FilePath -> FilePath
</> FilePath
name
    Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
    if Bool
isDir
      then FilePath -> IO [FilePath]
getRecursiveContents FilePath
path
      else [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
name]
  [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
paths)

-- |getRecursiveContentsFullPath returns all files under topdir
-- that aren't directories.
-- Unlike getRecursiveContents this function returns the full path.
getRecursiveContentsFullPath :: FilePath -> IO [FilePath]
getRecursiveContentsFullPath :: FilePath -> IO [FilePath]
getRecursiveContentsFullPath FilePath
topdir = do
  [FilePath]
entries <- FilePath -> IO [FilePath]
listDirectory FilePath
topdir
  [[FilePath]]
paths <- [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
entries ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall a b. (a -> b) -> a -> b
$ \FilePath
name -> do
    let path :: FilePath
path = FilePath
topdir FilePath -> FilePath -> FilePath
</> FilePath
name
    Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
    if Bool
isDir
      then FilePath -> IO [FilePath]
getRecursiveContentsFullPath FilePath
path
      else [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
path]
  [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
paths)