RawFilePath conversion for Utility.Directory.Stream
This commit is contained in:
parent
1ceece3108
commit
c7cca43ab0
4 changed files with 29 additions and 25 deletions
|
@ -752,12 +752,12 @@ stageJournal jl commitindex = withIndex $ withOtherTmp $ \tmpdir -> do
|
||||||
genstream dir h jh jlogh streamer = readDirectory jh >>= \case
|
genstream dir h jh jlogh streamer = readDirectory jh >>= \case
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just file -> do
|
Just file -> do
|
||||||
let path = dir P.</> toRawFilePath file
|
let path = dir P.</> file
|
||||||
unless (dirCruft (toRawFilePath file)) $ whenM (isfile path) $ do
|
unless (dirCruft file) $ whenM (isfile path) $ do
|
||||||
sha <- Git.HashObject.hashFile h path
|
sha <- Git.HashObject.hashFile h path
|
||||||
hPutStrLn jlogh file
|
B.hPutStr jlogh (file <> "\n")
|
||||||
streamer $ Git.UpdateIndex.updateIndexLine
|
streamer $ Git.UpdateIndex.updateIndexLine
|
||||||
sha TreeFile (asTopFilePath $ fileJournal $ toRawFilePath file)
|
sha TreeFile (asTopFilePath $ fileJournal file)
|
||||||
genstream dir h jh jlogh streamer
|
genstream dir h jh jlogh streamer
|
||||||
isfile file = isRegularFile <$> R.getFileStatus file
|
isfile file = isRegularFile <$> R.getFileStatus file
|
||||||
-- Clean up the staged files, as listed in the temp log file.
|
-- Clean up the staged files, as listed in the temp log file.
|
||||||
|
|
|
@ -243,17 +243,15 @@ withJournalHandle getjournaldir a = do
|
||||||
where
|
where
|
||||||
-- avoid overhead of creating the journal directory when it already
|
-- avoid overhead of creating the journal directory when it already
|
||||||
-- exists
|
-- exists
|
||||||
opendir d = liftIO (openDirectory (fromRawFilePath d))
|
opendir d = liftIO (openDirectory d)
|
||||||
`catchIO` (const (createAnnexDirectory d >> opendir d))
|
`catchIO` (const (createAnnexDirectory d >> opendir d))
|
||||||
|
|
||||||
{- Checks if there are changes in the journal. -}
|
{- Checks if there are changes in the journal. -}
|
||||||
journalDirty :: (BranchState -> Git.Repo -> RawFilePath) -> Annex Bool
|
journalDirty :: (BranchState -> Git.Repo -> RawFilePath) -> Annex Bool
|
||||||
journalDirty getjournaldir = do
|
journalDirty getjournaldir = do
|
||||||
st <- getState
|
st <- getState
|
||||||
d <- fromRawFilePath <$> fromRepo (getjournaldir st)
|
d <- fromRepo (getjournaldir st)
|
||||||
liftIO $
|
liftIO $ isDirectoryPopulated d
|
||||||
(not <$> isDirectoryEmpty d)
|
|
||||||
`catchIO` (const $ doesDirectoryExist d)
|
|
||||||
|
|
||||||
{- Produces a filename to use in the journal for a file on the branch.
|
{- Produces a filename to use in the journal for a file on the branch.
|
||||||
- The filename does not include the journal directory.
|
- The filename does not include the journal directory.
|
||||||
|
|
|
@ -37,6 +37,11 @@ dirCruft "." = True
|
||||||
dirCruft ".." = True
|
dirCruft ".." = True
|
||||||
dirCruft _ = False
|
dirCruft _ = False
|
||||||
|
|
||||||
|
dirCruft' :: R.RawFilePath -> Bool
|
||||||
|
dirCruft' "." = True
|
||||||
|
dirCruft' ".." = True
|
||||||
|
dirCruft' _ = False
|
||||||
|
|
||||||
{- Lists the contents of a directory.
|
{- Lists the contents of a directory.
|
||||||
- Unlike getDirectoryContents, paths are not relative to the directory. -}
|
- Unlike getDirectoryContents, paths are not relative to the directory. -}
|
||||||
dirContents :: RawFilePath -> IO [RawFilePath]
|
dirContents :: RawFilePath -> IO [RawFilePath]
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- streaming directory traversal
|
{- streaming directory reading
|
||||||
-
|
-
|
||||||
- Copyright 2011-2018 Joey Hess <id@joeyh.name>
|
- Copyright 2011-2025 Joey Hess <id@joeyh.name>
|
||||||
-
|
-
|
||||||
- License: BSD-2-clause
|
- License: BSD-2-clause
|
||||||
-}
|
-}
|
||||||
|
@ -14,19 +14,20 @@ module Utility.Directory.Stream (
|
||||||
openDirectory,
|
openDirectory,
|
||||||
closeDirectory,
|
closeDirectory,
|
||||||
readDirectory,
|
readDirectory,
|
||||||
isDirectoryEmpty,
|
isDirectoryPopulated,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import System.FilePath
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
|
import qualified Data.ByteString as B
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
#ifdef mingw32_HOST_OS
|
#ifdef mingw32_HOST_OS
|
||||||
import qualified System.Win32 as Win32
|
import qualified System.Win32 as Win32
|
||||||
|
import System.FilePath
|
||||||
#else
|
#else
|
||||||
import qualified System.Posix as Posix
|
import qualified System.Posix.Directory.ByteString as Posix
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
import Utility.Directory
|
import Utility.Directory
|
||||||
|
@ -41,14 +42,14 @@ data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar
|
||||||
|
|
||||||
type IsOpen = MVar () -- full when the handle is open
|
type IsOpen = MVar () -- full when the handle is open
|
||||||
|
|
||||||
openDirectory :: FilePath -> IO DirectoryHandle
|
openDirectory :: RawFilePath -> IO DirectoryHandle
|
||||||
openDirectory path = do
|
openDirectory path = do
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
dirp <- Posix.openDirStream path
|
dirp <- Posix.openDirStream path
|
||||||
isopen <- newMVar ()
|
isopen <- newMVar ()
|
||||||
return (DirectoryHandle isopen dirp)
|
return (DirectoryHandle isopen dirp)
|
||||||
#else
|
#else
|
||||||
(h, fdat) <- Win32.findFirstFile (path </> "*")
|
(h, fdat) <- Win32.findFirstFile (fromRawFilePath path </> "*")
|
||||||
-- Indicate that the fdat contains a filename that readDirectory
|
-- Indicate that the fdat contains a filename that readDirectory
|
||||||
-- has not yet returned, by making the MVar be full.
|
-- has not yet returned, by making the MVar be full.
|
||||||
-- (There's always at least a "." entry.)
|
-- (There's always at least a "." entry.)
|
||||||
|
@ -76,11 +77,11 @@ closeDirectory (DirectoryHandle isopen h _ alreadyhave) =
|
||||||
|
|
||||||
-- | Reads the next entry from the handle. Once the end of the directory
|
-- | Reads the next entry from the handle. Once the end of the directory
|
||||||
-- is reached, returns Nothing and automatically closes the handle.
|
-- is reached, returns Nothing and automatically closes the handle.
|
||||||
readDirectory :: DirectoryHandle -> IO (Maybe FilePath)
|
readDirectory :: DirectoryHandle -> IO (Maybe RawFilePath)
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
readDirectory hdl@(DirectoryHandle _ dirp) = do
|
readDirectory hdl@(DirectoryHandle _ dirp) = do
|
||||||
e <- Posix.readDirStream dirp
|
e <- Posix.readDirStream dirp
|
||||||
if null e
|
if B.null e
|
||||||
then do
|
then do
|
||||||
closeDirectory hdl
|
closeDirectory hdl
|
||||||
return Nothing
|
return Nothing
|
||||||
|
@ -103,18 +104,18 @@ readDirectory hdl@(DirectoryHandle _ h fdat mv) = do
|
||||||
where
|
where
|
||||||
getfn = do
|
getfn = do
|
||||||
filename <- Win32.getFindDataFileName fdat
|
filename <- Win32.getFindDataFileName fdat
|
||||||
return (Just filename)
|
return (Just (toRawFilePath filename))
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
-- | True only when directory exists and contains nothing.
|
-- | True only when directory exists and is not empty.
|
||||||
-- Throws exception if directory does not exist.
|
isDirectoryPopulated :: RawFilePath -> IO Bool
|
||||||
isDirectoryEmpty :: FilePath -> IO Bool
|
isDirectoryPopulated d = bracket (openDirectory d) closeDirectory check
|
||||||
isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check
|
`catchIO` const (return False)
|
||||||
where
|
where
|
||||||
check h = do
|
check h = do
|
||||||
v <- readDirectory h
|
v <- readDirectory h
|
||||||
case v of
|
case v of
|
||||||
Nothing -> return True
|
Nothing -> return False
|
||||||
Just f
|
Just f
|
||||||
| not (dirCruft (toRawFilePath f)) -> return False
|
| not (dirCruft f) -> return True
|
||||||
| otherwise -> check h
|
| otherwise -> check h
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue