From fede52ac05b4aa3a40e0871ff98f1b95c56e34ff Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 28 Sep 2012 16:04:49 -0400 Subject: [PATCH] if the webapp is started with a cwd the user can't write to, don't suggest it Fall back to somewhere under $HOME instead. I had a report that git-annex.app on OSX was coming up with "/" as the suggested location on first run. --- Assistant/WebApp/Configurators/Local.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index 072af18c11..f389af00a0 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -90,19 +90,22 @@ checkRepositoryPath p = do {- On first run, if run in the home directory, default to putting it in - ~/Desktop/annex, when a Desktop directory exists, and ~/annex otherwise. - - - If run in another directory, the user probably wants to put it there. -} + - If run in another directory, that the user can write to, + - the user probably wants to put it there. -} defaultRepositoryPath :: Bool -> IO FilePath defaultRepositoryPath firstrun = do cwd <- liftIO $ getCurrentDirectory home <- myHomeDir if home == cwd && firstrun - then do + then inhome + else ifM (canWrite cwd) ( return cwd, inhome ) + where + inhome = do desktop <- userDesktopDir ifM (doesDirectoryExist desktop) ( relHome $ desktop gitAnnexAssistantDefaultDir , return $ "~" gitAnnexAssistantDefaultDir ) - else return cwd newRepositoryForm :: FilePath -> Form RepositoryPath newRepositoryForm defpath msg = do