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.

7 files changed, 25 insertions, 23 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 37090d3bb..2d52dcefb 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -261,7 +261,7 @@ finishGetViaTmp check key action = do
 prepTmp :: Key -> Annex FilePath
 prepTmp key = do
 	tmp <- fromRepo $ gitAnnexTmpObjectLocation key
-	createAnnexDirectory (parentDir tmp)
+	createAnnexDirectory (takeDirectory tmp)
 	return tmp
 
 {- Creates a temp file for a key, runs an action on it, and cleans up
@@ -425,7 +425,7 @@ cleanObjectLoc key cleaner = do
   where
 	removeparents _ 0 = noop
 	removeparents file n = do
-		let dir = parentDir file
+		let dir = takeDirectory file
 		maybe noop (const $ removeparents dir (n-1))
 			<=< catchMaybeIO $ removeDirectory dir
 
@@ -474,7 +474,7 @@ moveBad key = do
 	src <- calcRepo $ gitAnnexLocation key
 	bad <- fromRepo gitAnnexBadDir
 	let dest = bad </> takeFileName src
-	createAnnexDirectory (parentDir dest)
+	createAnnexDirectory (takeDirectory dest)
 	cleanObjectLoc key $
 		liftIO $ moveFile src dest
 	logStatus key InfoMissing
diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs
index d9e1535f3..a2df9f6d3 100644
--- a/Annex/Content/Direct.hs
+++ b/Annex/Content/Direct.hs
@@ -247,7 +247,7 @@ sentinalStatus = maybe check return =<< Annex.getState Annex.sentinalstatus
 createInodeSentinalFile :: Annex ()
 createInodeSentinalFile = unlessM (alreadyexists <||> hasobjects) $ do
 	s <- annexSentinalFile
-	createAnnexDirectory (parentDir (sentinalFile s))
+	createAnnexDirectory (takeDirectory (sentinalFile s))
 	liftIO $ writeSentinalFile s
   where
 	alreadyexists = liftIO. sentinalFileExists =<< annexSentinalFile
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index e4015dd16..6292f027f 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -267,7 +267,7 @@ updateWorkTree d oldref = do
 	 - Empty work tree directories are removed, per git behavior. -}
 	moveout_raw _ _ f = liftIO $ do
 		nukeFile f
-		void $ tryIO $ removeDirectory $ parentDir f
+		void $ tryIO $ removeDirectory $ takeDirectory f
 	
 	{- If the file is already present, with the right content for the
 	 - key, it's left alone. 
@@ -288,7 +288,7 @@ updateWorkTree d oldref = do
 	movein_raw item makeabs f = do
 		preserveUnannexed item makeabs f oldref
 		liftIO $ do
-			createDirectoryIfMissing True $ parentDir f
+			createDirectoryIfMissing True $ takeDirectory f
 			void $ tryIO $ rename (d </> getTopFilePath (DiffTree.file item)) f
 
 {- If the file that's being moved in is already present in the work
@@ -306,13 +306,14 @@ preserveUnannexed item makeabs absf oldref = do
 	checkdirs (DiffTree.file item)
   where
 	checkdirs from = do
-		let p = parentDir (getTopFilePath from)
-		let d = asTopFilePath p
-		unless (null p) $ do
-			let absd = makeabs d
-			whenM (liftIO (colliding_nondir absd) <&&> unannexed absd) $
-				liftIO $ findnewname absd 0
-			checkdirs d
+		case parentDir (getTopFilePath from) of
+			Nothing -> noop
+			Just p -> do
+				let d = asTopFilePath p
+				let absd = makeabs d
+				whenM (liftIO (colliding_nondir absd) <&&> unannexed absd) $
+					liftIO $ findnewname absd 0
+				checkdirs d
 			
 	collidingitem f = isJust
 		<$> catchMaybeIO (getSymbolicLinkStatus f)
@@ -379,7 +380,7 @@ removeDirect k f = do
 			)
 	liftIO $ do
 		nukeFile f
-		void $ tryIO $ removeDirectory $ parentDir f
+		void $ tryIO $ removeDirectory $ takeDirectory f
 
 {- Called when a direct mode file has been changed. Its old content may be
  - lost. -}
diff --git a/Annex/Direct/Fixup.hs b/Annex/Direct/Fixup.hs
index 13485242a..73cefb134 100644
--- a/Annex/Direct/Fixup.hs
+++ b/Annex/Direct/Fixup.hs
@@ -10,16 +10,17 @@ module Annex.Direct.Fixup where
 import Git.Types
 import Git.Config
 import qualified Git.Construct as Construct
-import Utility.Path
 import Utility.SafeCommand
 
+import System.FilePath
+
 {- Direct mode repos have core.bare=true, but are not really bare.
  - Fix up the Repo to be a non-bare repo, and arrange for git commands
  - run by git-annex to be passed parameters that override this setting. -}
 fixupDirect :: Repo -> IO Repo
 fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = do
 	let r' = r
-		{ location = l { worktree = Just (parentDir d) }
+		{ location = l { worktree = Just (takeDirectory d) }
 		, gitGlobalOpts = gitGlobalOpts r ++
 			[ Param "-c"
 			, Param $ coreBare ++ "=" ++ boolConfig False
diff --git a/Annex/Perms.hs b/Annex/Perms.hs
index 3430554c7..d314e382c 100644
--- a/Annex/Perms.hs
+++ b/Annex/Perms.hs
@@ -71,12 +71,12 @@ annexFileMode = withShared $ return . go
 createAnnexDirectory :: FilePath -> Annex ()
 createAnnexDirectory dir = traverse dir [] =<< top
   where
-	top = parentDir <$> fromRepo gitAnnexDir
+	top = takeDirectory <$> fromRepo gitAnnexDir
 	traverse d below stop
 		| d `equalFilePath` stop = done
 		| otherwise = ifM (liftIO $ doesDirectoryExist d)
 			( done
-			, traverse (parentDir d) (d:below) stop
+			, traverse (takeDirectory d) (d:below) stop
 			)
 	  where
 		done = forM_ below $ \p -> do
@@ -92,14 +92,14 @@ freezeContentDir :: FilePath -> Annex ()
 freezeContentDir file = unlessM crippledFileSystem $
 	liftIO . go =<< fromRepo getSharedRepository
   where
-	dir = parentDir file
+	dir = takeDirectory file
 	go GroupShared = groupWriteRead dir
 	go AllShared = groupWriteRead dir
 	go _ = preventWrite dir
 
 thawContentDir :: FilePath -> Annex ()
 thawContentDir file = unlessM crippledFileSystem $
-	liftIO $ allowWrite $ parentDir file
+	liftIO $ allowWrite $ takeDirectory file
 
 {- Makes the directory tree to store an annexed file's content,
  - with appropriate permissions on each level. -}
@@ -111,7 +111,7 @@ createContentDir dest = do
 	unlessM crippledFileSystem $
 		liftIO $ allowWrite dir
   where
-	dir = parentDir dest
+	dir = takeDirectory dest
 
 {- Creates the content directory for a file if it doesn't already exist,
  - or thaws it if it does, then runs an action to modify the file, and
diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs
index 0355ddd51..4bb99b370 100644
--- a/Annex/ReplaceFile.hs
+++ b/Annex/ReplaceFile.hs
@@ -46,5 +46,5 @@ replaceFileFrom src dest = go `catchIO` fallback
   where
 	go = moveFile src dest
 	fallback _ = do
-		createDirectoryIfMissing True $ parentDir dest
+		createDirectoryIfMissing True $ takeDirectory dest
 		go
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index 15b169862..2eb8c97dd 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -125,7 +125,7 @@ prepSocket socketfile = do
 	-- Cleanup at end of this run.
 	Annex.addCleanup SshCachingCleanup sshCleanup
 
-	liftIO $ createDirectoryIfMissing True $ parentDir socketfile
+	liftIO $ createDirectoryIfMissing True $ takeDirectory socketfile
 	lockFileShared $ socket2lock socketfile
 
 enumSocketFiles :: Annex [FilePath]