mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

RawFilePath conversion of System.Directory

Browse source 
By using System.Directory.OsPath, which takes and returns OsString,
which is a ShortByteString. So, things like dirContents currently have the
overhead of copying that to a ByteString, but that should be less than
the overhead of using Strings which often in turn were converted to
RawFilePaths.

Added Utility.OsString and the OsString build flag. That flag is turned
on in the stack.yaml, and will be turned on automatically by cabal when
built with new enough libraries. The stack.yaml change is a bit ugly,
and that could be reverted for now if it causes any problems.

Note that Utility.OsString.toOsString on windows is avoiding only a
check of encoding that is documented as being unlikely to fail. I don't
think it can fail in git-annex; if it could, git-annex didn't contain
such an encoding check before, so at worst that should be a wash.
This commit is contained in:
Joey Hess 2025-01-20 18:03:26 -04:00
parent e5be81f8d4
commit 1ceece3108
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
34 changed files with 222 additions and 138 deletions
Download patch file Download diff file Expand all files Collapse all files

15
Logs/Transfer.hs
View file

@ -29,6 +29,7 @@ import Annex.Perms
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Control.Concurrent.STM
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified System.FilePath.ByteString as P
@ -157,7 +158,7 @@ getTransfers' dirs wanted = do
infos <- mapM checkTransfer transfers
return $ mapMaybe running $ zip transfers infos
where
findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive . fromRawFilePath)
findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive)
=<< mapM (fromRepo . transferDir) dirs
running (t, Just i) = Just (t, i)
running (_, Nothing) = Nothing
@ -180,11 +181,11 @@ getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles
where
getpairs = mapM $ \f -> do
let mt = parseTransferFile f
mi <- readTransferInfoFile Nothing f
mi <- readTransferInfoFile Nothing (fromRawFilePath f)
return $ case (mt, mi) of
(Just t, Just i) -> Just (t, i)
_ -> Nothing
findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive . fromRawFilePath)
findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive)
=<< mapM (fromRepo . failedTransferDir u) [Download, Upload]
clearFailedTransfers :: UUID -> Annex [(Transfer, TransferInfo)]
@ -244,17 +245,17 @@ failedTransferFile (Transfer direction u kd) r =
P.</> keyFile (mkKey (const kd))
{- Parses a transfer information filename to a Transfer. -}
parseTransferFile :: FilePath -> Maybe Transfer
parseTransferFile :: RawFilePath -> Maybe Transfer
parseTransferFile file
| "lck." `isPrefixOf` takeFileName file = Nothing
| "lck." `B.isPrefixOf` P.takeFileName file = Nothing
| otherwise = case drop (length bits - 3) bits of
[direction, u, key] -> Transfer
<$> parseDirection direction
<*> pure (toUUID u)
<*> fmap (fromKey id) (fileKey (toRawFilePath key))
<*> fmap (fromKey id) (fileKey key)
_ -> Nothing
where
bits = splitDirectories file
bits = P.splitDirectories file
writeTransferInfoFile :: TransferInfo -> RawFilePath -> Annex ()
writeTransferInfoFile info tfile = writeLogFile tfile $ writeTransferInfo info