diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 56a617db44..4eafcadfe2 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -268,7 +268,7 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch -- 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 @@ -281,7 +281,7 @@ updateAdjustedBranch adj (AdjBranch currbranch) 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 @@ -295,9 +295,9 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch 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 diff --git a/Annex/AdjustedBranch/Merge.hs b/Annex/AdjustedBranch/Merge.hs index 8a3d3b3be9..7817bdbeca 100644 --- a/Annex/AdjustedBranch/Merge.hs +++ b/Annex/AdjustedBranch/Merge.hs @@ -30,8 +30,8 @@ import Utility.Tmp.Dir 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 @@ -76,6 +76,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm 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 @@ -87,7 +88,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm 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' @@ -106,7 +107,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm 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 diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs index 5d90878152..0c0c203688 100644 --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -35,10 +35,10 @@ import Annex.InodeSentinal 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), @@ -268,7 +268,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do 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 $ diff --git a/Annex/Branch.hs b/Annex/Branch.hs index eca1ea778d..dd7dc03255 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -96,6 +96,7 @@ import Annex.Hook 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 @@ -711,9 +712,9 @@ forceUpdateIndex jl branchref = do {- 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 @@ -931,8 +932,8 @@ getIgnoredRefs = 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 () @@ -949,8 +950,8 @@ getMergedRefs = S.fromList . map fst <$> getMergedRefs' 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 = diff --git a/Annex/ChangedRefs.hs b/Annex/ChangedRefs.hs index 7a9ce8a34f..073686fb01 100644 --- a/Annex/ChangedRefs.hs +++ b/Annex/ChangedRefs.hs @@ -23,11 +23,11 @@ import Utility.Directory.Create 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] @@ -104,7 +104,7 @@ notifyHook chan reffile _ | ".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. diff --git a/Annex/Journal.hs b/Annex/Journal.hs index ac2f05ae97..cfa582c65e 100644 --- a/Annex/Journal.hs +++ b/Annex/Journal.hs @@ -205,7 +205,7 @@ getJournalFileStale (GetPrivate getprivate) file = do 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 diff --git a/Annex/Link.hs b/Annex/Link.hs index 8a5352e99e..4c2a76ffc2 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -118,7 +118,7 @@ makeGitLink linktarget file = ifM (coreSymlinks <$> Annex.getGitConfig) ( 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. -} @@ -153,7 +153,7 @@ stagePointerFile file mode sha = 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 diff --git a/CmdLine/GitRemoteAnnex.hs b/CmdLine/GitRemoteAnnex.hs index f1421815ad..d15fe3fd89 100644 --- a/CmdLine/GitRemoteAnnex.hs +++ b/CmdLine/GitRemoteAnnex.hs @@ -859,7 +859,7 @@ startPush' rmt manifest = do 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) diff --git a/Command/ResolveMerge.hs b/Command/ResolveMerge.hs index aaa5c25ad2..2d003547b2 100644 --- a/Command/ResolveMerge.hs +++ b/Command/ResolveMerge.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.ResolveMerge where import Command @@ -12,8 +14,9 @@ import qualified Git 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 @@ -26,10 +29,10 @@ seek = withNothing (commandAction start) 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 diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index d0250a48c0..eb643d7aad 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -32,6 +32,7 @@ import Annex.SpecialRemote.Config (exportTreeField) 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 @@ -255,18 +256,18 @@ test runannex mkr mkk = 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 diff --git a/Git/Ref.hs b/Git/Ref.hs index 2767ae339c..c6b2027280 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -15,19 +15,22 @@ import Git.Command 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 diff --git a/Git/Repair.hs b/Git/Repair.hs index 78fe2ea505..d69cdc2648 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -44,6 +44,7 @@ import Utility.Tmp.Dir 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 @@ -87,7 +88,7 @@ explodePacks r = go =<< listPackFiles r -- 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 @@ -116,9 +117,9 @@ retrieveMissingObjects missing referencerepo r 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) diff --git a/Logs/Export.hs b/Logs/Export.hs index 7f2242ea14..a3cf823d53 100644 --- a/Logs/Export.hs +++ b/Logs/Export.hs @@ -34,6 +34,7 @@ import Logs.File 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 @@ -129,7 +130,7 @@ getExportExcluded :: UUID -> Annex [Git.Tree.TreeItem] 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] diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs index b8435a6502..6d3599764f 100644 --- a/Remote/BitTorrent.hs +++ b/Remote/BitTorrent.hs @@ -39,7 +39,7 @@ import qualified Data.ByteString as S #ifdef WITH_TORRENTPARSER import Data.Torrent -import qualified Data.ByteString.Lazy as B +import qualified Utility.FileIO as F #endif remote :: RemoteType @@ -366,7 +366,7 @@ torrentFileSizes :: RawFilePath -> IO [(FilePath, Integer)] 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 diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 4fb8503867..94dc65250a 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -15,7 +15,6 @@ module Remote.Directory ( 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 @@ -52,6 +51,7 @@ import Utility.InodeCache 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 @@ -257,7 +257,7 @@ retrieveKeyFileM d NoChunks cow = fileRetriever' $ \dest k p iv -> do 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 diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs index 2268dc998a..b1b2438b7d 100644 --- a/Remote/Directory/LegacyChunked.hs +++ b/Remote/Directory/LegacyChunked.hs @@ -24,6 +24,7 @@ import Annex.Tmp 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 @@ -101,13 +102,13 @@ retrieve :: (RawFilePath -> Key -> [RawFilePath]) -> RawFilePath -> Retriever 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 diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index f7440463d4..b1e0d83c95 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -15,7 +15,6 @@ import Data.Default 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 @@ -35,6 +34,7 @@ import Utility.FileMode 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 @@ -198,7 +198,7 @@ fileKey1 file = readKey1 $ 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) diff --git a/Upgrade/V5.hs b/Upgrade/V5.hs index e6cb22a6d4..708c838977 100644 --- a/Upgrade/V5.hs +++ b/Upgrade/V5.hs @@ -34,8 +34,7 @@ import Utility.InodeCache 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 @@ -130,7 +129,7 @@ upgradeDirectWorkTree = 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 @@ -158,8 +157,8 @@ upgradeDirectWorkTree = do ) 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 () diff --git a/doc/todo/RawFilePath_conversion.mdwn b/doc/todo/RawFilePath_conversion.mdwn index e1ca599956..dd7ff4a843 100644 --- a/doc/todo/RawFilePath_conversion.mdwn +++ b/doc/todo/RawFilePath_conversion.mdwn @@ -18,7 +18,7 @@ status. 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