OsPath build flag no longer depends on filepath-bytestring

However, filepath-bytestring is still in Setup-Depends.
That's because Utility.OsPath uses it when not built with OsPath.
It would be maybe possible to make Utility.OsPath fall back to using
filepath, and eliminate that dependency too, but it would mean either
wrapping all of System.FilePath's functions, or using `type OsPath = FilePath`

Annex.Import uses ifdefs to avoid converting back to FilePath when not
on windows. On windows it's a bit slower due to that conversion.
Utility.Path.Windows.convertToWindowsNativeNamespace got a bit
slower too, but not really worth optimising I think.

Note that importing Utility.FileSystemEncoding at the same time as
System.Posix.ByteString will result in conflicting definitions for
RawFilePath. filepath-bytestring avoids that by importing RawFilePath
from System.Posix.ByteString, but that's not possible in
Utility.FileSystemEncoding, since Setup-Depends does not include unix.
This turned out not to affect any code in git-annex though.

Sponsored-by: Leon Schuermann

Annex/Import.hs

@@ -6,6 +6,7 @@
  -}
 
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
 
 module Annex.Import (
 	ImportTreeConfig(..),
@@ -68,8 +69,10 @@ import Backend.Utilities
 import Control.Concurrent.STM
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
-import qualified System.FilePath.Posix.ByteString as Posix
 import qualified Data.ByteArray.Encoding as BA
+#ifdef mingw32_HOST_OS
+import qualified System.FilePath.Posix as Posix
+#endif
 
 {- Configures how to build an import tree. -}
 data ImportTreeConfig
@@ -428,8 +431,12 @@ buildImportTreesGeneric converttree basetree msubdir importable@(ImportableConte
 		-- Full directory prefix where the sub tree is located.
 		let fullprefix = asTopFilePath $ case msubdir of
 			Nothing -> subdir
-			Just d -> toOsPath $
+			Just d ->
-				fromOsPath (getTopFilePath d) Posix.</> fromOsPath subdir
+#ifdef mingw32_HOST_OS
+				toOsPath $ fromOsPath (getTopFilePath d) Posix.</> fromOsPath subdir
+#else
+				getTopFilePath d </> subdir
+#endif
 		Tree ts <- converttree (Just fullprefix) $
 			map (\(p, i) -> (mkImportLocation p, i))
 				(importableContentsSubTree c)
@@ -1091,7 +1098,11 @@ getImportableContents r importtreeconfig ci matcher = do
 			isknown <||> (matches <&&> notignored)
 	  where
 		-- Checks, from least to most expensive.
+#ifdef mingw32_HOST_OS
 		ingitdir = ".git" `elem` Posix.splitDirectories (fromOsPath (fromImportLocation loc))
+#else
+		ingitdir = literalOsPath ".git" `elem` splitDirectories (fromImportLocation loc)
+#endif
 		matches = matchesImportLocation matcher loc sz
 		isknown = isKnownImportLocation dbhandle loc
 		notignored = notIgnoredImportLocation importtreeconfig ci loc

Backend/Hash.hs

@@ -187,7 +187,7 @@ trivialMigrate' oldkey newbackend afile maxextlen maxexts
 		AssociatedFile Nothing -> Nothing
 		AssociatedFile (Just file) -> Just $ alterKey oldkey $ \d -> d
 			{ keyName = S.toShort $ keyHash oldkey 
-				<> selectExtension maxextlen maxexts (fromOsPath file)
+				<> selectExtension maxextlen maxexts file
 			, keyVariety = newvariety
 			}
 	{- Upgrade to fix bad previous migration that created a

Backend/Utilities.hs

@@ -14,11 +14,11 @@ import qualified Annex
 import Utility.Hash
 import Types.Key
 import Types.KeySource
+import qualified Utility.OsString as OS
 
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Short as S (ShortByteString, toShort)
 import qualified Data.ByteString.Lazy as L
-import qualified System.FilePath.ByteString as P
 import Data.Char
 import Data.Word
 
@@ -49,13 +49,13 @@ addE source sethasext k = do
 	let ext = selectExtension
 		(annexMaxExtensionLength c)
 		(annexMaxExtensions c)
-		(fromOsPath (keyFilename source))
+		(keyFilename source)
 	return $ alterKey k $ \d -> d
 		{ keyName = keyName d <> S.toShort ext
 		, keyVariety = sethasext (keyVariety d)
 		}
 
-selectExtension :: Maybe Int -> Maybe Int -> RawFilePath -> S.ByteString
+selectExtension :: Maybe Int -> Maybe Int -> OsPath -> S.ByteString
 selectExtension maxlen maxextensions f
 	| null es = ""
 	| otherwise = S.intercalate "." ("":es)
@@ -64,11 +64,12 @@ selectExtension maxlen maxextensions f
 		take (fromMaybe maxExtensions maxextensions) $
 		filter (S.all validInExtension) $
 		takeWhile shortenough $
-		reverse $ S.split (fromIntegral (ord '.')) (P.takeExtensions f')
+		reverse $ S.split (fromIntegral (ord '.')) $
+			fromOsPath $ takeExtensions f'
 	shortenough e = S.length e <= fromMaybe maxExtensionLen maxlen
 	-- Avoid treating a file ".foo" as having its whole name as an
 	-- extension.
-	f' = S.dropWhile (== fromIntegral (ord '.')) (P.takeFileName f)
+	f' = OS.dropWhile (== unsafeFromChar '.') (takeFileName f)
 
 validInExtension :: Word8 -> Bool
 validInExtension c

Command/AddUrl.hs

@@ -38,7 +38,6 @@ import qualified Utility.RawFilePath as R
 import qualified Annex.Transfer as Transfer
 
 import Network.URI
-import qualified System.FilePath.ByteString as P
 
 cmd :: Command
 cmd = notBareRepo $ withAnnexOptions 
@@ -200,8 +199,9 @@ checkUrl addunlockedmatcher r o si u = do
 startRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> SeekInput -> FilePath -> URLString -> Maybe Integer -> CommandStart
 startRemote addunlockedmatcher r o si file uri sz = do
 	pathmax <- liftIO $ fileNameLengthLimit "."
-	let file' = toOsPath $ P.joinPath $ map (truncateFilePath pathmax) $
+	let file' = joinPath $ 
-		P.splitDirectories (toRawFilePath file)
+		map (toOsPath . truncateFilePath pathmax . fromOsPath) $
+			splitDirectories (toOsPath file)
 	startingAddUrl si uri o $ do
 		showNote $ UnquotedString $ "from " ++ Remote.name r 
 		showDestinationFile file'

Database/RawFilePath.hs

@@ -38,7 +38,7 @@ module Database.RawFilePath where
 #if MIN_VERSION_persistent_sqlite(2,13,3)
 import Database.Persist.Sqlite
 import qualified Database.Sqlite as Sqlite
-import qualified System.FilePath.ByteString as P
+import Utility.RawFilePath (RawFilePath)
 import qualified Control.Exception as E
 import Control.Monad.Logger (MonadLoggerIO)
 import Control.Monad.IO.Unlift (MonadUnliftIO)
@@ -47,7 +47,7 @@ import Control.Monad.Trans.Reader (ReaderT)
 import UnliftIO.Resource (ResourceT, runResourceT)
 
 openWith'
-	:: P.RawFilePath 
+	:: RawFilePath 
 	-> (SqlBackend -> Sqlite.Connection -> r)
 	-> SqliteConnectionInfo
 	-> LogFunc
@@ -58,7 +58,7 @@ openWith' db f connInfo logFunc = do
 	return $ f backend conn
 
 runSqlite' :: (MonadUnliftIO m)
-	=> P.RawFilePath
+	=> RawFilePath
 	-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
 	-> m a
 runSqlite' connstr = runResourceT
@@ -68,7 +68,7 @@ runSqlite' connstr = runResourceT
 
 withSqliteConn'
 	:: (MonadUnliftIO m, MonadLoggerIO m)
-	=> P.RawFilePath
+	=> RawFilePath
 	-> (SqlBackend -> m a)
 	-> m a
 withSqliteConn' connstr = withSqliteConnInfo' connstr $
@@ -76,7 +76,7 @@ withSqliteConn' connstr = withSqliteConnInfo' connstr $
 
 runSqliteInfo'
 	:: (MonadUnliftIO m)
-	=> P.RawFilePath
+	=> RawFilePath
 	-> SqliteConnectionInfo
 	-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
 	-> m a
@@ -87,7 +87,7 @@ runSqliteInfo' db conInfo = runResourceT
 
 withSqliteConnInfo'
 	:: (MonadUnliftIO m, MonadLoggerIO m)
-        => P.RawFilePath
+        => RawFilePath
 	-> SqliteConnectionInfo
 	-> (SqlBackend -> m a)
 	-> m a

Git/Tree.hs

@@ -37,14 +37,13 @@ import Git.Command
 import Git.Sha
 import qualified Git.LsTree as LsTree
 import qualified Utility.CoProcess as CoProcess
-import qualified System.FilePath.ByteString as P
+import qualified Utility.OsString as OS
 
 import Numeric
 import System.Posix.Types
 import Control.Monad.IO.Class
 import qualified Data.Set as S
 import qualified Data.Map as M
-import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as S8
 
 newtype Tree = Tree [TreeContent]
@@ -178,10 +177,10 @@ treeItemsToTree = go M.empty
 			Just (NewSubTree d l) ->
 				go (addsubtree idir m (NewSubTree d (c:l))) is
 			_ ->
-				go (addsubtree idir m (NewSubTree (asTopFilePath (toOsPath idir)) [c])) is
+				go (addsubtree idir m (NewSubTree (asTopFilePath idir) [c])) is
 	  where
 		p = gitPath i
-		idir = P.takeDirectory p
+		idir = takeDirectory p
 		c = treeItemToTreeContent i
 
 	addsubtree d m t
@@ -191,10 +190,10 @@ treeItemsToTree = go M.empty
 				Just (NewSubTree d' l) ->
 					let l' = filter (\ti -> gitPath ti /= d) l
 					in addsubtree parent m' (NewSubTree d' (t:l'))
-				_ -> addsubtree parent m' (NewSubTree (asTopFilePath (toOsPath parent)) [t])
+				_ -> addsubtree parent m' (NewSubTree (asTopFilePath parent) [t])
 		| otherwise = M.insert d t m
 	  where
-		parent = P.takeDirectory d
+		parent = takeDirectory d
 
 {- Flattens the top N levels of a Tree. -}
 flattenTree :: Int -> Tree -> Tree
@@ -285,9 +284,9 @@ adjustTree adjusttreeitem addtreeitems resolveaddconflict removefiles r repo =
 	addtreeitempathmap = mkPathMap addtreeitems
 	addtreeitemprefixmap = mkSubTreePathPrefixMap addtreeitems
 
-	removeset = S.fromList $ map (P.normalise . gitPath) removefiles
+	removeset = S.fromList $ map (normalise . gitPath) removefiles
-	removed (TreeBlob f _ _) = S.member (P.normalise (gitPath f)) removeset
+	removed (TreeBlob f _ _) = S.member (normalise (gitPath f)) removeset
-	removed (TreeCommit f _ _) = S.member (P.normalise (gitPath f)) removeset
+	removed (TreeCommit f _ _) = S.member (normalise (gitPath f)) removeset
 	removed (RecordedSubTree _ _ _) = False
 	removed (NewSubTree _ _) = False
 
@@ -303,7 +302,7 @@ adjustTree adjusttreeitem addtreeitems resolveaddconflict removefiles r repo =
 					addoldnew' (M.delete k oldm) ns
 				Nothing -> n : addoldnew' oldm ns
 	addoldnew' oldm [] = M.elems oldm
-	mkk = P.normalise . gitPath
+	mkk = normalise . gitPath
 
 {- Grafts subtree into the basetree at the specified location, replacing
  - anything that the basetree already had at that location.
@@ -360,9 +359,9 @@ graftTree' subtree graftloc basetree repo hdl = go basetree subdirs graftdirs
 		| d == graftloc = graftin' []
 		| otherwise = NewSubTree d [graftin' rest]
 
-	subdirs = P.splitDirectories $ gitPath graftloc
+	subdirs = splitDirectories $ gitPath graftloc
 
-	graftdirs = map (asTopFilePath . toInternalGitPath . toOsPath) $
+	graftdirs = map (asTopFilePath . toInternalGitPath) $
 		pathPrefixes subdirs
 
 {- Assumes the list is ordered, with tree objects coming right before their
@@ -392,16 +391,16 @@ extractTree l = case go [] inTopTree l of
 	parseerr = Left
 
 class GitPath t where
-	gitPath :: t -> RawFilePath
+	gitPath :: t -> OsPath
 
-instance GitPath RawFilePath where
+instance GitPath OsPath where
 	gitPath = id
 
 instance GitPath FilePath where
-	gitPath = toRawFilePath
+	gitPath = toOsPath
 
 instance GitPath TopFilePath where
-	gitPath = fromOsPath . getTopFilePath
+	gitPath = getTopFilePath
 
 instance GitPath TreeItem where
 	gitPath (TreeItem f _ _) = gitPath f
@@ -418,22 +417,22 @@ instance GitPath TreeContent where
 inTopTree :: GitPath t => t -> Bool
 inTopTree = inTree topTreePath
 
-topTreePath :: RawFilePath
+topTreePath :: OsPath
-topTreePath = "."
+topTreePath = literalOsPath "."
 
 inTree :: (GitPath t, GitPath f) => t -> f -> Bool
-inTree t f = gitPath t == P.takeDirectory (gitPath f)
+inTree t f = gitPath t == takeDirectory (gitPath f)
 
 beneathSubTree :: (GitPath t, GitPath f) => t -> f -> Bool
-beneathSubTree t f = subTreePrefix t `B.isPrefixOf` subTreePath f
+beneathSubTree t f = subTreePrefix t `OS.isPrefixOf` subTreePath f
 
-subTreePath :: GitPath t => t -> RawFilePath
+subTreePath :: GitPath t => t -> OsPath
-subTreePath = P.normalise . gitPath
+subTreePath = normalise . gitPath
 
-subTreePrefix :: GitPath t => t -> RawFilePath
+subTreePrefix :: GitPath t => t -> OsPath
 subTreePrefix t
-	| B.null tp = tp
+	| OS.null tp = tp
-	| otherwise = P.addTrailingPathSeparator (P.normalise tp)
+	| otherwise = addTrailingPathSeparator (normalise tp)
   where
 	tp = gitPath t
 
@@ -443,23 +442,23 @@ subTreePrefix t
  - Values that are not in any subdirectory are placed in
  - the topTreePath key.
  -}
-mkPathMap :: GitPath t => [t] -> M.Map RawFilePath [t]
+mkPathMap :: GitPath t => [t] -> M.Map OsPath [t]
 mkPathMap l = M.fromListWith (++) $
-	map (\ti -> (P.takeDirectory (gitPath ti), [ti])) l
+	map (\ti -> (takeDirectory (gitPath ti), [ti])) l
 
 {- Input is eg splitDirectories "foo/bar/baz",
  - for which it will output ["foo", "foo/bar", "foo/bar/baz"] -}
-pathPrefixes :: [RawFilePath] -> [RawFilePath]
+pathPrefixes :: [OsPath] -> [OsPath]
 pathPrefixes = go []
   where
 	go _ [] = []
-	go base (d:rest) = (P.joinPath base P.</> d) : go (base ++ [d]) rest
+	go base (d:rest) = (joinPath base </> d) : go (base ++ [d]) rest
 
 {- Makes a Map where the keys are all subtree path prefixes, 
  - and the values are items with that subtree path prefix.
  -}
-mkSubTreePathPrefixMap :: GitPath t => [t] -> M.Map RawFilePath [t]
+mkSubTreePathPrefixMap :: GitPath t => [t] -> M.Map OsPath [t]
 mkSubTreePathPrefixMap l = M.fromListWith (++) $ concatMap go l
   where
 	go ti = map (\p -> (p, [ti]))
-		(map subTreePrefix $ pathPrefixes $ P.splitDirectories $ subTreePath ti)
+		(map subTreePrefix $ pathPrefixes $ splitDirectories $ subTreePath ti)

Types/GitConfig.hs

@@ -64,7 +64,6 @@ import Control.Concurrent.STM
 import qualified Data.Set as S
 import qualified Data.Map as M
 import qualified Data.ByteString as B
-import qualified System.FilePath.ByteString as P
 
 -- | A configurable value, that may not be fully determined yet because
 -- the global git config has not yet been loaded.
@@ -244,7 +243,7 @@ extractGitConfig configsource r = GitConfig
 	, annexPidLock = getbool (annexConfig "pidlock") False
 	, annexPidLockTimeout = Seconds $ fromMaybe 300 $
 		getmayberead (annexConfig "pidlocktimeout")
-	, annexDbDir = (\d -> toOsPath (toRawFilePath d P.</> fromUUID hereuuid))
+	, annexDbDir = (\d -> toOsPath d </> fromUUID hereuuid)
 		<$> getmaybe (annexConfig "dbdir")
 	, annexAddUnlocked = configurable Nothing $
 		fmap Just $ getmaybe (annexConfig "addunlocked")

Utility/FileSystemEncoding.hs

@@ -23,7 +23,6 @@ module Utility.FileSystemEncoding (
 
 import qualified GHC.IO.Encoding as Encoding
 import System.IO
-import System.FilePath.ByteString (RawFilePath, encodeFilePath, decodeFilePath)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 #ifdef mingw32_HOST_OS
@@ -37,6 +36,9 @@ import Data.Char
 import Data.List
 #endif
 
+-- | A literal file path
+type RawFilePath = S.ByteString
+
 {- Makes all subsequent Handles that are opened, as well as stdio Handles,
  - use the filesystem encoding, instead of the encoding of the current
  - locale.
@@ -90,9 +92,7 @@ encodeBL = L8.fromString
 decodeBS :: S.ByteString -> FilePath
 #ifndef mingw32_HOST_OS
 -- This does the same thing as System.FilePath.ByteString.decodeFilePath,
--- with an identical implementation. However, older versions of that library
+-- with an identical implementation.
--- truncated at NUL, which this must not do, because it may end up used on
--- something other than a unix filepath.
 {-# NOINLINE decodeBS #-}
 decodeBS b = unsafePerformIO $ do
 	enc <- Encoding.getFileSystemEncoding
@@ -104,9 +104,7 @@ decodeBS = S8.toString
 encodeBS :: FilePath -> S.ByteString
 #ifndef mingw32_HOST_OS
 -- This does the same thing as System.FilePath.ByteString.encodeFilePath,
--- with an identical implementation. However, older versions of that library
+-- with an identical implementation.
--- truncated at NUL, which this must not do, because it may end up used on
--- something other than a unix filepath.
 {-# NOINLINE encodeBS #-}
 encodeBS f = unsafePerformIO $ do
 	enc <- Encoding.getFileSystemEncoding
@@ -116,10 +114,10 @@ encodeBS = S8.fromString
 #endif
 
 fromRawFilePath :: RawFilePath -> FilePath
-fromRawFilePath = decodeFilePath
+fromRawFilePath = decodeBS
 
 toRawFilePath :: FilePath -> RawFilePath
-toRawFilePath = encodeFilePath
+toRawFilePath = encodeBS
 
 {- Truncates a FilePath to the given number of bytes (or less),
  - as represented on disk.

Utility/OpenFd.hs

@@ -14,7 +14,8 @@ module Utility.OpenFd where
 
 import System.Posix.IO.ByteString
 import System.Posix.Types
-import System.FilePath.ByteString (RawFilePath)
+
+import Utility.RawFilePath
 
 openFdWithMode :: RawFilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
 #if MIN_VERSION_unix(2,8,0)

Utility/OsPath.hs

@@ -31,7 +31,7 @@ import qualified Data.ByteString.Lazy as L
 import System.OsPath as X hiding (OsPath, OsString, pack, unpack, unsafeFromChar)
 import System.OsPath
 import "os-string" System.OsString.Internal.Types
-import qualified System.FilePath.ByteString as PB
+import qualified System.FilePath as PS
 #if defined(mingw32_HOST_OS)
 import GHC.IO (unsafePerformIO)
 import System.OsString.Encoding.Internal (cWcharsToChars_UCS2)
@@ -100,7 +100,7 @@ bytesFromOsPath = getPosixString . getOsString
 
 {- For some reason not included in System.OsPath -}
 getSearchPath :: IO [OsPath]
-getSearchPath = map toOsPath <$> PB.getSearchPath
+getSearchPath = map toOsPath <$> PS.getSearchPath
 
 {- Used for string constants. Note that when using OverloadedStrings,
  - the IsString instance for ShortByteString only works properly with

Utility/Path/Windows.hs

@@ -15,9 +15,10 @@ module Utility.Path.Windows (
 import Utility.Path
 import Utility.OsPath
 import Utility.SystemDirectory
+import Utility.FileSystemEncoding
 
 import qualified Data.ByteString as B
-import qualified System.FilePath.Windows.ByteString as P
+import qualified System.FilePath.Windows as WinPath
 
 {- Convert a filepath to use Windows's native namespace.
  - This avoids filesystem length limits.
@@ -36,9 +37,9 @@ convertToWindowsNativeNamespace f
 		-- Make absolute because any '.' and '..' in the path
 		-- will not be resolved once it's converted.
 		cwd <- getCurrentDirectory
-		let p = fromOsPath (simplifyPath (combine cwd (toOsPath f)))
+		let p = simplifyPath (combine cwd (toOsPath f))
 		-- Normalize slashes.
-		let p' = P.normalise p
+		let p' = encodeBS $ WinPath.normalise $ fromOsPath p
 		return (win32_file_namespace <> p')
   where
 	win32_dev_namespace = "\\\\.\\"

Utility/Touch.hs

@@ -14,10 +14,11 @@ module Utility.Touch (
 
 #if ! defined(mingw32_HOST_OS)
 
-import System.FilePath.ByteString (RawFilePath)
 import System.Posix.Files.ByteString
 import Data.Time.Clock.POSIX
 
+import Utility.RawFilePath
+
 {- Changes the access and modification times of an existing file.
    Can follow symlinks, or not. -}
 touchBoth :: RawFilePath -> POSIXTime -> POSIXTime -> Bool -> IO ()

git-annex.cabal

@@ -230,7 +230,6 @@ Executable git-annex
    directory (>= 1.2.7.0),
    disk-free-space,
    filepath,
-   filepath-bytestring (>= 1.4.2.1.1),
    IfElse,
    monad-logger (>= 0.3.10),
    free,
@@ -339,6 +338,9 @@ Executable git-annex
       filepath (>= 1.5.2.0),
       file-io (>= 0.1.3)
     CPP-Options: -DWITH_OSPATH
+  else
+    Build-Depends:
+      filepath-bytestring (>= 1.4.2.1.1)
 
   if (os(windows))
     Build-Depends: