{-# LANGUAGE CPP #-}
module Darcs.Util.File
(
getFileStatus
, withCurrentDirectory
, doesDirectoryReallyExist
, removeFileMayNotExist
, getRecursiveContents
, getRecursiveContentsFullPath
, 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 :: forall p a. FilePathLike p => 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 -> String
forall a. FilePathLike a => a -> String
toFilePath p
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") (p -> IO ()
forall p. FilePathLike p => p -> IO ()
setCurrentDirectory p
name)
AbsolutePath -> IO AbsolutePath
forall a. a -> IO a
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 a. a -> IO a
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 :: String -> IO (Maybe FileStatus)
getFileStatus String
f =
FileStatus -> Maybe FileStatus
forall a. a -> Maybe a
Just (FileStatus -> Maybe FileStatus)
-> IO FileStatus -> IO (Maybe FileStatus)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO FileStatus
getSymbolicLinkStatus String
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileStatus
forall a. Maybe a
Nothing)
doesDirectoryReallyExist :: FilePath -> IO Bool
doesDirectoryReallyExist :: String -> IO Bool
doesDirectoryReallyExist String
f =
IO Bool -> Bool -> IO Bool
forall a. IO a -> a -> IO a
catchNonExistence (FileStatus -> Bool
isDirectory (FileStatus -> Bool) -> IO FileStatus -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO FileStatus
getSymbolicLinkStatus String
f) Bool
False
removeFileMayNotExist :: FilePathLike p => p -> IO ()
removeFileMayNotExist :: forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist p
f = IO () -> () -> IO ()
forall a. IO a -> a -> IO a
catchNonExistence (String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ p -> String
forall a. FilePathLike a => a -> String
toFilePath p
f) ()
osxCacheDir :: IO (Maybe FilePath)
osxCacheDir :: IO (Maybe String)
osxCacheDir = do
String
home <- IO String
getHomeDirectory
Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
home String -> String -> String
</> String
"Library" String -> String -> String
</> String
"Caches"
IO (Maybe String) -> IO (Maybe String) -> IO (Maybe String)
forall a. IO a -> IO a -> IO a
`catchall` Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
xdgCacheDir :: IO (Maybe FilePath)
xdgCacheDir :: IO (Maybe String)
xdgCacheDir = do
[(String, String)]
env <- IO [(String, String)]
getEnvironment
String
d <- case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"XDG_CACHE_HOME" [(String, String)]
env of
Just String
d -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
d
Maybe String
Nothing -> String -> IO String
getAppUserDataDirectory String
"cache"
Bool
exists <- String -> IO Bool
doesDirectoryExist String
d
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 String -> IO ()
createDirectory String
d
#ifndef WIN32
String -> FileMode -> IO ()
setFileMode String
d FileMode
ownerModes
#endif
Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
d
IO (Maybe String) -> IO (Maybe String) -> IO (Maybe String)
forall a. IO a -> IO a -> IO a
`catchall` Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
getRecursiveContents :: FilePath -> IO [FilePath]
getRecursiveContents :: String -> IO [String]
getRecursiveContents String
topdir = do
[String]
entries <- String -> IO [String]
listDirectory String
topdir
[[String]]
paths <- [String] -> (String -> IO [String]) -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
entries ((String -> IO [String]) -> IO [[String]])
-> (String -> IO [String]) -> IO [[String]]
forall a b. (a -> b) -> a -> b
$ \String
name -> do
let path :: String
path = String
topdir String -> String -> String
</> String
name
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
path
if Bool
isDir
then String -> IO [String]
getRecursiveContents String
path
else [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
name]
[String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
paths)
getRecursiveContentsFullPath :: FilePath -> IO [FilePath]
getRecursiveContentsFullPath :: String -> IO [String]
getRecursiveContentsFullPath String
topdir = do
[String]
entries <- String -> IO [String]
listDirectory String
topdir
[[String]]
paths <- [String] -> (String -> IO [String]) -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
entries ((String -> IO [String]) -> IO [[String]])
-> (String -> IO [String]) -> IO [[String]]
forall a b. (a -> b) -> a -> b
$ \String
name -> do
let path :: String
path = String
topdir String -> String -> String
</> String
name
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
path
if Bool
isDir
then String -> IO [String]
getRecursiveContentsFullPath String
path
else [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
path]
[String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
paths)