These are all straightforward, and easy small performance wins.
Sponsored-by: Nicholas Golder-Manning
-- origbranch.
_ <- propigateAdjustedCommits' True origbranch adj commitlck
- origheadfile <- inRepo $ readFileStrict . Git.Ref.headFile
+ origheadfile <- inRepo $ readFileStrict . fromRawFilePath . Git.Ref.headFile
origheadsha <- inRepo (Git.Ref.sha currbranch)
b <- adjustBranch adj origbranch
Just s -> do
inRepo $ \r -> do
let newheadfile = fromRef s
- writeFile (Git.Ref.headFile r) newheadfile
+ writeFile (fromRawFilePath (Git.Ref.headFile r)) newheadfile
return (Just newheadfile)
_ -> return Nothing
unless ok $ case newheadfile of
Nothing -> noop
Just v -> preventCommits $ \_commitlck -> inRepo $ \r -> do
- v' <- readFileStrict (Git.Ref.headFile r)
+ v' <- readFileStrict (fromRawFilePath (Git.Ref.headFile r))
when (v == v') $
- writeFile (Git.Ref.headFile r) origheadfile
+ writeFile (fromRawFilePath (Git.Ref.headFile r)) origheadfile
return ok
| otherwise = preventCommits $ \commitlck -> do
import Utility.CopyFile
import Utility.Directory.Create
import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
-import qualified Data.ByteString as S
import qualified System.FilePath.ByteString as P
canMergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Annex Bool
tmpwt <- fromRepo gitAnnexMergeDir
withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath "git") $ \tmpgit -> withWorkTreeRelated tmpgit $
withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do
+ let tmpgit' = toRawFilePath tmpgit
liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)
-- Copy in refs and packed-refs, to work
-- around bug in git 2.13.0, which
liftIO $ forM_ refs' $ \src -> do
whenM (R.doesPathExist src) $ do
dest <- relPathDirToFile git_dir src
- let dest' = toRawFilePath tmpgit P.</> dest
+ let dest' = tmpgit' P.</> dest
createDirectoryUnder [git_dir]
(P.takeDirectory dest')
void $ createLinkOrCopy src dest'
if merged
then do
!mergecommit <- liftIO $ extractSha
- <$> S.readFile (tmpgit </> "HEAD")
+ <$> F.readFile' (toOsPath (tmpgit' P.</> "HEAD"))
-- This is run after the commit lock is dropped.
return $ postmerge mergecommit
else return $ return False
import Utility.InodeCache
import Utility.FileMode
import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
import qualified Data.Set as S
import qualified Data.Map as M
-import qualified Data.ByteString.Lazy as L
import System.PosixCompat.Files (isSymbolicLink)
{- Merges from a branch into the current branch (which may not exist yet),
Nothing -> noop
Just sha -> replaceWorkTreeFile (toRawFilePath item) $ \tmp -> do
c <- catObject sha
- liftIO $ L.writeFile (decodeBS tmp) c
+ liftIO $ F.writeFile (toOsPath tmp) c
when isexecutable $
liftIO $ void $ tryIO $
modifyFileMode tmp $
import Utility.Directory.Stream
import Utility.Tmp
import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
{- Name of the branch that is used to store git-annex's information. -}
name :: Git.Ref
{- Checks if the index needs to be updated. -}
needUpdateIndex :: Git.Ref -> Annex Bool
needUpdateIndex branchref = do
- f <- fromRawFilePath <$> fromRepo gitAnnexIndexStatus
+ f <- toOsPath <$> fromRepo gitAnnexIndexStatus
committedref <- Git.Ref . firstLine' <$>
- liftIO (catchDefaultIO mempty $ B.readFile f)
+ liftIO (catchDefaultIO mempty $ F.readFile' f)
return (committedref /= branchref)
{- Record that the branch's index has been updated to correspond to a
S.fromList . mapMaybe Git.Sha.extractSha . fileLines' <$> content
where
content = do
- f <- fromRawFilePath <$> fromRepo gitAnnexIgnoredRefs
- liftIO $ catchDefaultIO mempty $ B.readFile f
+ f <- toOsPath <$> fromRepo gitAnnexIgnoredRefs
+ liftIO $ catchDefaultIO mempty $ F.readFile' f
addMergedRefs :: [(Git.Sha, Git.Branch)] -> Annex ()
addMergedRefs [] = return ()
getMergedRefs' :: Annex [(Git.Sha, Git.Branch)]
getMergedRefs' = do
- f <- fromRawFilePath <$> fromRepo gitAnnexMergedRefs
- s <- liftIO $ catchDefaultIO mempty $ B.readFile f
+ f <- toOsPath <$> fromRepo gitAnnexMergedRefs
+ s <- liftIO $ catchDefaultIO mempty $ F.readFile' f
return $ map parse $ fileLines' s
where
parse l =
import qualified Git
import Git.Sha
import qualified Utility.SimpleProtocol as Proto
+import qualified Utility.FileIO as F
import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.TBMChan
-import qualified Data.ByteString as S
import qualified System.FilePath.ByteString as P
newtype ChangedRefs = ChangedRefs [Git.Ref]
| ".lock" `isSuffixOf` reffile = noop
| otherwise = void $ do
sha <- catchDefaultIO Nothing $
- extractSha <$> S.readFile reffile
+ extractSha <$> F.readFile' (toOsPath (toRawFilePath reffile))
-- When the channel is full, there is probably no reader
-- running, or ref changes have been occurring very fast,
-- so it's ok to not write the change to it.
jfile = journalFile file
getfrom d = catchMaybeIO $
discardIncompleteAppend . L.fromStrict
- <$> B.readFile (fromRawFilePath (d P.</> jfile))
+ <$> F.readFile' (toOsPath (d P.</> jfile))
-- Note that this forces read of the whole lazy bytestring.
discardIncompleteAppend :: L.ByteString -> L.ByteString
( liftIO $ do
void $ tryIO $ R.removeLink file
R.createSymbolicLink linktarget file
- , liftIO $ S.writeFile (fromRawFilePath file) linktarget
+ , liftIO $ F.writeFile' (toOsPath file) linktarget
)
{- Creates a link on disk, and additionally stages it in git. -}
writePointerFile :: RawFilePath -> Key -> Maybe FileMode -> IO ()
writePointerFile file k mode = do
- S.writeFile (fromRawFilePath file) (formatPointer k)
+ F.writeFile' (toOsPath file) (formatPointer k)
maybe noop (R.setFileMode file) mode
newtype Restage = Restage Bool
f <- fromRepo (lastPushedManifestFile (Remote.uuid rmt))
oldmanifest <- liftIO $
fromRight mempty . parseManifest
- <$> B.readFile (fromRawFilePath f)
+ <$> F.readFile' (toOsPath f)
`catchNonAsync` (const (pure mempty))
let oldmanifest' = mkManifest [] $
S.fromList (inManifest oldmanifest)
- Licensed under the GNU AGPL version 3 or higher.
-}
+{-# LANGUAGE OverloadedStrings #-}
+
module Command.ResolveMerge where
import Command
import Git.Sha
import qualified Git.Branch
import Annex.AutoMerge
+import qualified Utility.FileIO as F
-import qualified Data.ByteString as S
+import qualified System.FilePath.ByteString as P
cmd :: Command
cmd = command "resolvemerge" SectionPlumbing
start :: CommandStart
start = starting "resolvemerge" (ActionItemOther Nothing) (SeekInput []) $ do
us <- fromMaybe nobranch <$> inRepo Git.Branch.current
- d <- fromRawFilePath <$> fromRepo Git.localGitDir
- let merge_head = d </> "MERGE_HEAD"
+ d <- fromRepo Git.localGitDir
+ let merge_head = toOsPath $ d P.</> "MERGE_HEAD"
them <- fromMaybe (giveup nomergehead) . extractSha
- <$> liftIO (S.readFile merge_head)
+ <$> liftIO (F.readFile' merge_head)
ifM (resolveMerge (Just us) them False)
( do
void $ commitResolvedMerge Git.Branch.ManualCommit
import Remote.Helper.Chunked
import Remote.Helper.Encryptable (encryptionField, highRandomQualityField)
import Git.Types
+import qualified Utility.FileIO as F
import Test.Tasty
import Test.Tasty.Runners
get r k
, check "fsck downloaded object" fsck
, check "retrieveKeyFile resume from 0" $ \r k -> do
- tmp <- fromRawFilePath <$> prepTmp k
- liftIO $ writeFile tmp ""
+ tmp <- toOsPath <$> prepTmp k
+ liftIO $ F.writeFile' tmp mempty
lockContentForRemoval k noop removeAnnex
get r k
, check "fsck downloaded object" fsck
, check "retrieveKeyFile resume from 33%" $ \r k -> do
loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k)
- tmp <- fromRawFilePath <$> prepTmp k
+ tmp <- toOsPath <$> prepTmp k
partial <- liftIO $ bracket (openBinaryFile loc ReadMode) hClose $ \h -> do
sz <- hFileSize h
L.hGet h $ fromInteger $ sz `div` 3
- liftIO $ L.writeFile tmp partial
+ liftIO $ F.writeFile tmp partial
lockContentForRemoval k noop removeAnnex
get r k
, check "fsck downloaded object" fsck
import Git.Sha
import Git.Types
import Git.FilePath
+import qualified Utility.FileIO as F
import Data.Char (chr, ord)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
+import qualified System.FilePath.ByteString as P
headRef :: Ref
headRef = Ref "HEAD"
-headFile :: Repo -> FilePath
-headFile r = fromRawFilePath (localGitDir r) </> "HEAD"
+headFile :: Repo -> RawFilePath
+headFile r = localGitDir r P.</> "HEAD"
setHeadRef :: Ref -> Repo -> IO ()
-setHeadRef ref r = S.writeFile (headFile r) ("ref: " <> fromRef' ref)
+setHeadRef ref r =
+ F.writeFile' (toOsPath (headFile r)) ("ref: " <> fromRef' ref)
{- Converts a fully qualified git ref into a user-visible string. -}
describe :: Ref -> String
import Utility.Rsync
import Utility.FileMode
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
-- May fail, if pack file is corrupt.
void $ tryIO $
pipeWrite [Param "unpack-objects", Param "-r"] r' $ \h ->
- L.hPut h =<< L.readFile (fromRawFilePath packfile)
+ L.hPut h =<< F.readFile (toOsPath packfile)
objs <- emptyWhenDoesNotExist (dirContentsRecursive (toRawFilePath tmpdir))
forM_ objs $ \objfile -> do
f <- relPathDirToFile
unlessM (boolSystem "git" [Param "init", File tmpdir]) $
giveup $ "failed to create temp repository in " ++ tmpdir
tmpr <- Config.read =<< Construct.fromPath (toRawFilePath tmpdir)
- let repoconfig r' = fromRawFilePath (localGitDir r' P.</> "config")
- whenM (doesFileExist (repoconfig r)) $
- L.readFile (repoconfig r) >>= L.writeFile (repoconfig tmpr)
+ let repoconfig r' = toOsPath (localGitDir r' P.</> "config")
+ whenM (doesFileExist (fromRawFilePath (fromOsPath (repoconfig r)))) $
+ F.readFile (repoconfig r) >>= F.writeFile (repoconfig tmpr)
rs <- Construct.fromRemotes r
stillmissing <- pullremotes tmpr rs fetchrefstags missing
if S.null (knownMissing stillmissing)
import qualified Git.LsTree
import qualified Git.Tree
import Annex.UUID
+import qualified Utility.FileIO as F
import qualified Data.Map as M
import qualified Data.ByteString as B
getExportExcluded u = do
logf <- fromRepo $ gitAnnexExportExcludeLog u
liftIO $ catchDefaultIO [] $ exportExcludedParser
- <$> L.readFile (fromRawFilePath logf)
+ <$> F.readFile (toOsPath logf)
where
exportExcludedParser :: L.ByteString -> [Git.Tree.TreeItem]
#ifdef WITH_TORRENTPARSER
import Data.Torrent
-import qualified Data.ByteString.Lazy as B
+import qualified Utility.FileIO as F
#endif
remote :: RemoteType
torrentFileSizes torrent = do
#ifdef WITH_TORRENTPARSER
let mkfile = joinPath . map (scrub . decodeBL)
- b <- B.readFile (fromRawFilePath torrent)
+ b <- F.readFile (toOsPath torrent)
return $ case readTorrent b of
Left e -> giveup $ "failed to parse torrent: " ++ e
Right t -> case tInfo t of
removeDirGeneric,
) where
-import qualified Data.ByteString.Lazy as L
import qualified Data.Map as M
import qualified Data.List.NonEmpty as NE
import qualified System.FilePath.ByteString as P
import Utility.FileMode
import Utility.Directory.Create
import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
#ifndef mingw32_HOST_OS
import Utility.OpenFd
#endif
src <- liftIO $ fromRawFilePath <$> getLocation d k
void $ liftIO $ fileCopier cow src (fromRawFilePath dest) p iv
retrieveKeyFileM d _ _ = byteRetriever $ \k sink ->
- sink =<< liftIO (L.readFile . fromRawFilePath =<< getLocation d k)
+ sink =<< liftIO (F.readFile . toOsPath =<< getLocation d k)
retrieveKeyFileCheapM :: RawFilePath -> ChunkConfig -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ())
-- no cheap retrieval possible for chunks
import Utility.Metered
import Utility.Directory.Create
import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
withCheckedFiles :: (FilePath -> IO Bool) -> FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool
withCheckedFiles _ [] _locations _ _ = return False
retrieve locations d basek p _dest miv c = withOtherTmp $ \tmpdir -> do
showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow."
let tmp = tmpdir P.</> keyFile basek <> ".directorylegacy.tmp"
- let tmp' = fromRawFilePath tmp
+ let tmp' = toOsPath tmp
let go = \k sink -> do
liftIO $ void $ withStoredFiles (fromRawFilePath d) (legacyLocations locations) k $ \fs -> do
forM_ fs $
- S.appendFile tmp' <=< S.readFile
+ F.appendFile' tmp' <=< S.readFile
return True
- b <- liftIO $ L.readFile tmp'
+ b <- liftIO $ F.readFile tmp'
liftIO $ removeWhenExistsWith R.removeLink tmp
sink b
byteRetriever go basek p tmp miv c
import Data.ByteString.Builder
import qualified Data.ByteString as S
import qualified Data.ByteString.Short as S (toShort, fromShort)
-import qualified Data.ByteString.Lazy as L
import qualified System.FilePath.ByteString as P
import System.PosixCompat.Files (isRegularFile)
import Text.Read
import Utility.Tmp
import qualified Upgrade.V2
import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
-- v2 adds hashing of filenames of content and location log files.
-- Key information is encoded in filenames differently, so
replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file
writeLog1 :: FilePath -> [LogLine] -> IO ()
-writeLog1 file ls = viaTmp (L.writeFile . fromRawFilePath . fromOsPath)
+writeLog1 file ls = viaTmp F.writeFile
(toOsPath (toRawFilePath file))
(toLazyByteString $ buildLog ls)
import Utility.DottedVersion
import Annex.AdjustedBranch
import qualified Utility.RawFilePath as R
-
-import qualified Data.ByteString as S
+import qualified Utility.FileIO as F
upgrade :: Bool -> Annex UpgradeResult
upgrade automatic = flip catchNonAsync onexception $ do
Just k -> do
stagePointerFile f Nothing =<< hashPointerFile k
ifM (isJust <$> getAnnexLinkTarget f)
- ( writepointer (fromRawFilePath f) k
+ ( writepointer f k
, fromdirect (fromRawFilePath f) k
)
Database.Keys.addAssociatedFile k
)
writepointer f k = liftIO $ do
- removeWhenExistsWith R.removeLink (toRawFilePath f)
- S.writeFile f (formatPointer k)
+ removeWhenExistsWith R.removeLink f
+ F.writeFile' (toOsPath f) (formatPointer k)
{- Remove all direct mode bookkeeping files. -}
removeDirectCruft :: Annex ()
mechanical, with only some wrapper functions in Utility.FileIO and
Utility.RawFilePath needing to be changed.
* Utility.FileIO is used for most withFile and openFile, but not yet for
- readFile, writeFile, and appendFile. Including versions of those from
+ readFile, writeFile, and appendFile (except most ones on bytestrings)
bytestring. Also readFileStrict should be replaced with
Utility.FileIO.readFile'
Note that the String versions can do newline translation, which has to be
projects / git-annex.git / commitdiff