more OsPath conversion

Finally reached Annex code in this conversion.

Sponsored-by: Graham Spencer

Utility/FileIO.hs

@@ -16,6 +16,7 @@ module Utility.FileIO
 (
 	withFile,
 	openFile,
+	openBinaryFile,
 	readFile,
 	readFile',
 	writeFile,
@@ -51,6 +52,11 @@ openFile f m = do
 	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)
 	O.openFile f' m
 
+openBinaryFile :: OsPath -> IOMode -> IO Handle
+openBinaryFile f m = do
+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)
+	O.openBinaryFile f' m
+
 readFile :: OsPath -> IO L.ByteString
 readFile f = do
 	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)
@@ -104,6 +110,9 @@ withFile = System.IO.withFile . fromRawFilePath
 openFile :: OsPath -> IOMode -> IO Handle
 openFile = System.IO.openFile . fromRawFilePath
 
+openBinaryFile :: OsPath -> IOMode -> IO Handle
+openBinaryFile = System.IO.openBinaryFile . fromRawFilePath
+
 readFile :: OsPath -> IO L.ByteString
 readFile = L.readFile . fromRawFilePath
 

Utility/FileSize.hs

@@ -24,6 +24,7 @@ import System.PosixCompat.Files (fileSize)
 #endif
 import System.PosixCompat.Files (FileStatus)
 import qualified Utility.RawFilePath as R
+import Utility.OsPath
 
 type FileSize = Integer
 
@@ -33,18 +34,18 @@ type FileSize = Integer
  - FileOffset which maxes out at 2 gb.
  - See https://github.com/jystic/unix-compat/issues/16
  -}
-getFileSize :: R.RawFilePath -> IO FileSize
+getFileSize :: OsPath -> IO FileSize
 #ifndef mingw32_HOST_OS
-getFileSize f = fmap (fromIntegral . fileSize) (R.getFileStatus f)
+getFileSize f = fmap (fromIntegral . fileSize) (R.getFileStatus (fromOsPath f))
 #else
-getFileSize f = bracket (F.openFile (toOsPath f) ReadMode) hClose hFileSize
+getFileSize f = bracket (F.openFile f ReadMode) hClose hFileSize
 #endif
 
 {- Gets the size of the file, when its FileStatus is already known.
  -
  - On windows, uses getFileSize. Otherwise, the FileStatus contains the
  - size, so this does not do any work. -}
-getFileSize' :: R.RawFilePath -> FileStatus -> IO FileSize
+getFileSize' :: OsPath -> FileStatus -> IO FileSize
 #ifndef mingw32_HOST_OS
 getFileSize' _ s = return $ fromIntegral $ fileSize s
 #else

Utility/Gpg.hs

@@ -182,7 +182,7 @@ feedRead cmd params passphrase feeder reader = do
 	withTmpFile (toOsPath "gpg") $ \tmpfile h -> do
 		liftIO $ B.hPutStr h passphrase
 		liftIO $ hClose h
-		let passphrasefile = [Param "--passphrase-file", File (fromRawFilePath (fromOsPath tmpfile))]
+		let passphrasefile = [Param "--passphrase-file", File (fromOsPath tmpfile)]
 		go $ passphrasefile ++ params
 #endif
   where
@@ -441,7 +441,7 @@ testHarness tmpdir cmd a = ifM (inSearchPath (unGpgCmd cmd))
 	go Nothing = return Nothing
 
         makenewdir n = do
-		let subdir = tmpdir </> show n
+		let subdir = toOsPath tmpdir </> toOsPath (show n)
 		catchIOErrorType AlreadyExists (const $ makenewdir $ n + 1) $ do
 			createDirectory subdir
 			return subdir

Utility/InodeCache.hs

@@ -49,6 +49,7 @@ import Common
 import Utility.TimeStamp
 import Utility.QuickCheck
 import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
 
 import System.PosixCompat.Types
 import System.PosixCompat.Files (isRegularFile, fileID)
@@ -189,20 +190,20 @@ readInodeCache s = case words s of
 		return $ InodeCache $ InodeCachePrim i sz (MTimeHighRes t)
 	_ -> Nothing
 
-genInodeCache :: RawFilePath -> TSDelta -> IO (Maybe InodeCache)
+genInodeCache :: OsPath -> TSDelta -> IO (Maybe InodeCache)
 genInodeCache f delta = catchDefaultIO Nothing $
-	toInodeCache delta f =<< R.getSymbolicLinkStatus f
+	toInodeCache delta f =<< R.getSymbolicLinkStatus (fromOsPath f)
 
-toInodeCache :: TSDelta -> RawFilePath -> FileStatus -> IO (Maybe InodeCache)
+toInodeCache :: TSDelta -> OsPath -> FileStatus -> IO (Maybe InodeCache)
 toInodeCache d f s = toInodeCache' d f s (fileID s)
 
-toInodeCache' :: TSDelta -> RawFilePath -> FileStatus -> FileID -> IO (Maybe InodeCache)
+toInodeCache' :: TSDelta -> OsPath -> FileStatus -> FileID -> IO (Maybe InodeCache)
 toInodeCache' (TSDelta getdelta) f s inode
 	| isRegularFile s = do
 		delta <- getdelta
 		sz <- getFileSize' f s
 #ifdef mingw32_HOST_OS
-		mtime <- utcTimeToPOSIXSeconds <$> getModificationTime (fromRawFilePath f)
+		mtime <- utcTimeToPOSIXSeconds <$> getModificationTime f
 #else
 		let mtime = Posix.modificationTimeHiRes s
 #endif
@@ -214,8 +215,8 @@ toInodeCache' (TSDelta getdelta) f s inode
  - Its InodeCache at the time of its creation is written to the cache file,
  - so changes can later be detected. -}
 data SentinalFile = SentinalFile
-	{ sentinalFile :: RawFilePath
-	, sentinalCacheFile :: RawFilePath
+	{ sentinalFile :: OsPath
+	, sentinalCacheFile :: OsPath
 	}
 	deriving (Show)
 
@@ -232,8 +233,8 @@ noTSDelta = TSDelta (pure 0)
 
 writeSentinalFile :: SentinalFile -> IO ()
 writeSentinalFile s = do
-	writeFile (fromRawFilePath (sentinalFile s)) ""
-	maybe noop (writeFile (fromRawFilePath (sentinalCacheFile s)) . showInodeCache)
+	F.writeFile' (sentinalFile s) mempty
+	maybe noop (writeFile (fromOsPath (sentinalCacheFile s)) . showInodeCache)
 		=<< genInodeCache (sentinalFile s) noTSDelta
 
 data SentinalStatus = SentinalStatus
@@ -262,7 +263,7 @@ checkSentinalFile s = do
 				Just new -> return $ calc old new
   where
 	loadoldcache = catchDefaultIO Nothing $
-		readInodeCache <$> readFile (fromRawFilePath (sentinalCacheFile s))
+		readInodeCache <$> readFile (fromOsPath (sentinalCacheFile s))
 	gennewcache = genInodeCache (sentinalFile s) noTSDelta
 	calc (InodeCache (InodeCachePrim oldinode oldsize oldmtime)) (InodeCache (InodeCachePrim newinode newsize newmtime)) =
 		SentinalStatus (not unchanged) tsdelta
@@ -287,7 +288,7 @@ checkSentinalFile s = do
 	dummy = SentinalStatus True noTSDelta
 
 sentinalFileExists :: SentinalFile -> IO Bool
-sentinalFileExists s = allM R.doesPathExist [sentinalCacheFile s, sentinalFile s]
+sentinalFileExists s = allM doesPathExist [sentinalCacheFile s, sentinalFile s]
 
 instance Arbitrary InodeCache where
 	arbitrary =

Utility/LogFile.hs

@@ -35,7 +35,7 @@ rotateLog logfile = go 0
   where
 	go num
 		| num > maxLogs = return ()
-		| otherwise = whenM (doesFileExist currfile) $ do
+		| otherwise = whenM (doesFileExist (toOsPath currfile)) $ do
 			go (num + 1)
 			rename (toRawFilePath currfile) (toRawFilePath nextfile)
 	  where
@@ -50,7 +50,7 @@ rotatedLog logfile n = logfile ++ "." ++ show n
 
 {- Lists most recent logs last. -}
 listLogs :: FilePath -> IO [FilePath]
-listLogs logfile = filterM doesFileExist $ reverse $ 
+listLogs logfile = filterM (doesFileExist . toOsPath) $ reverse $ 
 	logfile : map (rotatedLog logfile) [1..maxLogs]
 
 maxLogs :: Int

Utility/Lsof.hs

@@ -15,6 +15,7 @@ module Utility.Lsof (
 import Common
 import BuildInfo
 import Utility.Env.Set
+import qualified Utility.OsString as OS
 
 import System.Posix.Types
 
@@ -30,12 +31,14 @@ data ProcessInfo = ProcessInfo ProcessID CmdLine
  - path where the program was found. Make sure at runtime that lsof is
  - available, and if it's not in PATH, adjust PATH to contain it. -}
 setup :: IO ()
-setup = do
-	let cmd = fromMaybe "lsof" BuildInfo.lsof
-	when (isAbsolute cmd) $ do
+setup = when (isAbsolute cmd) $ do
 	path <- getSearchPath
-		let path' = takeDirectory cmd : path
-		setEnv "PATH" (intercalate [searchPathSeparator] path') True
+	let path' = fromOsPath $ OS.intercalate sep $
+		takeDirectory cmd : path
+	setEnv "PATH" path' True
+  where
+	cmd = toOsPath $ fromMaybe "lsof" BuildInfo.lsof
+	sep = OS.singleton searchPathSeparator
 
 {- Checks each of the files in a directory to find open files.
  - Note that this will find hard links to files elsewhere that are open. -}

Utility/Metered.hs

@@ -227,7 +227,7 @@ defaultChunkSize = 32 * k - chunkOverhead
  -}
 watchFileSize
 	:: (MonadIO m, MonadMask m)
-	=> RawFilePath
+	=> OsPath
 	-> MeterUpdate
 	-> (MeterUpdate -> m a)
 	-> m a

Utility/Url.hs

@@ -50,6 +50,7 @@ import Utility.IPAddress
 import qualified Utility.RawFilePath as R
 import Utility.Hash (IncrementalVerifier(..))
 import Utility.Url.Parse
+import qualified Utility.FileIO as F
 
 import Network.URI
 import Network.HTTP.Types
@@ -311,8 +312,8 @@ getUrlInfo url uo = case parseURIRelaxed url of
 		=<< curlRestrictedParams r u defport (basecurlparams url')
 
 	existsfile u = do
-		let f = toRawFilePath (unEscapeString (uriPath u))
-		s <- catchMaybeIO $ R.getSymbolicLinkStatus f
+		let f = toOsPath (unEscapeString (uriPath u))
+		s <- catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath f)
 		case s of
 			Just stat -> do
 				sz <- getFileSize' f stat
@@ -362,10 +363,10 @@ headRequest r = r
  -
  - When the download fails, returns an error message.
  -}
-download :: MeterUpdate -> Maybe IncrementalVerifier -> URLString -> FilePath -> UrlOptions -> IO (Either String ())
+download :: MeterUpdate -> Maybe IncrementalVerifier -> URLString -> OsPath -> UrlOptions -> IO (Either String ())
 download = download' False
 
-download' :: Bool -> MeterUpdate -> Maybe IncrementalVerifier -> URLString -> FilePath -> UrlOptions -> IO (Either String ())
+download' :: Bool -> MeterUpdate -> Maybe IncrementalVerifier -> URLString -> OsPath -> UrlOptions -> IO (Either String ())
 download' nocurlerror meterupdate iv url file uo =
 	catchJust matchHttpException go showhttpexception
 		`catchNonAsync` (dlfailed . show)
@@ -421,8 +422,8 @@ download' nocurlerror meterupdate iv url file uo =
 		-- curl does not create destination file
 		-- if the url happens to be empty, so pre-create.
 		unlessM (doesFileExist file) $
-			writeFile file ""
-		ifM (boolSystem "curl" (curlparams ++ [Param "-o", File file, File rawurl]))
+			F.writeFile file mempty
+		ifM (boolSystem "curl" (curlparams ++ [Param "-o", File (fromOsPath file), File rawurl]))
 			( return $ Right ()
 			, return $ Left "download failed"
 			)
@@ -434,7 +435,7 @@ download' nocurlerror meterupdate iv url file uo =
 		noverification
 		let src = unEscapeString (uriPath u)
 		withMeteredFile src meterupdate $
-			L.writeFile file
+			F.writeFile file
 		return $ Right ()
 
 	-- Conduit does not support ftp, so will throw an exception on a
@@ -461,9 +462,9 @@ download' nocurlerror meterupdate iv url file uo =
  - thrown for reasons other than http status codes will still be thrown
  - as usual.)
  -}
-downloadConduit :: MeterUpdate -> Maybe IncrementalVerifier -> Request -> FilePath -> UrlOptions -> IO ()
+downloadConduit :: MeterUpdate -> Maybe IncrementalVerifier -> Request -> OsPath -> UrlOptions -> IO ()
 downloadConduit meterupdate iv req file uo =
-	catchMaybeIO (getFileSize (toRawFilePath file)) >>= \case
+	catchMaybeIO (getFileSize file) >>= \case
 		Just sz | sz > 0 -> resumedownload sz
 		_ -> join $ runResourceT $ do
 			liftIO $ debug "Utility.Url" (show req')
@@ -566,7 +567,7 @@ sinkResponseFile
 	=> MeterUpdate
 	-> Maybe IncrementalVerifier
 	-> BytesProcessed
-	-> FilePath
+	-> OsPath
 	-> IOMode
 	-> Response (ConduitM () B8.ByteString m ())
 	-> m ()
@@ -577,7 +578,7 @@ sinkResponseFile meterupdate iv initialp file mode resp = do
 			return (const noop)
 		(Just iv', _) -> return (updateIncrementalVerifier iv')
 		(Nothing, _) -> return (const noop)
-	(fr, fh) <- allocate (openBinaryFile file mode) hClose
+	(fr, fh) <- allocate (F.openBinaryFile file mode) hClose
 	runConduit $ responseBody resp .| go ui initialp fh
 	release fr
   where

doc/todo/RawFilePath_conversion.mdwn

@@ -26,6 +26,18 @@ status.
   Make Utility.SystemDirectory import it when built with OsPath,
   and the remaining 6 hours or work will explain itself..
   This has been started in the `ospath` branch.
+* As part of the OsPath conversion, Git.LsFiles has several
+  `pipeNullSplit'` calls that have toOsPath mapped over the results.
+  That adds an additional copy, so the lazy ByteString is converted to strict,
+  and then to ShortByteString, with a copy each time. This is in the
+  critical path for large git repos, and might be a noticable slowdown.
+  There is currently no easy way to go direct from a lazy ByteString to a
+  ShortByteString, although it would certianly be possible to write low
+  level code to do it efficiently. Alternatively, it would be possible to
+  read a strict ByteString direct from a handle, like hGetLine does
+  (although in this case it would need to stop at the terminating 0 byte)
+  and unsafePerformIO to stream to a list would avoid needing to rewrite
+  this code to not use a list.
 
 [[!tag confirmed]]