made parentDir return a Maybe FilePath; removed most uses of it

parentDir is less safe than takeDirectory, especially when working
with relative FilePaths. It's really only useful in loops that
want to terminate at /

This commit was sponsored by Audric SCHILTKNECHT.

Assistant/Install.hs

@@ -49,7 +49,7 @@ ensureInstalled = go =<< standaloneAppBase
 	go (Just base) = do
 		let program = base </> "git-annex"
 		programfile <- programFile
-		createDirectoryIfMissing True (parentDir programfile)
+		createDirectoryIfMissing True (takeDirectory programfile)
 		writeFile programfile program
 
 #ifdef darwin_HOST_OS
@@ -87,7 +87,7 @@ installWrapper :: FilePath -> String -> IO ()
 installWrapper file content = do
 	curr <- catchDefaultIO "" $ readFileStrict file
 	when (curr /= content) $ do
-		createDirectoryIfMissing True (parentDir file)
+		createDirectoryIfMissing True (takeDirectory file)
 		viaTmp writeFile file content
 		modifyFileMode file $ addModes [ownerExecuteMode]
 

Assistant/Install/AutoStart.hs

@@ -19,7 +19,7 @@ import System.Directory
 installAutoStart :: FilePath -> FilePath -> IO ()
 installAutoStart command file = do
 #ifdef darwin_HOST_OS
-	createDirectoryIfMissing True (parentDir file)
+	createDirectoryIfMissing True (takeDirectory file)
 	writeFile file $ genOSXAutoStartFile osxAutoStartLabel command
 		["assistant", "--autostart"]
 #else

Assistant/Install/Menu.hs

@@ -38,7 +38,7 @@ fdoDesktopMenu command = genDesktopEntry
 
 installIcon :: FilePath -> FilePath -> IO ()
 installIcon src dest = do
-	createDirectoryIfMissing True (parentDir dest)
+	createDirectoryIfMissing True (takeDirectory dest)
 	withBinaryFile src ReadMode $ \hin ->
 		withBinaryFile dest WriteMode $ \hout ->
 			hGetContents hin >>= hPutStr hout

Assistant/Ssh.hs

@@ -233,7 +233,8 @@ genSshKeyPair = withTmpDir "git-annex-keygen" $ \dir -> do
 setupSshKeyPair :: SshKeyPair -> SshData -> IO SshData
 setupSshKeyPair sshkeypair sshdata = do
 	sshdir <- sshDir
-	createDirectoryIfMissing True $ parentDir $ sshdir </> sshprivkeyfile
+	createDirectoryIfMissing True $
+		takeDirectory $ sshdir </> sshprivkeyfile
 
 	unlessM (doesFileExist $ sshdir </> sshprivkeyfile) $
 		writeFileProtected (sshdir </> sshprivkeyfile) (sshPrivKey sshkeypair)

Assistant/Threads/UpgradeWatcher.hs

@@ -47,7 +47,7 @@ upgradeWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do
 			, modifyHook = changed
 			, delDirHook = changed
 			}
-		let dir = parentDir flagfile
+		let dir = takeDirectory flagfile
 		let depth = length (splitPath dir) + 1
 		let nosubdirs f = length (splitPath f) == depth
 		void $ liftIO $ watchDir dir nosubdirs False hooks (startup mvar)

Assistant/Upgrade.hs

@@ -161,7 +161,7 @@ upgradeToDistribution newdir cleanup distributionfile = do
 	{- OS X uses a dmg, so mount it, and copy the contents into place. -}
 	unpack = liftIO $ do
 		olddir <- oldVersionLocation
-		withTmpDirIn (parentDir newdir) "git-annex.upgrade" $ \tmpdir -> do
+		withTmpDirIn (takeDirectory newdir) "git-annex.upgrade" $ \tmpdir -> do
 			void $ boolSystem "hdiutil"
 				[ Param "attach", File distributionfile
 				, Param "-mountpoint", File tmpdir
@@ -186,7 +186,7 @@ upgradeToDistribution newdir cleanup distributionfile = do
 	 - into place. -}
 	unpack = liftIO $ do
 		olddir <- oldVersionLocation
-		withTmpDirIn (parentDir newdir) "git-annex.upgrade" $ \tmpdir -> do
+		withTmpDirIn (takeDirectory newdir) "git-annex.upgrade" $ \tmpdir -> do
 			let tarball = tmpdir </> "tar"
 			-- Cannot rely on filename extension, and this also
 			-- avoids problems if tar doesn't support transparent
@@ -217,14 +217,14 @@ upgradeToDistribution newdir cleanup distributionfile = do
 		unlessM (doesDirectoryExist dir) $
 			error $ "did not find " ++ dir ++ " in " ++ distributionfile
 	makeorigsymlink olddir = do
-		let origdir = parentDir olddir </> installBase
+		let origdir = takeDirectory olddir </> installBase
 		nukeFile origdir
 		createSymbolicLink newdir origdir
 
 {- Finds where the old version was installed. -}
 oldVersionLocation :: IO FilePath
 oldVersionLocation = do
-	pdir <- parentDir <$> readProgramFile
+	pdir <- takeDirectory <$> readProgramFile
 #ifdef darwin_HOST_OS
 	let dirs = splitDirectories pdir
 	{- It will probably be deep inside a git-annex.app directory. -}
@@ -253,7 +253,7 @@ newVersionLocation d olddir =
 			return Nothing
   where
 	s = installBase ++ "." ++ distributionVersion d
-	topdir = parentDir olddir
+	topdir = takeDirectory olddir
 	newloc = topdir </> s
 	trymkdir dir fallback =
 		(createDirectory dir >> return (Just dir))

Assistant/WebApp/Configurators/Local.hs

@@ -83,7 +83,7 @@ checkRepositoryPath p = do
 	home <- myHomeDir
 	let basepath = expandTilde home $ T.unpack p
 	path <- absPath basepath
-	let parent = parentDir path
+	let parent = takeDirectory path
 	problems <- catMaybes <$> mapM runcheck
 		[ (return $ path == "/", "Enter the full path to use for the repository.")
 		, (return $ all isSpace basepath, "A blank path? Seems unlikely.")
@@ -416,7 +416,7 @@ startFullAssistant path repogroup setup = do
 canWrite :: FilePath -> IO Bool		
 canWrite dir = do
 	tocheck <- ifM (doesDirectoryExist dir)
-		(return dir, return $ parentDir dir)
+		(return dir, return $ takeDirectory dir)
 	catchBoolIO $ fileAccess tocheck False True False
 
 {- Gets the UUID of the git repo at a location, which may not exist, or