revert parentDir change

Reverts 965e106f24

Unfortunately, this caused breakage on Windows, and possibly elsewhere,
because parentDir and takeDirectory do not behave the same when there is a
trailing directory separator.

Annex/Content.hs

@@ -261,7 +261,7 @@ finishGetViaTmp check key action = do
 prepTmp :: Key -> Annex FilePath
 prepTmp key = do
 	tmp <- fromRepo $ gitAnnexTmpObjectLocation key
-	createAnnexDirectory (takeDirectory tmp)
+	createAnnexDirectory (parentDir 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 = takeDirectory file
+		let dir = parentDir 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 (takeDirectory dest)
+	createAnnexDirectory (parentDir dest)
 	cleanObjectLoc key $
 		liftIO $ moveFile src dest
 	logStatus key InfoMissing

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 (takeDirectory (sentinalFile s))
+	createAnnexDirectory (parentDir (sentinalFile s))
 	liftIO $ writeSentinalFile s
   where
 	alreadyexists = liftIO. sentinalFileExists =<< annexSentinalFile

Annex/Direct.hs

@@ -270,7 +270,7 @@ updateWorkTree d oldref = do
 	 - Empty work tree directories are removed, per git behavior. -}
 	moveout_raw _ _ f = liftIO $ do
 		nukeFile f
-		void $ tryIO $ removeDirectory $ takeDirectory f
+		void $ tryIO $ removeDirectory $ parentDir f
 	
 	{- If the file is already present, with the right content for the
 	 - key, it's left alone. 
@@ -291,7 +291,7 @@ updateWorkTree d oldref = do
 	movein_raw item makeabs f = do
 		preserveUnannexed item makeabs f oldref
 		liftIO $ do
-			createDirectoryIfMissing True $ takeDirectory f
+			createDirectoryIfMissing True $ parentDir f
 			void $ tryIO $ rename (d </> getTopFilePath (DiffTree.file item)) f
 
 {- If the file that's being moved in is already present in the work
@@ -309,10 +309,9 @@ preserveUnannexed item makeabs absf oldref = do
 	checkdirs (DiffTree.file item)
   where
 	checkdirs from = do
-		case parentDir (getTopFilePath from) of
-			Nothing -> noop
-			Just p -> 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
@@ -383,7 +382,7 @@ removeDirect k f = do
 			)
 	liftIO $ do
 		nukeFile f
-		void $ tryIO $ removeDirectory $ takeDirectory f
+		void $ tryIO $ removeDirectory $ parentDir f
 
 {- Called when a direct mode file has been changed. Its old content may be
  - lost. -}

Annex/Direct/Fixup.hs

@@ -10,17 +10,16 @@ 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 (takeDirectory d) }
+		{ location = l { worktree = Just (parentDir d) }
 		, gitGlobalOpts = gitGlobalOpts r ++
 			[ Param "-c"
 			, Param $ coreBare ++ "=" ++ boolConfig False

Annex/Perms.hs

@@ -71,12 +71,12 @@ annexFileMode = withShared $ return . go
 createAnnexDirectory :: FilePath -> Annex ()
 createAnnexDirectory dir = traverse dir [] =<< top
   where
-	top = takeDirectory <$> fromRepo gitAnnexDir
+	top = parentDir <$> fromRepo gitAnnexDir
 	traverse d below stop
 		| d `equalFilePath` stop = done
 		| otherwise = ifM (liftIO $ doesDirectoryExist d)
 			( done
-			, traverse (takeDirectory d) (d:below) stop
+			, traverse (parentDir 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 = takeDirectory file
+	dir = parentDir file
 	go GroupShared = groupWriteRead dir
 	go AllShared = groupWriteRead dir
 	go _ = preventWrite dir
 
 thawContentDir :: FilePath -> Annex ()
 thawContentDir file = unlessM crippledFileSystem $
-	liftIO $ allowWrite $ takeDirectory file
+	liftIO $ allowWrite $ parentDir 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 = takeDirectory dest
+	dir = parentDir 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

Annex/ReplaceFile.hs

@@ -46,5 +46,5 @@ replaceFileFrom src dest = go `catchIO` fallback
   where
 	go = moveFile src dest
 	fallback _ = do
-		createDirectoryIfMissing True $ takeDirectory dest
+		createDirectoryIfMissing True $ parentDir dest
 		go

Annex/Ssh.hs

@@ -125,7 +125,7 @@ prepSocket socketfile = do
 	-- Cleanup at end of this run.
 	Annex.addCleanup SshCachingCleanup sshCleanup
 
-	liftIO $ createDirectoryIfMissing True $ takeDirectory socketfile
+	liftIO $ createDirectoryIfMissing True $ parentDir socketfile
 	lockFileShared $ socket2lock socketfile
 
 enumSocketFiles :: Annex [FilePath]

Assistant.hs

@@ -78,7 +78,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
 	logfile <- fromRepo gitAnnexLogFile
 	liftIO $ debugM desc $ "logging to " ++ logfile
 #ifndef mingw32_HOST_OS
-	createAnnexDirectory (takeDirectory logfile)
+	createAnnexDirectory (parentDir logfile)
 	logfd <- liftIO $ handleToFd =<< openLog logfile
 	if foreground
 		then do
@@ -98,7 +98,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
 	-- log file. The only way to do so is to restart the program.
 	when (foreground || not foreground) $ do
 		let flag = "GIT_ANNEX_OUTPUT_REDIR"
-		createAnnexDirectory (takeDirectory logfile)
+		createAnnexDirectory (parentDir logfile)
 		ifM (liftIO $ isNothing <$> getEnv flag)
 			( liftIO $ withFile devNull WriteMode $ \nullh -> do
 				loghandle <- openLog logfile

Assistant/Install.hs

@@ -49,7 +49,7 @@ ensureInstalled = go =<< standaloneAppBase
 	go (Just base) = do
 		let program = base </> "git-annex"
 		programfile <- programFile
-		createDirectoryIfMissing True (takeDirectory programfile)
+		createDirectoryIfMissing True (parentDir 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 (takeDirectory file)
+		createDirectoryIfMissing True (parentDir file)
 		viaTmp writeFile file content
 		modifyFileMode file $ addModes [ownerExecuteMode]
 

Assistant/Install/AutoStart.hs

@@ -19,7 +19,7 @@ import System.FilePath
 installAutoStart :: FilePath -> FilePath -> IO ()
 installAutoStart command file = do
 #ifdef darwin_HOST_OS
-	createDirectoryIfMissing True (takeDirectory file)
+	createDirectoryIfMissing True (parentDir 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 (takeDirectory dest)
+	createDirectoryIfMissing True (parentDir dest)
 	withBinaryFile src ReadMode $ \hin ->
 		withBinaryFile dest WriteMode $ \hout ->
 			hGetContents hin >>= hPutStr hout

Assistant/Ssh.hs

@@ -233,8 +233,7 @@ genSshKeyPair = withTmpDir "git-annex-keygen" $ \dir -> do
 setupSshKeyPair :: SshKeyPair -> SshData -> IO SshData
 setupSshKeyPair sshkeypair sshdata = do
 	sshdir <- sshDir
-	createDirectoryIfMissing True $
-		takeDirectory $ sshdir </> sshprivkeyfile
+	createDirectoryIfMissing True $ parentDir $ 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 = takeDirectory flagfile
+		let dir = parentDir 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 (takeDirectory newdir) "git-annex.upgrade" $ \tmpdir -> do
+		withTmpDirIn (parentDir 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 (takeDirectory newdir) "git-annex.upgrade" $ \tmpdir -> do
+		withTmpDirIn (parentDir 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 = takeDirectory olddir </> installBase
+		let origdir = parentDir olddir </> installBase
 		nukeFile origdir
 		createSymbolicLink newdir origdir
 
 {- Finds where the old version was installed. -}
 oldVersionLocation :: IO FilePath
 oldVersionLocation = do
-	pdir <- takeDirectory <$> readProgramFile
+	pdir <- parentDir <$> 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 = takeDirectory olddir
+	topdir = parentDir 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 = takeDirectory path
+	let parent = parentDir 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 $ takeDirectory dir)
+		(return dir, return $ parentDir dir)
 	catchBoolIO $ fileAccess tocheck False True False
 
 {- Gets the UUID of the git repo at a location, which may not exist, or

Build/DesktopFile.hs

@@ -22,7 +22,6 @@ import Assistant.Install.Menu
 import Control.Applicative
 import System.Directory
 import System.Environment
-import System.FilePath
 #ifndef mingw32_HOST_OS
 import System.Posix.User
 #endif
@@ -76,6 +75,6 @@ install command = do
 		( return ()
 		, do
 			programfile <- inDestDir =<< programFile
-			createDirectoryIfMissing True (takeDirectory programfile)
+			createDirectoryIfMissing True (parentDir programfile)
 			writeFile programfile command
 		)

Build/DistributionUpdate.hs

@@ -64,7 +64,7 @@ getbuild repodir (url, f) = do
 	let dest = repodir </> f
 	let tmp = dest ++ ".tmp"
 	nukeFile tmp
-	createDirectoryIfMissing True (takeDirectory dest)
+	createDirectoryIfMissing True (parentDir dest)
 	let oops s = do
 		nukeFile tmp
 		putStrLn $ "*** " ++ s

Build/EvilSplicer.hs

@@ -204,7 +204,7 @@ applySplices destdir imports splices@(first:_) = do
 	let f = splicedFile first
 	let dest = (destdir </> f)
 	lls <- map (++ "\n") . lines <$> readFileStrictAnyEncoding f
-	createDirectoryIfMissing True (takeDirectory dest)
+	createDirectoryIfMissing True (parentDir dest)
 	let newcontent = concat $ addimports $ expand lls splices
 	oldcontent <- catchMaybeIO $ readFileStrictAnyEncoding dest
 	when (oldcontent /= Just newcontent) $ do

Build/LinuxMkLibs.hs

@@ -47,7 +47,7 @@ mklibs top = do
 	writeFile (top </> "linker")
 		(Prelude.head $ filter ("ld-linux" `isInfixOf`) libs')
 	writeFile (top </> "gconvdir")
-		(takeDirectory $ Prelude.head $ filter ("/gconv/" `isInfixOf`) glibclibs)
+		(parentDir $ Prelude.head $ filter ("/gconv/" `isInfixOf`) glibclibs)
 	
 	mapM_ (installLinkerShim top) exes
 
@@ -75,7 +75,7 @@ installLinkerShim top exe = do
 symToHardLink :: FilePath -> IO ()
 symToHardLink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus f) $ do
 	l <- readSymbolicLink f
-	let absl = absPathFrom (takeDirectory f) l
+	let absl = absPathFrom (parentDir f) l
 	nukeFile f
 	createLink absl f
 
@@ -84,7 +84,7 @@ installFile top f = do
 	createDirectoryIfMissing True destdir
 	void $ copyFileExternal CopyTimeStamps f destdir
   where
-	destdir = inTop top $ takeDirectory f
+	destdir = inTop top $ parentDir f
 
 checkExe :: FilePath -> IO Bool
 checkExe f

Build/OSXMkLibs.hs

@@ -50,7 +50,7 @@ installLibs appbase replacement_libs libmap = do
 		ifM (doesFileExist dest)
 			( return Nothing
 			, do
-				createDirectoryIfMissing True (takeDirectory dest)
+				createDirectoryIfMissing True (parentDir dest)
 				putStrLn $ "installing " ++ pathlib ++ " as " ++ shortlib
 				_ <- boolSystem "cp" [File pathlib, File dest]
 				_ <- boolSystem "chmod" [Param "644", File dest]

CmdLine/Seek.hs

@@ -70,7 +70,7 @@ withPathContents a params = seekActions $
 	map a . concat <$> liftIO (mapM get params)
   where
 	get p = ifM (isDirectory <$> getFileStatus p)
-		( map (\f -> (f, makeRelative (takeDirectory p) f))
+		( map (\f -> (f, makeRelative (parentDir p) f))
 			<$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) True p
 		, return [(p, takeFileName p)]
 		)

Command/AddUrl.hs

@@ -101,7 +101,7 @@ performRemote r relaxed uri file sz = ifAnnexed file adduri geturi
 downloadRemoteFile :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key)
 downloadRemoteFile r relaxed uri file sz = do
 	urlkey <- Backend.URL.fromUrl uri sz
-	liftIO $ createDirectoryIfMissing True (takeDirectory file)
+	liftIO $ createDirectoryIfMissing True (parentDir file)
 	ifM (Annex.getState Annex.fast <||> pure relaxed)
 		( do
 			cleanup (Remote.uuid r) loguri file urlkey Nothing
@@ -195,7 +195,7 @@ addUrlFileQuvi relaxed quviurl videourl file = do
 				showOutput
 				ok <- Transfer.notifyTransfer Transfer.Download (Just file) $
 					Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do
-						liftIO $ createDirectoryIfMissing True (takeDirectory tmp)
+						liftIO $ createDirectoryIfMissing True (parentDir tmp)
 						downloadUrl [videourl] tmp
 				if ok
 					then do
@@ -227,7 +227,7 @@ addUrlChecked relaxed url u checkexistssize key
 
 addUrlFile :: Bool -> URLString -> FilePath -> Annex (Maybe Key)
 addUrlFile relaxed url file = do
-	liftIO $ createDirectoryIfMissing True (takeDirectory file)
+	liftIO $ createDirectoryIfMissing True (parentDir file)
 	ifM (Annex.getState Annex.fast <||> pure relaxed)
 		( nodownload relaxed url file
 		, downloadWeb url file
@@ -269,7 +269,7 @@ downloadWith downloader dummykey u url file =
   where
 	runtransfer tmp =  Transfer.notifyTransfer Transfer.Download (Just file) $
 		Transfer.download u dummykey (Just file) Transfer.forwardRetry $ \p -> do
-			liftIO $ createDirectoryIfMissing True (takeDirectory tmp)
+			liftIO $ createDirectoryIfMissing True (parentDir tmp)
 			downloader tmp p
 
 {- Hits the url to get the size, if available.

Command/Fix.hs

@@ -43,7 +43,7 @@ perform file link = do
 			<$> getSymbolicLinkStatus file
 #endif
 #endif
-		createDirectoryIfMissing True (takeDirectory file)
+		createDirectoryIfMissing True (parentDir file)
 		removeFile file
 		createSymbolicLink link file
 #ifdef WITH_CLIBS

Command/FromKey.hs

@@ -34,7 +34,7 @@ start _ = error "specify a key and a dest file"
 perform :: Key -> FilePath -> CommandPerform
 perform key file = do
 	link <- inRepo $ gitAnnexLink file key
-	liftIO $ createDirectoryIfMissing True (takeDirectory file)
+	liftIO $ createDirectoryIfMissing True (parentDir file)
 	liftIO $ createSymbolicLink link file
 	next $ cleanup file
 

Command/Fsck.hs

@@ -200,7 +200,7 @@ fixLink key file = do
 	go want have
 		| want /= fromInternalGitPath have = do
 			showNote "fixing link"
-			liftIO $ createDirectoryIfMissing True (takeDirectory file)
+			liftIO $ createDirectoryIfMissing True (parentDir file)
 			liftIO $ removeFile file
 			addAnnexLink want file
 		| otherwise = noop
@@ -218,7 +218,7 @@ verifyLocationLog key desc = do
 	file <- calcRepo $ gitAnnexLocation key
 	when (present && not direct) $
 		freezeContent file
-	whenM (liftIO $ doesDirectoryExist $ takeDirectory file) $
+	whenM (liftIO $ doesDirectoryExist $ parentDir file) $
 		freezeContentDir file
 
 	{- In direct mode, modified files will show up as not present,
@@ -450,7 +450,7 @@ needFsck _ _ = return True
  -}
 recordFsckTime :: Key -> Annex ()
 recordFsckTime key = do
-	parent <- takeDirectory <$> calcRepo (gitAnnexLocation key)
+	parent <- parentDir <$> calcRepo (gitAnnexLocation key)
 	liftIO $ void $ tryIO $ do
 		touchFile parent
 #ifndef mingw32_HOST_OS
@@ -459,7 +459,7 @@ recordFsckTime key = do
 
 getFsckTime :: Key -> Annex (Maybe EpochTime)
 getFsckTime key = do
-	parent <- takeDirectory <$> calcRepo (gitAnnexLocation key)
+	parent <- parentDir <$> calcRepo (gitAnnexLocation key)
 	liftIO $ catchDefaultIO Nothing $ do
 		s <- getFileStatus parent
 		return $ if isSticky $ fileMode s
@@ -477,7 +477,7 @@ getFsckTime key = do
 recordStartTime :: Annex ()
 recordStartTime = do
 	f <- fromRepo gitAnnexFsckState
-	createAnnexDirectory $ takeDirectory f
+	createAnnexDirectory $ parentDir f
 	liftIO $ do
 		nukeFile f
 		withFile f WriteMode $ \h -> do

Command/FuzzTest.hs

@@ -173,7 +173,7 @@ instance Arbitrary FuzzAction where
 
 runFuzzAction :: FuzzAction -> Annex ()
 runFuzzAction (FuzzAdd (FuzzFile f)) = liftIO $ do
-	createDirectoryIfMissing True $ takeDirectory f
+	createDirectoryIfMissing True $ parentDir f
 	n <- getStdRandom random :: IO Int
 	writeFile f $ show n ++ "\n"
 runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $ nukeFile f
@@ -210,7 +210,7 @@ genFuzzAction = do
 			case md of
 				Nothing -> genFuzzAction
 				Just d -> do
-					newd <- liftIO $ newDir (takeDirectory $ toFilePath d)
+					newd <- liftIO $ newDir (parentDir $ toFilePath d)
 					maybe genFuzzAction (return . FuzzMoveDir d) newd
 		FuzzDeleteDir _ -> do
 			d <- liftIO existingDir

Command/Import.hs

@@ -88,7 +88,7 @@ start mode (srcfile, destfile) =
 		next $ return True
 	importfile = do
 		handleexisting =<< liftIO (catchMaybeIO $ getSymbolicLinkStatus destfile)
-		liftIO $ createDirectoryIfMissing True (takeDirectory destfile)
+		liftIO $ createDirectoryIfMissing True (parentDir destfile)
 		liftIO $ if mode == Duplicate || mode == SkipDuplicates
 			then void $ copyFileExternal CopyAllMetaData srcfile destfile
 			else moveFile srcfile destfile

Command/ImportFeed.hs

@@ -311,7 +311,7 @@ checkFeedBroken' url f = do
 	now <- liftIO getCurrentTime
 	case prev of
 		Nothing -> do
-			createAnnexDirectory (takeDirectory f)
+			createAnnexDirectory (parentDir f)
 			liftIO $ writeFile f $ show now
 			return False
 		Just prevtime -> do

Command/Unlock.hs

@@ -46,7 +46,7 @@ perform dest key = ifM (checkDiskSpace Nothing key 0)
 	( do
 		src <- calcRepo $ gitAnnexLocation key
 		tmpdest <- fromRepo $ gitAnnexTmpObjectLocation key
-		liftIO $ createDirectoryIfMissing True (takeDirectory tmpdest)
+		liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
 		showAction "copying"
 		ifM (liftIO $ copyFileExternal CopyAllMetaData src tmpdest)
 			( do

Command/Vicfg.hs

@@ -39,7 +39,7 @@ seek = withNothing start
 start :: CommandStart
 start = do
 	f <- fromRepo gitAnnexTmpCfgFile
-	createAnnexDirectory $ takeDirectory f
+	createAnnexDirectory $ parentDir f
 	cfg <- getCfg
 	descs <- uuidDescriptions
 	liftIO $ writeFileAnyEncoding f $ genCfg cfg descs

Config/Files.hs

@@ -33,7 +33,7 @@ modifyAutoStartFile func = do
 	let dirs' = nubBy equalFilePath $ func dirs
 	when (dirs' /= dirs) $ do
 		f <- autoStartFile
-		createDirectoryIfMissing True (takeDirectory f)
+		createDirectoryIfMissing True (parentDir f)
 		viaTmp writeFile f $ unlines dirs'
 
 {- Adds a directory to the autostart file. If the directory is already

Git/Construct.hs

@@ -46,8 +46,8 @@ fromCwd = getCurrentDirectory >>= seekUp
 		r <- checkForRepo dir
 		case r of
 			Nothing -> case parentDir dir of
-				Nothing -> return Nothing
-				Just d -> seekUp d
+				"" -> return Nothing
+				d -> seekUp d
 			Just loc -> Just <$> newFrom loc
 
 {- Local Repo constructor, accepts a relative or absolute path. -}

Git/Repair.hs

@@ -244,7 +244,7 @@ explodePackedRefsFile r = do
   where
 	makeref (sha, ref) = do
 		let dest = localGitDir r </> fromRef ref
-		createDirectoryIfMissing True (takeDirectory dest)
+		createDirectoryIfMissing True (parentDir dest)
 		unlessM (doesFileExist dest) $
 			writeFile dest (fromRef sha)
 

Locations.hs

@@ -146,7 +146,7 @@ gitAnnexLink file key r = do
 	currdir <- getCurrentDirectory
 	let absfile = fromMaybe whoops $ absNormPathUnix currdir file
 	loc <- gitAnnexLocation' key r False
-	relPathDirToFile (takeDirectory absfile) loc
+	relPathDirToFile (parentDir absfile) loc
   where
 	whoops = error $ "unable to normalize " ++ file
 

Logs/FsckResults.hs

@@ -29,7 +29,7 @@ writeFsckResults u fsckresults = do
 				| otherwise -> store s t logfile
   where
 	store s t logfile = do 
-		createDirectoryIfMissing True (takeDirectory logfile)
+		createDirectoryIfMissing True (parentDir logfile)
 		liftIO $ viaTmp writeFile logfile $ serialize s t
 	serialize s t =
 		let ls = map fromRef (S.toList s)

Remote/BitTorrent.hs

@@ -189,7 +189,7 @@ downloadTorrentFile u = do
 		, do
 			showAction "downloading torrent file"
 			showOutput
-			createAnnexDirectory (takeDirectory torrent)
+			createAnnexDirectory (parentDir torrent)
 			if isTorrentMagnetUrl u
 				then do
 					tmpdir <- tmpTorrentDir u

Remote/Directory.hs

@@ -143,7 +143,7 @@ finalizeStoreGeneric :: FilePath -> FilePath -> IO ()
 finalizeStoreGeneric tmp dest = do
 	void $ tryIO $ allowWrite dest -- may already exist
 	void $ tryIO $ removeDirectoryRecursive dest -- or not exist
-	createDirectoryIfMissing True (takeDirectory dest)
+	createDirectoryIfMissing True (parentDir dest)
 	renameDirectory tmp dest
 	-- may fail on some filesystems
 	void $ tryIO $ do

Remote/GCrypt.hs

@@ -315,7 +315,7 @@ store r rsyncopts
 			void $ tryIO $ createDirectoryIfMissing True tmpdir
 			let tmpf = tmpdir </> keyFile k
 			meteredWriteFile p tmpf b
-			let destdir = takeDirectory $ gCryptLocation r k
+			let destdir = parentDir $ gCryptLocation r k
 			Remote.Directory.finalizeStoreGeneric tmpdir destdir
 			return True
 	| Git.repoIsSsh (repo r) = if isShell r
@@ -340,7 +340,7 @@ retrieve r rsyncopts
 remove :: Remote -> Remote.Rsync.RsyncOpts -> Remover
 remove r rsyncopts k
 	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) (return False) $
-		liftIO $ Remote.Directory.removeDirGeneric (Git.repoLocation (repo r)) (takeDirectory (gCryptLocation r k))
+		liftIO $ Remote.Directory.removeDirGeneric (Git.repoLocation (repo r)) (parentDir (gCryptLocation r k))
 	| Git.repoIsSsh (repo r) = shellOrRsync r removeshell removersync
 	| otherwise = unsupportedUrl
   where

Remote/Git.hs

@@ -556,7 +556,7 @@ rsyncOrCopyFile rsyncparams src dest p =
 	ifM (sameDeviceIds src dest) (docopy, dorsync)
   where
 	sameDeviceIds a b = (==) <$> getDeviceId a <*> getDeviceId b
-	getDeviceId f = deviceID <$> liftIO (getFileStatus $ takeDirectory f)
+	getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f)
 	docopy = liftIO $ bracket
 		(forkIO $ watchfilesize zeroBytesProcessed)
 		(void . tryIO . killThread)

Remote/Rsync.hs

@@ -161,7 +161,7 @@ rsyncSetup mu _ c = do
 store :: RsyncOpts -> Key -> FilePath -> MeterUpdate -> Annex Bool
 store o k src meterupdate = withRsyncScratchDir $ \tmp -> do
 	let dest = tmp </> Prelude.head (keyPaths k)
-	liftIO $ createDirectoryIfMissing True $ takeDirectory dest
+	liftIO $ createDirectoryIfMissing True $ parentDir dest
 	ok <- liftIO $ if canrename
 		then do
 			rename src dest
@@ -214,7 +214,7 @@ remove o k = do
 	 - traverses directories. -}
 	includes = concatMap use annexHashes
 	use h = let dir = h k in
-		[ takeDirectory dir
+		[ parentDir dir
 		, dir
 		-- match content directory and anything in it
 		, dir </> keyFile k </> "***"

Remote/Tahoe.hs

@@ -153,7 +153,7 @@ tahoeConfigure configdir furl mscs = do
 
 createClient :: TahoeConfigDir -> IntroducerFurl -> IO Bool
 createClient configdir furl = do
-	createDirectoryIfMissing True (takeDirectory configdir)
+	createDirectoryIfMissing True (parentDir configdir)
 	boolTahoe configdir "create-client"
 		[ Param "--nickname", Param "git-annex"
 		, Param "--introducer", Param furl

Test.hs

@@ -1071,7 +1071,7 @@ test_uncommitted_conflict_resolution = do
 		withtmpclonerepo False $ \r2 -> do
 			indir r1 $ do
 				disconnectOrigin
-				createDirectoryIfMissing True (takeDirectory remoteconflictor)
+				createDirectoryIfMissing True (parentDir remoteconflictor)
 				writeFile remoteconflictor annexedcontent
 				git_annex "add" [conflictor] @? "add remoteconflicter failed"
 				git_annex "sync" [] @? "sync failed in r1"

Upgrade/V1.hs

@@ -73,7 +73,7 @@ moveContent = do
   where
 	move f = do
 		let k = fileKey1 (takeFileName f)
-		let d = takeDirectory f
+		let d = parentDir f
 		liftIO $ allowWrite d
 		liftIO $ allowWrite f
 		moveAnnex k f
@@ -114,7 +114,7 @@ moveLocationLogs = do
 		dest <- fromRepo $ logFile2 k
 		dir <- fromRepo Upgrade.V2.gitStateDir
 		let f = dir </> l
-		liftIO $ createDirectoryIfMissing True (takeDirectory dest)
+		liftIO $ createDirectoryIfMissing True (parentDir dest)
 		-- could just git mv, but this way deals with
 		-- log files that are not checked into git,
 		-- as well as merging with already upgraded

Utility/Daemon.hs

@@ -83,7 +83,7 @@ foreground pidfile a = do
  - Fails if the pid file is already locked by another process. -}
 lockPidFile :: FilePath -> IO ()
 lockPidFile pidfile = do
-	createDirectoryIfMissing True (takeDirectory pidfile)
+	createDirectoryIfMissing True (parentDir pidfile)
 #ifndef mingw32_HOST_OS
 	fd <- openFd pidfile ReadWrite (Just stdFileMode) defaultFileFlags
 	locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
@@ -176,6 +176,6 @@ winLockFile pid pidfile = do
 	prefix = pidfile ++ "."
 	suffix = ".lck"
 	cleanstale = mapM_ (void . tryIO . removeFile) =<<
-		(filter iswinlockfile <$> dirContents (takeDirectory pidfile))
+		(filter iswinlockfile <$> dirContents (parentDir pidfile))
 	iswinlockfile f = suffix `isSuffixOf` f && prefix `isPrefixOf` f
 #endif

Utility/FreeDesktop.hs

@@ -27,6 +27,7 @@ module Utility.FreeDesktop (
 ) where
 
 import Utility.Exception
+import Utility.Path
 import Utility.UserInfo
 import Utility.Process
 import Utility.PartialPrelude
@@ -78,7 +79,7 @@ buildDesktopMenuFile d = unlines ("[Desktop Entry]" : map keyvalue d) ++ "\n"
 
 writeDesktopMenuFile :: DesktopEntry -> String -> IO ()
 writeDesktopMenuFile d file = do
-	createDirectoryIfMissing True (takeDirectory file)
+	createDirectoryIfMissing True (parentDir file)
 	writeFile file $ buildDesktopMenuFile d
 
 {- Path to use for a desktop menu file, in either the systemDataDir or

Utility/LinuxMkLibs.hs

@@ -29,13 +29,13 @@ installLib installfile top lib = ifM (doesFileExist lib)
 	( do
 		installfile top lib
 		checksymlink lib
-		return $ Just $ takeDirectory lib
+		return $ Just $ parentDir lib
 	, return Nothing
 	)
   where
 	checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do
 		l <- readSymbolicLink (inTop top f)
-		let absl = absPathFrom (takeDirectory f) l
+		let absl = absPathFrom (parentDir f) l
 		target <- relPathDirToFile (takeDirectory f) absl
 		installfile top absl
 		nukeFile (top ++ f)

Utility/Path.hs

@@ -77,12 +77,18 @@ absNormPathUnix dir path = todos <$> MissingH.absNormPath (fromdos dir) (fromdos
 	todos = replace "/" "\\"
 #endif
 
-{- Just the parent directory of a path, or Nothing if the path has no
- - parent (ie for "/") -}
-parentDir :: FilePath -> Maybe FilePath
+{- Returns the parent directory of a path.
+ -
+ - To allow this to be easily used in loops, which terminate upon reaching the
+ - top, the parent of / is ""
+ -
+ - An additional subtle difference between this and takeDirectory
+ - is that takeDirectory "foo/bar/" is "foo/bar", while parentDir is "foo"
+ -}
+parentDir :: FilePath -> FilePath
 parentDir dir
-	| null dirs = Nothing
-	| otherwise = Just $ joinDrive drive (join s $ init dirs)
+	| null dirs = ""
+	| otherwise = joinDrive drive (join s $ init dirs)
   where
 	-- on Unix, the drive will be "/" when the dir is absolute, otherwise ""
 	(drive, path) = splitDrive dir
@@ -92,8 +98,8 @@ parentDir dir
 prop_parentDir_basics :: FilePath -> Bool
 prop_parentDir_basics dir
 	| null dir = True
-	| dir == "/" = parentDir dir == Nothing
-	| otherwise = p /= Just dir
+	| dir == "/" = parentDir dir == ""
+	| otherwise = p /= dir
   where
 	p = parentDir dir