convert parentDir to be based on takeDirectory, but fixed for trailing /

4 files changed, 22 insertions, 24 deletions

diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index 15eb04060..df1c8f239 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -308,10 +308,10 @@ preserveUnannexed item makeabs absf oldref = do
 		liftIO $ findnewname absf 0
 	checkdirs (DiffTree.file item)
   where
-	checkdirs from = do
-		let p = parentDir (getTopFilePath from)
-		let d = asTopFilePath p
-		unless (null p) $ do
+	checkdirs from = case upFrom (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
diff --git a/Git/Construct.hs b/Git/Construct.hs
index 108ee7eb7..572c5eb37 100644
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -45,9 +45,9 @@ fromCwd = getCurrentDirectory >>= seekUp
 	seekUp dir = do
 		r <- checkForRepo dir
 		case r of
-			Nothing -> case parentDir dir of
-				"" -> return Nothing
-				d -> seekUp d
+			Nothing -> case upFrom dir of
+				Nothing -> return Nothing
+				Just d -> seekUp d
 			Just loc -> Just <$> newFrom loc
 
 {- Local Repo constructor, accepts a relative or absolute path. -}
diff --git a/Test.hs b/Test.hs
index dd12997ff..803bc6220 100644
--- a/Test.hs
+++ b/Test.hs
@@ -141,7 +141,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
 	, testProperty "prop_logs_sane" Logs.prop_logs_sane
 	, testProperty "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape
 	, testProperty "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config
-	, testProperty "prop_parentDir_basics" Utility.Path.prop_parentDir_basics
+	, testProperty "prop_upFrom_basics" Utility.Path.prop_upFrom_basics
 	, testProperty "prop_relPathDirToFile_basics" Utility.Path.prop_relPathDirToFile_basics
 	, testProperty "prop_relPathDirToFile_regressionTest" Utility.Path.prop_relPathDirToFile_regressionTest
 	, testProperty "prop_cost_sane" Config.Cost.prop_cost_sane
diff --git a/Utility/Path.hs b/Utility/Path.hs
index 763654db2..c42a70601 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -77,31 +77,29 @@ absNormPathUnix dir path = todos <$> MissingH.absNormPath (fromdos dir) (fromdos
 	todos = replace "/" "\\"
 #endif
 
-{- 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"
- -}
+{- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -}
 parentDir :: FilePath -> FilePath
-parentDir dir
-	| null dirs = ""
-	| otherwise = joinDrive drive (join s $ init dirs)
+parentDir = takeDirectory . dropTrailingPathSeparator
+
+{- Just the parent directory of a path, or Nothing if the path has no
+- parent (ie for "/" or ".") -}
+upFrom :: FilePath -> Maybe FilePath
+upFrom dir
+	| null dirs = Nothing
+	| otherwise = Just $ joinDrive drive (join s $ init dirs)
   where
 	-- on Unix, the drive will be "/" when the dir is absolute, otherwise ""
 	(drive, path) = splitDrive dir
 	dirs = filter (not . null) $ split s path
 	s = [pathSeparator]
 
-prop_parentDir_basics :: FilePath -> Bool
-prop_parentDir_basics dir
+prop_upFrom_basics :: FilePath -> Bool
+prop_upFrom_basics dir
 	| null dir = True
-	| dir == "/" = parentDir dir == ""
-	| otherwise = p /= dir
+	| dir == "/" = p == Nothing
+	| otherwise = p /= Just dir
   where
-	p = parentDir dir
+	p = upFrom dir
 
 {- Checks if the first FilePath is, or could be said to contain the second.
  - For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc