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

convert TopFilePath to use RawFilePath

Browse source 
Adds a dependency on filepath-bytestring, an as yet unreleased fork of
filepath that operates on RawFilePath.

Git.Repo also changed to use RawFilePath for the path to the repo.

This does eliminate some RawFilePath -> FilePath -> RawFilePath
conversions. And filepath-bytestring's </> is probably faster.
But I don't expect a major performance improvement from this.
This is mostly groundwork for making Annex.Location use RawFilePath,
which will allow for a conversion-free pipleline.
This commit is contained in:
Joey Hess 2019-12-09 13:49:05 -04:00
parent a7004375ec
commit bdec7fed9c
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
97 changed files with 323 additions and 271 deletions
Download patch file Download diff file Expand all files Collapse all files

28
Annex/Fixup.hs
View file

@ -19,6 +19,7 @@ import Utility.SafeCommand
import Utility.Directory
import Utility.Exception
import Utility.Monad
import Utility.FileSystemEncoding
import Utility.PartialPrelude
import System.IO
@ -29,6 +30,8 @@ import Data.Maybe
import Control.Monad
import Control.Monad.IfElse
import qualified Data.Map as M
import qualified System.FilePath.ByteString as P
import qualified Data.ByteString as S
import Control.Applicative
import Prelude
@ -52,7 +55,7 @@ disableWildcardExpansion r = r
fixupDirect :: Repo -> Repo
fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = do
r
{ location = l { worktree = Just (parentDir d) }
{ location = l { worktree = Just (toRawFilePath (parentDir (fromRawFilePath d))) }
, gitGlobalOpts = gitGlobalOpts r ++
[ Param "-c"
, Param $ fromConfigKey coreBare ++ "=" ++ boolConfig False
@ -110,12 +113,13 @@ fixupUnusualRepos r@(Repo { location = l@(Local { worktree = Just w, gitdir = d
, return r
)
where
dotgit = w </> ".git"
dotgit = w P.</> ".git"
dotgit' = fromRawFilePath dotgit
replacedotgit = whenM (doesFileExist dotgit) $ do
linktarget <- relPathDirToFile w d
nukeFile dotgit
createSymbolicLink linktarget dotgit
replacedotgit = whenM (doesFileExist dotgit') $ do
linktarget <- relPathDirToFile (fromRawFilePath w) (fromRawFilePath d)
nukeFile dotgit'
createSymbolicLink linktarget dotgit'
unsetcoreworktree =
maybe (error "unset core.worktree failed") (\_ -> return ())
@ -125,13 +129,13 @@ fixupUnusualRepos r@(Repo { location = l@(Local { worktree = Just w, gitdir = d
-- git-worktree sets up a "commondir" file that contains
-- the path to the main git directory.
-- Using --separate-git-dir does not.
catchDefaultIO Nothing (headMaybe . lines <$> readFile (d </> "commondir")) >>= \case
catchDefaultIO Nothing (headMaybe . lines <$> readFile (fromRawFilePath (d P.</> "commondir"))) >>= \case
Just gd -> do
-- Make the worktree's git directory
-- contain an annex symlink to the main
-- repository's annex directory.
let linktarget = gd </> "annex"
createSymbolicLink linktarget (dotgit </> "annex")
createSymbolicLink linktarget (dotgit' </> "annex")
Nothing -> return ()
-- Repo adjusted, so that symlinks to objects that get checked
@ -141,12 +145,12 @@ fixupUnusualRepos r@(Repo { location = l@(Local { worktree = Just w, gitdir = d
| coreSymlinks c = r { location = l { gitdir = dotgit } }
| otherwise = r
notnoannex = isNothing <$> noAnnexFileContent (Git.repoWorkTree r)
notnoannex = isNothing <$> noAnnexFileContent (fmap fromRawFilePath (Git.repoWorkTree r))
fixupUnusualRepos r _ = return r
needsSubmoduleFixup :: Repo -> Bool
needsSubmoduleFixup (Repo { location = (Local { worktree = Just _, gitdir = d }) }) =
(".git" </> "modules") `isInfixOf` d
(".git" P.</> "modules") `S.isInfixOf` d
needsSubmoduleFixup _ = False
needsGitLinkFixup :: Repo -> IO Bool
@ -154,6 +158,6 @@ needsGitLinkFixup (Repo { location = (Local { worktree = Just wt, gitdir = d })
-- Optimization: Avoid statting .git in the common case; only
-- when the gitdir is not in the usual place inside the worktree
-- might .git be a file.
| wt </> ".git" == d = return False
| otherwise = doesFileExist (wt </> ".git")
| wt P.</> ".git" == d = return False
| otherwise = doesFileExist (fromRawFilePath (wt P.</> ".git"))
needsGitLinkFixup _ = return False