From 1faa3af9cd074c61445503032b0dcf2c01a6f801 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Jan 2025 14:26:04 -0400 Subject: [PATCH] add file-io to build-depends when building with OsPath flag Partly converted code to use functions from it, though more remain unconverted. Most of withFile and openFile now use it. --- Annex/Journal.hs | 5 +- Annex/Link.hs | 7 +- Annex/Proxy.hs | 3 +- CHANGELOG | 1 + Command/AddUrl.hs | 2 +- Command/Fsck.hs | 3 +- Common.hs | 1 + Logs/File.hs | 25 +++---- Logs/Migrate.hs | 2 +- Logs/Restage.hs | 6 +- Logs/Smudge.hs | 2 +- Upgrade/V5/Direct.hs | 5 +- Utility/Directory.hs | 35 +++------ Utility/FileIO.hs | 103 +++++++++++++++++++++++++++ Utility/FileMode.hs | 4 +- Utility/FileSize.hs | 4 +- Utility/HtmlDetect.hs | 7 +- Utility/OsPath.hs | 18 +++-- doc/todo/RawFilePath_conversion.mdwn | 9 ++- git-annex.cabal | 4 +- 20 files changed, 178 insertions(+), 68 deletions(-) create mode 100644 Utility/FileIO.hs diff --git a/Annex/Journal.hs b/Annex/Journal.hs index 72582b6f88..ac2f05ae97 100644 --- a/Annex/Journal.hs +++ b/Annex/Journal.hs @@ -27,6 +27,7 @@ import Annex.BranchState import Types.BranchState import Utility.Directory.Stream import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import qualified Data.Set as S import qualified Data.ByteString.Lazy as L @@ -92,7 +93,7 @@ setJournalFile _jl ru file content = withOtherTmp $ \tmp -> do -- journal file is written atomically let jfile = journalFile file let tmpfile = tmp P. jfile - liftIO $ withFile (fromRawFilePath tmpfile) WriteMode $ \h -> + liftIO $ F.withFile (toOsPath tmpfile) WriteMode $ \h -> writeJournalHandle h content let dest = jd P. jfile let mv = do @@ -133,7 +134,7 @@ checkCanAppendJournalFile _jl ru file = do -} appendJournalFile :: Journalable content => JournalLocked -> AppendableJournalFile -> content -> Annex () appendJournalFile _jl (AppendableJournalFile (jd, jfile)) content = do - let write = liftIO $ withFile (fromRawFilePath jfile) ReadWriteMode $ \h -> do + let write = liftIO $ F.withFile (toOsPath jfile) ReadWriteMode $ \h -> do sz <- hFileSize h when (sz /= 0) $ do hSeek h SeekFromEnd (-1) diff --git a/Annex/Link.hs b/Annex/Link.hs index 4961499f62..72b0d3afff 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -38,6 +38,7 @@ import Utility.Tmp.Dir import Utility.CopyFile import qualified Database.Keys.Handle import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 @@ -87,7 +88,7 @@ getAnnexLinkTarget' file coresymlinks = if coresymlinks probesymlink = R.readSymbolicLink file - probefilecontent = withFile (fromRawFilePath file) ReadMode $ \h -> do + probefilecontent = F.withFile (toOsPath file) ReadMode $ \h -> do s <- S.hGet h maxSymlinkSz -- If we got the full amount, the file is too large -- to be a symlink target. @@ -434,7 +435,7 @@ maxSymlinkSz = 8192 isPointerFile :: RawFilePath -> IO (Maybe Key) isPointerFile f = catchDefaultIO Nothing $ #if defined(mingw32_HOST_OS) - withFile (fromRawFilePath f) ReadMode readhandle + F.withFile (toOsPath f) ReadMode readhandle #else #if MIN_VERSION_unix(2,8,0) let open = do @@ -445,7 +446,7 @@ isPointerFile f = catchDefaultIO Nothing $ #else ifM (isSymbolicLink <$> R.getSymbolicLinkStatus f) ( return Nothing - , withFile (fromRawFilePath f) ReadMode readhandle + , F.withFile (toOsPath f) ReadMode readhandle ) #endif #endif diff --git a/Annex/Proxy.hs b/Annex/Proxy.hs index 4f11f617c9..6ac652c642 100644 --- a/Annex/Proxy.hs +++ b/Annex/Proxy.hs @@ -30,6 +30,7 @@ import Utility.Tmp.Dir import Utility.Metered import Git.Types import qualified Database.Export as Export +import qualified Utility.FileIO as F #ifndef mingw32_HOST_OS import Utility.OpenFile #endif @@ -184,7 +185,7 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv oclosedv mexportdb = go -- the client, to avoid bad content -- being stored in the special remote. iv <- startVerifyKeyContentIncrementally Remote.AlwaysVerify k - h <- liftIO $ openFile (fromRawFilePath tmpfile) WriteMode + h <- liftIO $ F.openFile (toOsPath tmpfile) WriteMode let nuketmp = liftIO $ removeWhenExistsWith removeFile (fromRawFilePath tmpfile) gotall <- liftIO $ receivetofile iv h len liftIO $ hClose h diff --git a/CHANGELOG b/CHANGELOG index fa11259b2b..f720bf9850 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -3,6 +3,7 @@ git-annex (10.20250116) UNRELEASED; urgency=medium * Support help.autocorrect settings "prompt", "never", and "immediate". * Allow setting remote.foo.annex-tracking-branch to a branch name that contains "/", as long as it's not a remote tracking branch. + * Added OsPath build flag, which speeds up git-annex's operations on files. -- Joey Hess Mon, 20 Jan 2025 10:24:51 -0400 diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 7feb0b19eb..a749c55527 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -353,7 +353,7 @@ downloadWeb addunlockedmatcher o url urlinfo file = urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing (verifiableOption o) downloader f p = Url.withUrlOptions $ downloadUrl False urlkey p Nothing [url] f go Nothing = return Nothing - go (Just (tmp, backend)) = ifM (useYoutubeDl o <&&> liftIO (isHtmlFile (fromRawFilePath tmp))) + go (Just (tmp, backend)) = ifM (useYoutubeDl o <&&> liftIO (isHtmlFile tmp)) ( tryyoutubedl tmp backend , normalfinish tmp backend ) diff --git a/Command/Fsck.hs b/Command/Fsck.hs index bb2b1258a3..e01b3402d5 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -45,6 +45,7 @@ import qualified Database.Fsck as FsckDb import Types.CleanupActions import Types.Key import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import Data.Time.Clock.POSIX import System.Posix.Types (EpochTime) @@ -678,7 +679,7 @@ recordStartTime u = do f <- fromRepo (gitAnnexFsckState u) createAnnexDirectory $ parentDir f liftIO $ removeWhenExistsWith R.removeLink f - liftIO $ withFile (fromRawFilePath f) WriteMode $ \h -> do + liftIO $ F.withFile (toOsPath f) WriteMode $ \h -> do #ifndef mingw32_HOST_OS t <- modificationTime <$> R.getFileStatus f #else diff --git a/Common.hs b/Common.hs index b1e77b30ff..71681275f9 100644 --- a/Common.hs +++ b/Common.hs @@ -33,5 +33,6 @@ import Utility.FileSize as X import Utility.Network as X import Utility.Split as X import Utility.FileSystemEncoding as X +import Utility.OsPath as X import Utility.PartialPrelude as X diff --git a/Logs/File.hs b/Logs/File.hs index e129da0553..08203121ef 100644 --- a/Logs/File.hs +++ b/Logs/File.hs @@ -26,6 +26,7 @@ import Annex.Perms import Annex.LockFile import Annex.ReplaceFile import Utility.Tmp +import qualified Utility.FileIO as F import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 @@ -52,7 +53,7 @@ withLogHandle f a = do where setup tmp = do setAnnexFilePerm tmp - liftIO $ openFile (fromRawFilePath tmp) WriteMode + liftIO $ F.openFile (toOsPath tmp) WriteMode cleanup h = liftIO $ hClose h -- | Appends a line to a log file, first locking it to prevent @@ -61,11 +62,9 @@ appendLogFile :: RawFilePath -> RawFilePath -> L.ByteString -> Annex () appendLogFile f lck c = createDirWhenNeeded f $ withExclusiveLock lck $ do - liftIO $ withFile f' AppendMode $ + liftIO $ F.withFile (toOsPath f) AppendMode $ \h -> L8.hPutStrLn h c - setAnnexFilePerm (toRawFilePath f') - where - f' = fromRawFilePath f + setAnnexFilePerm f -- | Modifies a log file. -- @@ -93,14 +92,13 @@ modifyLogFile f lck modf = withExclusiveLock lck $ do checkLogFile :: RawFilePath -> RawFilePath -> (L.ByteString -> Bool) -> Annex Bool checkLogFile f lck matchf = withSharedLock lck $ bracket setup cleanup go where - setup = liftIO $ tryWhenExists $ openFile f' ReadMode + setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode cleanup Nothing = noop cleanup (Just h) = liftIO $ hClose h go Nothing = return False go (Just h) = do !r <- liftIO (any matchf . fileLines <$> L.hGetContents h) return r - f' = fromRawFilePath f -- | Folds a function over lines of a log file to calculate a value. calcLogFile :: RawFilePath -> RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t @@ -111,7 +109,7 @@ calcLogFile f lck start update = calcLogFileUnsafe :: RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t calcLogFileUnsafe f start update = bracket setup cleanup go where - setup = liftIO $ tryWhenExists $ openFile f' ReadMode + setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode cleanup Nothing = noop cleanup (Just h) = liftIO $ hClose h go Nothing = return start @@ -120,7 +118,6 @@ calcLogFileUnsafe f start update = bracket setup cleanup go go' v (l:ls) = do let !v' = update l v go' v' ls - f' = fromRawFilePath f -- | Streams lines from a log file, passing each line to the processor, -- and then empties the file at the end. @@ -134,19 +131,19 @@ calcLogFileUnsafe f start update = bracket setup cleanup go -- -- Locking is used to prevent writes to to the log file while this -- is running. -streamLogFile :: FilePath -> RawFilePath -> Annex () -> (String -> Annex ()) -> Annex () +streamLogFile :: RawFilePath -> RawFilePath -> Annex () -> (String -> Annex ()) -> Annex () streamLogFile f lck finalizer processor = withExclusiveLock lck $ do streamLogFileUnsafe f finalizer processor - liftIO $ writeFile f "" - setAnnexFilePerm (toRawFilePath f) + liftIO $ F.writeFile' (toOsPath f) mempty + setAnnexFilePerm f -- Unsafe version that does not do locking, and does not empty the file -- at the end. -streamLogFileUnsafe :: FilePath -> Annex () -> (String -> Annex ()) -> Annex () +streamLogFileUnsafe :: RawFilePath -> Annex () -> (String -> Annex ()) -> Annex () streamLogFileUnsafe f finalizer processor = bracketOnError setup cleanup go where - setup = liftIO $ tryWhenExists $ openFile f ReadMode + setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode cleanup Nothing = noop cleanup (Just h) = liftIO $ hClose h go Nothing = finalizer diff --git a/Logs/Migrate.hs b/Logs/Migrate.hs index b60b21cfcb..63ace2f92e 100644 --- a/Logs/Migrate.hs +++ b/Logs/Migrate.hs @@ -79,7 +79,7 @@ logMigration old new = do -- | Commits a migration to the git-annex branch. commitMigration :: Annex () commitMigration = do - logf <- fromRawFilePath <$> fromRepo gitAnnexMigrateLog + logf <- fromRepo gitAnnexMigrateLog lckf <- fromRepo gitAnnexMigrateLock nv <- liftIO $ newTVarIO (0 :: Integer) g <- Annex.gitRepo diff --git a/Logs/Restage.hs b/Logs/Restage.hs index 5d4e2e0910..dc9a35940c 100644 --- a/Logs/Restage.hs +++ b/Logs/Restage.hs @@ -14,6 +14,7 @@ import Git.FilePath import Logs.File import Utility.InodeCache import Annex.LockFile +import qualified Utility.FileIO as F import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L @@ -48,21 +49,20 @@ streamRestageLog :: Annex () -> (TopFilePath -> InodeCache -> Annex ()) -> Annex streamRestageLog finalizer processor = do logf <- fromRepo gitAnnexRestageLog oldf <- fromRepo gitAnnexRestageLogOld - let oldf' = fromRawFilePath oldf lckf <- fromRepo gitAnnexRestageLock withExclusiveLock lckf $ liftIO $ whenM (R.doesPathExist logf) $ ifM (R.doesPathExist oldf) ( do - h <- openFile oldf' AppendMode + h <- F.openFile (toOsPath oldf) AppendMode hPutStr h =<< readFile (fromRawFilePath logf) hClose h liftIO $ removeWhenExistsWith R.removeLink logf , moveFile logf oldf ) - streamLogFileUnsafe oldf' finalizer $ \l -> + streamLogFileUnsafe oldf finalizer $ \l -> case parseRestageLog l of Just (f, ic) -> processor f ic Nothing -> noop diff --git a/Logs/Smudge.hs b/Logs/Smudge.hs index 7b0f5ff5f6..5a667ec826 100644 --- a/Logs/Smudge.hs +++ b/Logs/Smudge.hs @@ -34,7 +34,7 @@ streamSmudged :: (Key -> TopFilePath -> Annex ()) -> Annex () streamSmudged a = do logf <- fromRepo gitAnnexSmudgeLog lckf <- fromRepo gitAnnexSmudgeLock - streamLogFile (fromRawFilePath logf) lckf noop $ \l -> + streamLogFile logf lckf noop $ \l -> case parse l of Nothing -> noop Just (k, f) -> a k f diff --git a/Upgrade/V5/Direct.hs b/Upgrade/V5/Direct.hs index c807b29d9e..672f320ca3 100644 --- a/Upgrade/V5/Direct.hs +++ b/Upgrade/V5/Direct.hs @@ -29,6 +29,7 @@ import Annex.Perms import Utility.InodeCache import Annex.InodeSentinal import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F setIndirect :: Annex () setIndirect = do @@ -88,8 +89,8 @@ associatedFiles key = do - the top of the repo. -} associatedFilesRelative :: Key -> Annex [FilePath] associatedFilesRelative key = do - mapping <- fromRawFilePath <$> calcRepo (gitAnnexMapping key) - liftIO $ catchDefaultIO [] $ withFile mapping ReadMode $ \h -> + mapping <- calcRepo (gitAnnexMapping key) + liftIO $ catchDefaultIO [] $ F.withFile (toOsPath mapping) ReadMode $ \h -> -- Read strictly to ensure the file is closed promptly lines <$> hGetContentsStrict h diff --git a/Utility/Directory.hs b/Utility/Directory.hs index 91a2a1a07b..3648a4454d 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -12,6 +12,11 @@ module Utility.Directory where +#ifdef WITH_OSPATH +import System.Directory.OsPath +#else +import Utility.SystemDirectory +#endif import Control.Monad import System.PosixCompat.Files (isDirectory, isSymbolicLink) import Control.Applicative @@ -20,40 +25,24 @@ import qualified System.FilePath.ByteString as P import Data.Maybe import Prelude +import Utility.OsPath import Utility.Exception import Utility.Monad import Utility.FileSystemEncoding import qualified Utility.RawFilePath as R -#ifdef WITH_OSPATH -import Utility.OsPath -import qualified System.Directory.OsPath as OP -#else -import Utility.SystemDirectory -#endif - dirCruft :: R.RawFilePath -> Bool dirCruft "." = True dirCruft ".." = True dirCruft _ = False -dirCruft' :: R.RawFilePath -> Bool -dirCruft' "." = True -dirCruft' ".." = True -dirCruft' _ = False - {- Lists the contents of a directory. - Unlike getDirectoryContents, paths are not relative to the directory. -} dirContents :: RawFilePath -> IO [RawFilePath] -#ifdef WITH_OSPATH -dirContents d = map (\p -> d P. fromOsPath p) - <$> OP.listDirectory (toOsPath d) -#else dirContents d = - map (\p -> d P. toRawFilePath p) - . filter (not . dirCruft . toRawFilePath) - <$> getDirectoryContents (fromRawFilePath d) -#endif + map (\p -> d P. fromOsPath p) + . filter (not . dirCruft . fromOsPath) + <$> getDirectoryContents (toOsPath d) {- Gets files in a directory, and then its subdirectories, recursively, - and lazily. @@ -102,11 +91,7 @@ dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir (Just s) | isDirectory s -> recurse | isSymbolicLink s && followsubdirsymlinks -> -#ifdef WITH_OSPATH - ifM (OP.doesDirectoryExist (toOsPath entry)) -#else - ifM (doesDirectoryExist (fromRawFilePath entry)) -#endif + ifM (doesDirectoryExist (toOsPath entry)) ( recurse , skip ) diff --git a/Utility/FileIO.hs b/Utility/FileIO.hs new file mode 100644 index 0000000000..04c926d606 --- /dev/null +++ b/Utility/FileIO.hs @@ -0,0 +1,103 @@ +{- File IO on OsPaths. + - + - Since Prelude exports many of these as well, this needs to be imported + - qualified. + - + - Copyright 2025 Joey Hess + - + - License: BSD-2-clause + -} + +{-# OPTIONS_GHC -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Utility.FileIO +( + withFile, + openFile, + readFile, + readFile', + writeFile, + writeFile', + appendFile, + appendFile', +) where + +#ifdef WITH_OSPATH + +#ifndef mingw32_HOST_OS +import System.File.OsPath +#else +-- On Windows, System.File.OsPath does not handle UNC-style conversion itself, +-- so that has to be done when calling it. See +-- https://github.com/haskell/file-io/issues/39 +import Utility.Path.Windows +import Utility.OsPath +import System.IO (IO, Handle, IOMode) +import System.OsPath (OsPath) +import qualified System.File.OsPath as O +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import Control.Applicative + +withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r +withFile f m a = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.withFile f' m a + +openFile :: OsPath -> IOMode -> IO Handle +openFile f m = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.openFile f' m + +readFile :: OsPath -> IO L.ByteString +readFile f = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.readFile f' + +readFile' :: OsPath -> IO B.ByteString +readFile' f = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.readFile' f' + +writeFile :: OsPath -> L.ByteString -> IO () +writeFile f b = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.writeFile f' b + +writeFile' :: OsPath -> B.ByteString -> IO () +writeFile' f b = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.writeFile' f' b + +appendFile :: OsPath -> L.ByteString -> IO () +appendFile f b = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.appendFile f' b + +appendFile' :: OsPath -> B.ByteString -> IO () +appendFile' f b = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.appendFile' f' b + +#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. +import Utility.OsPath +import System.IO (withFile, openFile, IO) +import Data.ByteString.Lazy (readFile, writeFile, appendFile) +import qualified Data.ByteString as B + +readFile' :: OsPath -> IO B.ByteString +readFile' = B.readFile + +writeFile' :: OsPath -> B.ByteString -> IO () +writeFile' = B.writeFile + +appendFile' :: OsPath -> B.ByteString -> IO () +appendFile' = B.appendFile +#endif diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index eb25c526d1..95e5d570ef 100644 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -27,6 +27,8 @@ import Control.Monad.Catch import Utility.Exception import Utility.FileSystemEncoding import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F +import Utility.OsPath {- Applies a conversion function to a file's mode. -} modifyFileMode :: RawFilePath -> (FileMode -> FileMode) -> IO () @@ -178,7 +180,7 @@ writeFileProtected' :: RawFilePath -> (Handle -> IO ()) -> IO () writeFileProtected' file writer = bracket setup cleanup writer where setup = do - h <- protectedOutput $ openFile (fromRawFilePath file) WriteMode + h <- protectedOutput $ F.openFile (toOsPath file) WriteMode void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes return h cleanup = hClose diff --git a/Utility/FileSize.hs b/Utility/FileSize.hs index 3d216f2be4..ad23647606 100644 --- a/Utility/FileSize.hs +++ b/Utility/FileSize.hs @@ -18,6 +18,8 @@ module Utility.FileSize ( import Control.Exception (bracket) import System.IO import Utility.FileSystemEncoding +import qualified Utility.FileIO as F +import Utility.OsPath #else import System.PosixCompat.Files (fileSize) #endif @@ -36,7 +38,7 @@ getFileSize :: R.RawFilePath -> IO FileSize #ifndef mingw32_HOST_OS getFileSize f = fmap (fromIntegral . fileSize) (R.getFileStatus f) #else -getFileSize f = bracket (openFile (fromRawFilePath f) ReadMode) hClose hFileSize +getFileSize f = bracket (F.openFile (toOsPath f) ReadMode) hClose hFileSize #endif {- Gets the size of the file, when its FileStatus is already known. diff --git a/Utility/HtmlDetect.hs b/Utility/HtmlDetect.hs index fd5ad2ef06..cf83e52f08 100644 --- a/Utility/HtmlDetect.hs +++ b/Utility/HtmlDetect.hs @@ -13,6 +13,9 @@ module Utility.HtmlDetect ( ) where import Author +import qualified Utility.FileIO as F +import Utility.RawFilePath +import Utility.OsPath import Text.HTML.TagSoup import System.IO @@ -57,8 +60,8 @@ isHtmlBs = isHtml . B8.unpack -- It would be equivalent to use isHtml <$> readFile file, -- but since that would not read all of the file, the handle -- would remain open until it got garbage collected sometime later. -isHtmlFile :: FilePath -> IO Bool -isHtmlFile file = withFile file ReadMode $ \h -> +isHtmlFile :: RawFilePath -> IO Bool +isHtmlFile file = F.withFile (toOsPath file) ReadMode $ \h -> isHtmlBs <$> B.hGet h htmlPrefixLength -- | How much of the beginning of a html document is needed to detect it. diff --git a/Utility/OsPath.hs b/Utility/OsPath.hs index b53a141f3b..f05267524b 100644 --- a/Utility/OsPath.hs +++ b/Utility/OsPath.hs @@ -11,10 +11,9 @@ module Utility.OsPath where +import Utility.FileSystemEncoding + #ifdef WITH_OSPATH - -import Utility.RawFilePath - import System.OsPath import "os-string" System.OsString.Internal.Types import qualified Data.ByteString.Short as S @@ -36,4 +35,15 @@ fromOsPath = S.fromShort . getWindowsString . getOsString fromOsPath = S.fromShort . getPosixString . getOsString #endif -#endif /* WITH_OSPATH */ +#else +{- When not building with WITH_OSPATH, use FilePath. This allows + - using functions from legacy FilePath libraries interchangeably with + - newer OsPath libraries. + - -} +type OsPath = FilePath +toOsPath :: RawFilePath -> OsPath +toOsPath = fromRawFilePath + +fromOsPath :: OsPath -> RawFilePath +fromOsPath = toRawFilePath +#endif diff --git a/doc/todo/RawFilePath_conversion.mdwn b/doc/todo/RawFilePath_conversion.mdwn index 138cd57d47..5232f2a390 100644 --- a/doc/todo/RawFilePath_conversion.mdwn +++ b/doc/todo/RawFilePath_conversion.mdwn @@ -14,11 +14,10 @@ status. ghc-9.6.1 and above. Will need to switch from filepath-bytestring to this, and to avoid a lot of ifdefs, probably only after git-annex no longers supports building with older ghc versions. -* withFile remains to be converted, and is used in several important code - paths, including Annex.Journal and Annex.Link. - There is a OSPath version in file-io library, but that is - not currently a git-annex dependency. (withFile is in base, and base is - unlikely to convert to AFPP soon) +* Utility.FileIO is used for most withFile and openFile, but not yet for + readFile, writeFile, and appendFile. Including versions of those from + bytestring. +* readFileStrict should be replaced with Utility.FileIO.readFile' [[!tag confirmed]] diff --git a/git-annex.cabal b/git-annex.cabal index 0ece7af41c..b662fe482e 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -336,7 +336,8 @@ Executable git-annex Build-Depends: os-string (>= 2.0.0), directory (>= 1.3.8.3), - filepath (>= 1.5.2.0) + filepath (>= 1.5.2.0), + file-io (>= 0.1.3) CPP-Options: -DWITH_OSPATH if (os(windows)) @@ -1134,6 +1135,7 @@ Executable git-annex Utility.STM Utility.Su Utility.SystemDirectory + Utility.FileIO Utility.Terminal Utility.TimeStamp Utility.TList