diff options
author | 2012-08-16 16:50:21 -0700 | |
---|---|---|
committer | 2012-08-16 16:50:21 -0700 | |
commit | 95bfbcd3e3952dc1e22fbc313394c54c3ababad4 (patch) | |
tree | ce667179b7e6403e7e57c5e228844ec81588e1f3 | |
parent | b81833705466e63641a524a3bd7050075de8a1be (diff) |
make canCheckSymlink check in a parent directory if the directory DNE
-rw-r--r-- | Assistant/WebApp/Configurators.hs | 15 |
1 files changed, 10 insertions, 5 deletions
diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs index 14da2ddbf..67939fffb 100644 --- a/Assistant/WebApp/Configurators.hs +++ b/Assistant/WebApp/Configurators.hs @@ -133,6 +133,7 @@ checkRepositoryPath p = do ) expandTilde home ('~':'/':path) = home </> path expandTilde _ path = path + {- On first run, if run in the home directory, default to putting it in - ~/Desktop/annex, when a Desktop directory exists, and ~/annex otherwise. @@ -350,9 +351,13 @@ canWrite dir = do {- Checks if a directory is on a filesystem that supports symlinks. -} canMakeSymlink :: FilePath -> IO Bool -canMakeSymlink dir = catchBoolIO $ do - createSymbolicLink link link - removeLink link - return True +canMakeSymlink dir = ifM (doesDirectoryExist dir) + ( catchBoolIO $ test dir + , canMakeSymlink (parentDir dir) + ) where - link = dir </> "delete.me" + test d = do + let link = d </> "delete.me" + createSymbolicLink link link + removeLink link + return True |