From 05bdce328d890cbac68a8627aaae262078a8290a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 23 Jan 2025 10:22:06 -0400 Subject: [PATCH] start converting from System.Directory to System.OsPath This is the start of a long road, got the first few files to compile after this large change. Sponsored-by: mycroft --- Build/Configure.hs | 5 +- Build/TestConfig.hs | 3 +- Build/Version.hs | 2 +- Utility/FileIO.hs | 39 +++++++++++--- Utility/MoveFile.hs | 7 ++- Utility/OsPath.hs | 51 ++++++++++++------ Utility/Path.hs | 22 +++++--- Utility/SystemDirectory.hs | 103 ++++++++++++++++++++++++++++++++++--- 8 files changed, 185 insertions(+), 47 deletions(-) diff --git a/Build/Configure.hs b/Build/Configure.hs index cce9488bae..2c848ce965 100644 --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -11,6 +11,7 @@ import Utility.SafeCommand import Utility.Env.Basic import qualified Git.Version import Utility.SystemDirectory +import Utility.OsPath import Control.Monad import Control.Applicative @@ -91,11 +92,11 @@ getSshConnectionCaching = Config "sshconnectioncaching" . BoolConfig <$> setup :: IO () setup = do - createDirectoryIfMissing True tmpDir + createDirectoryIfMissing True (toOsPath tmpDir) writeFile testFile "test file contents" cleanup :: IO () -cleanup = removeDirectoryRecursive tmpDir +cleanup = removeDirectoryRecursive (toOsPath tmpDir) run :: [TestCase] -> IO () run ts = do diff --git a/Build/TestConfig.hs b/Build/TestConfig.hs index 5458612d4c..89a8027fa8 100644 --- a/Build/TestConfig.hs +++ b/Build/TestConfig.hs @@ -8,6 +8,7 @@ import Utility.Path import Utility.Monad import Utility.SafeCommand import Utility.SystemDirectory +import Utility.OsPath import System.IO import System.FilePath @@ -106,7 +107,7 @@ findCmdPath k command = do where find d = let f = d command - in ifM (doesFileExist f) ( return (Just f), return Nothing ) + in ifM (doesFileExist (toOsPath f)) ( return (Just f), return Nothing ) quiet :: String -> String quiet s = s ++ " >/dev/null 2>&1" diff --git a/Build/Version.hs b/Build/Version.hs index e3b905919d..3552814116 100644 --- a/Build/Version.hs +++ b/Build/Version.hs @@ -73,4 +73,4 @@ writeVersion ver = catchMaybeIO (F.readFile' f) >>= \case , "" ] footer = [] - f = toOsPath "Build/Version" + f = literalOsPath "Build/Version" diff --git a/Utility/FileIO.hs b/Utility/FileIO.hs index 5a8f661ce5..b604581fc6 100644 --- a/Utility/FileIO.hs +++ b/Utility/FileIO.hs @@ -89,21 +89,44 @@ openTempFile p s = do #endif #else --- When not building with OsPath, export FilePath versions --- instead. However, functions still use ByteString for the --- file content in that case, unlike the Strings used by the Prelude. +-- When not building with OsPath, export RawFilePath versions +-- instead. import Utility.OsPath -import System.IO (withFile, openFile, openTempFile, IO) +import Utility.FileSystemEncoding +import System.IO (IO, Handle, IOMode) +import Prelude ((.), return) import qualified System.IO -import Data.ByteString.Lazy (readFile, writeFile, appendFile) import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L + +withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r +withFile = System.IO.withFile . fromRawFilePath + +openFile :: OsPath -> IOMode -> IO Handle +openFile = System.IO.openFile . fromRawFilePath + +readFile :: OsPath -> IO L.ByteString +readFile = L.readFile . fromRawFilePath readFile' :: OsPath -> IO B.ByteString -readFile' = B.readFile +readFile' = B.readFile . fromRawFilePath + +writeFile :: OsPath -> L.ByteString -> IO () +writeFile = L.writeFile . fromRawFilePath writeFile' :: OsPath -> B.ByteString -> IO () -writeFile' = B.writeFile +writeFile' = B.writeFile . fromRawFilePath + +appendFile :: OsPath -> L.ByteString -> IO () +appendFile = L.appendFile . fromRawFilePath appendFile' :: OsPath -> B.ByteString -> IO () -appendFile' = B.appendFile +appendFile' = B.appendFile . fromRawFilePath + +openTempFile :: OsPath -> OsPath -> IO (OsPath, Handle) +openTempFile p s = do + (t, h) <- System.IO.openTempFile + (fromRawFilePath p) + (fromRawFilePath s) + return (toRawFilePath t, h) #endif diff --git a/Utility/MoveFile.hs b/Utility/MoveFile.hs index d80c9203f8..95cd716c4b 100644 --- a/Utility/MoveFile.hs +++ b/Utility/MoveFile.hs @@ -46,7 +46,6 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename rethrow = throwM e mv tmp () = do - let tmp' = fromRawFilePath (fromOsPath tmp) -- copyFile is likely not as optimised as -- the mv command, so we'll use the command. -- @@ -59,18 +58,18 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename ok <- copyright =<< boolSystem "mv" [ Param "-f" , Param (fromRawFilePath src) - , Param tmp' + , Param (fromRawFilePath (fromOsPath tmp)) ] let e' = e #else - r <- tryIO $ copyFile (fromRawFilePath src) tmp' + r <- tryIO $ copyFile src tmp let (ok, e') = case r of Left err -> (False, err) Right _ -> (True, e) #endif unless ok $ do -- delete any partial - _ <- tryIO $ removeFile tmp' + _ <- tryIO $ removeFile tmp throwM e' #ifndef mingw32_HOST_OS diff --git a/Utility/OsPath.hs b/Utility/OsPath.hs index 5a62e61004..0567b647ab 100644 --- a/Utility/OsPath.hs +++ b/Utility/OsPath.hs @@ -7,51 +7,68 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.OsPath ( OsPath, OsString, + literalOsPath, toOsPath, fromOsPath, ) where import Utility.FileSystemEncoding - #ifdef WITH_OSPATH import System.OsPath import "os-string" System.OsString.Internal.Types import qualified Data.ByteString.Short as S +#else +import qualified Data.ByteString as S +#endif + +class OsPathConv t where + toOsPath :: t -> OsPath + fromOsPath :: OsPath -> t + +instance OsPathConv FilePath where + toOsPath = toOsPath . toRawFilePath + fromOsPath = fromRawFilePath . fromOsPath + +{- Used for string constants. -} +literalOsPath :: String -> OsPath +literalOsPath = toOsPath + +#ifdef WITH_OSPATH +instance OsPathConv RawFilePath where + toOsPath = bytesToOsPath + fromOsPath = bytesFromOsPath {- Unlike System.OsString.fromBytes, on Windows this does not ensure a - valid USC-2LE encoding. The input ByteString must be in a valid encoding - already or uses of the OsPath will fail. -} -toOsPath :: RawFilePath -> OsPath +bytesToOsPath :: RawFilePath -> OsPath #if defined(mingw32_HOST_OS) -toOsPath = OsString . WindowsString . S.toShort +bytesToOsPath = OsString . WindowsString . S.toShort #else -toOsPath = OsString . PosixString . S.toShort +bytesToOsPath = OsString . PosixString . S.toShort #endif -fromOsPath :: OsPath -> RawFilePath +bytesFromOsPath :: OsPath -> RawFilePath #if defined(mingw32_HOST_OS) -fromOsPath = S.fromShort . getWindowsString . getOsString +bytesFromOsPath = S.fromShort . getWindowsString . getOsString #else -fromOsPath = S.fromShort . getPosixString . getOsString +bytesFromOsPath = S.fromShort . getPosixString . getOsString #endif #else -{- When not building with WITH_OSPATH, use FilePath. This allows - - using functions from legacy FilePath libraries interchangeably with - - newer OsPath libraries. +{- When not building with WITH_OSPATH, use RawFilePath. -} -type OsPath = FilePath +type OsPath = RawFilePath -type OsString = String +type OsString = S.ByteString -toOsPath :: RawFilePath -> OsPath -toOsPath = fromRawFilePath - -fromOsPath :: OsPath -> RawFilePath -fromOsPath = toRawFilePath +instance OsPathConv RawFilePath where + toOsPath = id + fromOsPath = id #endif diff --git a/Utility/Path.hs b/Utility/Path.hs index de13712d32..493efcad1c 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -28,7 +28,11 @@ module Utility.Path ( ) where import System.FilePath.ByteString -import qualified System.FilePath as P +#ifdef WITH_OSPATH +import qualified System.OsPath as P +#else +import qualified System.FilePath.ByteString as P +#endif import qualified Data.ByteString as B import Data.List import Data.Maybe @@ -40,6 +44,7 @@ import Author import Utility.Monad import Utility.SystemDirectory import Utility.Exception +import Utility.OsPath #ifdef mingw32_HOST_OS import Data.Char @@ -251,15 +256,16 @@ inSearchPath command = isJust <$> searchPath command - - Note that this will find commands in PATH that are not executable. -} -searchPath :: String -> IO (Maybe FilePath) +searchPath :: String -> IO (Maybe OsPath) searchPath command - | P.isAbsolute command = copyright $ check command - | otherwise = P.getSearchPath >>= getM indir + | P.isAbsolute command' = copyright $ check command' + | otherwise = getSearchPath >>= getM indir . map toOsPath where - indir d = check $ d P. command + command' = toOsPath command + indir d = check (d P. command') check f = firstM doesFileExist #ifdef mingw32_HOST_OS - [f, f ++ ".exe"] + [f, f <> ".exe"] #else [f] #endif @@ -270,10 +276,10 @@ searchPath command - - Note that this will find commands in PATH that are not executable. -} -searchPathContents :: (FilePath -> Bool) -> IO [FilePath] +searchPathContents :: (OsPath -> Bool) -> IO [OsPath] searchPathContents p = filterM doesFileExist - =<< (concat <$> (P.getSearchPath >>= mapM go)) + =<< (concat <$> (getSearchPath >>= mapM (go . toOsPath))) where go d = map (d P.) . filter p <$> catchDefaultIO [] (getDirectoryContents d) diff --git a/Utility/SystemDirectory.hs b/Utility/SystemDirectory.hs index a7d60f931e..4ea9b4dbbe 100644 --- a/Utility/SystemDirectory.hs +++ b/Utility/SystemDirectory.hs @@ -1,16 +1,107 @@ -{- System.Directory without its conflicting isSymbolicLink and getFileSize. +{- System.Directory wrapped to use OsPath. + - + - getFileSize is omitted, use Utility.FileSize instead - - Copyright 2016 Joey Hess - - License: BSD-2-clause -} --- Disable warnings because only some versions of System.Directory export --- isSymbolicLink. -{-# OPTIONS_GHC -fno-warn-tabs -w #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.SystemDirectory ( - module System.Directory + createDirectory, + createDirectoryIfMissing, + removeDirectory, + removeDirectoryRecursive, + removePathForcibly, + renameDirectory, + listDirectory, + getDirectoryContents, + getCurrentDirectory, + setCurrentDirectory, + withCurrentDirectory, + getTemporaryDirectory, + removeFile, + renameFile, + renamePath, + copyFile, + canonicalizePath, + doesPathExist, + doesFileExist, + doesDirectoryExist, + getModificationTime, ) where -import System.Directory hiding (isSymbolicLink, getFileSize) +#ifdef WITH_OSPATH +import System.Directory.OsPath +#else +import qualified System.Directory as X +import Data.Time.Clock (UTCTime) +import Utility.OsPath +import Utility.FileSystemEncoding + +createDirectory :: OsPath -> IO () +createDirectory = X.createDirectory . fromRawFilePath + +createDirectoryIfMissing :: Bool -> OsPath -> IO () +createDirectoryIfMissing b = X.createDirectoryIfMissing b . fromRawFilePath + +removeDirectory :: OsPath -> IO () +removeDirectory = X.removeDirectory . fromRawFilePath + +removeDirectoryRecursive :: OsPath -> IO () +removeDirectoryRecursive = X.removeDirectoryRecursive . fromRawFilePath + +removePathForcibly :: OsPath -> IO () +removePathForcibly = X.removePathForcibly . fromRawFilePath + +renameDirectory :: OsPath -> OsPath -> IO () +renameDirectory a b = X.renameDirectory (fromRawFilePath a) (fromRawFilePath b) + +listDirectory :: OsPath -> IO [OsPath] +listDirectory p = map toRawFilePath <$> X.listDirectory (fromRawFilePath p) + +getDirectoryContents :: OsPath -> IO [OsPath] +getDirectoryContents p = map toRawFilePath <$> X.getDirectoryContents (fromRawFilePath p) + +getCurrentDirectory :: IO OsPath +getCurrentDirectory = toRawFilePath <$> X.getCurrentDirectory + +setCurrentDirectory :: OsPath -> IO () +setCurrentDirectory = X.setCurrentDirectory . fromRawFilePath + +withCurrentDirectory :: OsPath -> IO a -> IO a +withCurrentDirectory = X.withCurrentDirectory . fromRawFilePath + +getTemporaryDirectory :: IO OsPath +getTemporaryDirectory = toRawFilePath <$> X.getTemporaryDirectory + +removeFile :: OsPath -> IO () +removeFile = X.removeFile . fromRawFilePath + +renameFile :: OsPath -> OsPath -> IO () +renameFile a b = X.renameFile (fromRawFilePath a) (fromRawFilePath b) + +renamePath :: OsPath -> OsPath -> IO () +renamePath a b = X.renamePath (fromRawFilePath a) (fromRawFilePath b) + +copyFile :: OsPath -> OsPath -> IO () +copyFile a b = X.copyFile (fromRawFilePath a) (fromRawFilePath b) + +canonicalizePath :: OsPath -> IO OsPath +canonicalizePath p = toRawFilePath <$> X.canonicalizePath (fromRawFilePath p) + +doesPathExist :: OsPath -> IO Bool +doesPathExist = X.doesPathExist . fromRawFilePath + +doesFileExist :: OsPath -> IO Bool +doesFileExist = X.doesFileExist . fromRawFilePath + +doesDirectoryExist :: OsPath -> IO Bool +doesDirectoryExist = X.doesDirectoryExist . fromRawFilePath + +getModificationTime :: OsPath -> IO UTCTime +getModificationTime = X.getModificationTime . fromRawFilePath +#endif