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
-- 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
-}
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)
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
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.
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
#else
ifM (isSymbolicLink <$> R.getSymbolicLinkStatus f)
( return Nothing
- , withFile (fromRawFilePath f) ReadMode readhandle
+ , F.withFile (toOsPath f) ReadMode readhandle
)
#endif
#endif
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
-- 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
* 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 <id@joeyh.name> Mon, 20 Jan 2025 10:24:51 -0400
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
)
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)
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
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
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
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
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.
--
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
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
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.
--
-- 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
-- | 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
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
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
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
import Utility.InodeCache
import Annex.InodeSentinal
import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
setIndirect :: Annex ()
setIndirect = 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
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
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.
(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
)
--- /dev/null
+{- File IO on OsPaths.
+ -
+ - Since Prelude exports many of these as well, this needs to be imported
+ - qualified.
+ -
+ - Copyright 2025 Joey Hess <id@joeyh.name>
+ -
+ - 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
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 ()
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
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
#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.
) where
import Author
+import qualified Utility.FileIO as F
+import Utility.RawFilePath
+import Utility.OsPath
import Text.HTML.TagSoup
import System.IO
-- 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.
module Utility.OsPath where
-#ifdef WITH_OSPATH
-
-import Utility.RawFilePath
+import Utility.FileSystemEncoding
+#ifdef WITH_OSPATH
import System.OsPath
import "os-string" System.OsString.Internal.Types
import qualified Data.ByteString.Short as S
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
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]]
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))
Utility.STM
Utility.Su
Utility.SystemDirectory
+ Utility.FileIO
Utility.Terminal
Utility.TimeStamp
Utility.TList
projects / git-annex.git / commitdiff