diff options
| -rw-r--r-- | Annex/Content.hs | 3 | ||||
| -rw-r--r-- | Annex/Ssh.hs | 4 | ||||
| -rw-r--r-- | Command/Log.hs | 2 | ||||
| -rw-r--r-- | Command/Map.hs | 8 | ||||
| -rw-r--r-- | Command/Unused.hs | 2 | ||||
| -rw-r--r-- | Config.hs | 2 | ||||
| -rw-r--r-- | Git.hs | 77 | ||||
| -rw-r--r-- | Git/Command.hs | 13 | ||||
| -rw-r--r-- | Git/Config.hs | 62 | ||||
| -rw-r--r-- | Git/Construct.hs | 10 | ||||
| -rw-r--r-- | Git/LsFiles.hs | 2 | ||||
| -rw-r--r-- | Git/Types.hs | 20 | ||||
| -rw-r--r-- | Init.hs | 2 | ||||
| -rw-r--r-- | Locations.hs | 14 | ||||
| -rw-r--r-- | Remote/Bup.hs | 2 | ||||
| -rw-r--r-- | Remote/Helper/Ssh.hs | 2 | ||||
| -rw-r--r-- | Upgrade/V1.hs | 4 | ||||
| -rw-r--r-- | Upgrade/V2.hs | 2 | ||||
| -rw-r--r-- | Utility/Directory.hs | 14 | ||||
| -rw-r--r-- | debian/changelog | 1 | ||||
| -rw-r--r-- | git-union-merge.hs | 2 |
21 files changed, 144 insertions, 104 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 2142d1f09..26b332e24 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -34,6 +34,7 @@ import Common.Annex import Logs.Location import Annex.UUID import qualified Git +import qualified Git.Config import qualified Annex import qualified Annex.Queue import qualified Annex.Branch @@ -303,7 +304,7 @@ saveState oneshot = doSideAction $ do ifM alwayscommit ( Annex.Branch.commit "update" , Annex.Branch.stage) where - alwayscommit = fromMaybe True . Git.configTrue + alwayscommit = fromMaybe True . Git.Config.isTrue <$> getConfig (annexConfig "alwayscommit") "" {- Downloads content from any of a list of urls. -} diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index f0824b119..8bd4fe33a 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -14,7 +14,7 @@ import qualified Data.Map as M import Common.Annex import Annex.LockPool -import qualified Git +import qualified Git.Config import Config import qualified Build.SysConfig as SysConfig import Annex.Perms @@ -47,7 +47,7 @@ sshInfo (host, port) = ifM caching ) where caching = fromMaybe SysConfig.sshconnectioncaching - . Git.configTrue + . Git.Config.isTrue <$> getConfig (annexConfig "sshcaching") "" cacheParams :: FilePath -> [CommandParam] diff --git a/Command/Log.hs b/Command/Log.hs index d78b60206..aa39aea9c 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -133,7 +133,7 @@ compareChanges format changes = concatMap diff $ zip changes (drop 1 changes) - *lot* for newish files. -} getLog :: Key -> [CommandParam] -> Annex [String] getLog key os = do - top <- fromRepo Git.workTree + top <- fromRepo Git.repoPath p <- liftIO $ relPathCwdToFile top let logfile = p </> Logs.Location.logFile key inRepo $ pipeNullSplit $ diff --git a/Command/Map.hs b/Command/Map.hs index bdb86f95a..86e9609a7 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -156,14 +156,14 @@ absRepo :: Git.Repo -> Git.Repo -> Annex Git.Repo absRepo reference r | Git.repoIsUrl reference = return $ Git.Construct.localToUrl reference r | Git.repoIsUrl r = return r - | otherwise = liftIO $ Git.Construct.fromAbsPath =<< absPath (Git.workTree r) + | otherwise = liftIO $ Git.Construct.fromAbsPath =<< absPath (Git.repoPath r) {- Checks if two repos are the same. -} same :: Git.Repo -> Git.Repo -> Bool same a b - | both Git.repoIsSsh = matching Git.Url.authority && matching Git.workTree + | both Git.repoIsSsh = matching Git.Url.authority && matching Git.repoPath | both Git.repoIsUrl && neither Git.repoIsSsh = matching show - | neither Git.repoIsSsh = matching Git.workTree + | neither Git.repoIsSsh = matching Git.repoPath | otherwise = False where @@ -210,7 +210,7 @@ tryScan r where sshcmd = cddir ++ " && " ++ "git config --null --list" - dir = Git.workTree r + dir = Git.repoPath r cddir | "/~" `isPrefixOf` dir = let (userhome, reldir) = span (/= '/') (drop 1 dir) diff --git a/Command/Unused.hs b/Command/Unused.hs index f5ee452a8..1224d0545 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -231,7 +231,7 @@ withKeysReferenced' :: v -> (Key -> v -> Annex v) -> Annex v withKeysReferenced' initial a = go initial =<< files where files = do - top <- fromRepo Git.workTree + top <- fromRepo Git.repoPath inRepo $ LsFiles.inRepo [top] go v [] = return v go v (f:fs) = do @@ -84,7 +84,7 @@ prop_cost_sane = False `notElem` {- Checks if a repo should be ignored. -} repoNotIgnored :: Git.Repo -> Annex Bool -repoNotIgnored r = not . fromMaybe False . Git.configTrue +repoNotIgnored r = not . fromMaybe False . Git.Config.isTrue <$> getRemoteConfig r "ignore" "" {- If a value is specified, it is used; otherwise the default is looked up @@ -3,7 +3,7 @@ - This is written to be completely independant of git-annex and should be - suitable for other uses. - - - Copyright 2010, 2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -17,19 +17,17 @@ module Git ( repoIsUrl, repoIsSsh, repoIsHttp, + repoIsLocal, repoIsLocalBare, repoDescribe, repoLocation, - workTree, - gitDir, - configTrue, + repoPath, + localGitDir, attributes, hookPath, assertLocal, ) where -import qualified Data.Map as M -import Data.Char import Network.URI (uriPath, uriScheme, unEscapeString) import System.Posix.Files @@ -41,15 +39,34 @@ import Utility.FileMode repoDescribe :: Repo -> String repoDescribe Repo { remoteName = Just name } = name repoDescribe Repo { location = Url url } = show url -repoDescribe Repo { location = Dir dir } = dir +repoDescribe Repo { location = Local { worktree = Just dir } } = dir +repoDescribe Repo { location = Local { gitdir = dir } } = dir +repoDescribe Repo { location = LocalUnknown dir } = dir repoDescribe Repo { location = Unknown } = "UNKNOWN" {- Location of the repo, either as a path or url. -} repoLocation :: Repo -> String repoLocation Repo { location = Url url } = show url -repoLocation Repo { location = Dir dir } = dir +repoLocation Repo { location = Local { worktree = Just dir } } = dir +repoLocation Repo { location = Local { gitdir = dir } } = dir +repoLocation Repo { location = LocalUnknown dir } = dir repoLocation Repo { location = Unknown } = undefined +{- Path to a repository. For non-bare, this is the worktree, for bare, + - it's the gitdir, and for URL repositories, is the path on the remote + - host. -} +repoPath :: Repo -> FilePath +repoPath Repo { location = Url u } = unEscapeString $ uriPath u +repoPath Repo { location = Local { worktree = Just d } } = d +repoPath Repo { location = Local { gitdir = d } } = d +repoPath Repo { location = LocalUnknown dir } = dir +repoPath Repo { location = Unknown } = undefined + +{- Path to a local repository's .git directory. -} +localGitDir :: Repo -> FilePath +localGitDir Repo { location = Local { gitdir = d } } = d +localGitDir _ = undefined + {- Some code needs to vary between URL and normal repos, - or bare and non-bare, these functions help with that. -} repoIsUrl :: Repo -> Bool @@ -74,11 +91,12 @@ repoIsHttp Repo { location = Url url } | otherwise = False repoIsHttp _ = False -configAvail ::Repo -> Bool -configAvail Repo { config = c } = c /= M.empty +repoIsLocal :: Repo -> Bool +repoIsLocal Repo { location = Local { } } = True +repoIsLocal _ = False repoIsLocalBare :: Repo -> Bool -repoIsLocalBare r@(Repo { location = Dir _ }) = configAvail r && configBare r +repoIsLocalBare Repo { location = Local { worktree = Nothing } } = True repoIsLocalBare _ = False assertLocal :: Repo -> a -> a @@ -90,49 +108,18 @@ assertLocal repo action ] | otherwise = action -configBare :: Repo -> Bool -configBare repo = maybe unknown (fromMaybe False . configTrue) $ - M.lookup "core.bare" $ config repo - where - unknown = error $ "it is not known if git repo " ++ - repoDescribe repo ++ - " is a bare repository; config not read" - {- Path to a repository's gitattributes file. -} attributes :: Repo -> FilePath attributes repo - | configBare repo = workTree repo ++ "/info/.gitattributes" - | otherwise = workTree repo ++ "/.gitattributes" - -{- Path to a repository's .git directory. -} -gitDir :: Repo -> FilePath -gitDir repo - | configBare repo = workTree repo - | otherwise = workTree repo </> ".git" + | repoIsLocalBare repo = repoPath repo ++ "/info/.gitattributes" + | otherwise = repoPath repo ++ "/.gitattributes" {- Path to a given hook script in a repository, only if the hook exists - and is executable. -} hookPath :: String -> Repo -> IO (Maybe FilePath) hookPath script repo = do - let hook = gitDir repo </> "hooks" </> script + let hook = localGitDir repo </> "hooks" </> script ifM (catchBoolIO $ isexecutable hook) ( return $ Just hook , return Nothing ) where isexecutable f = isExecutable . fileMode <$> getFileStatus f - -{- Path to a repository's --work-tree, that is, its top. - - - - Note that for URL repositories, this is the path on the remote host. -} -workTree :: Repo -> FilePath -workTree Repo { location = Url u } = unEscapeString $ uriPath u -workTree Repo { location = Dir d } = d -workTree Repo { location = Unknown } = undefined - -{- Checks if a string from git config is a true value. -} -configTrue :: String -> Maybe Bool -configTrue s - | s' == "true" = Just True - | s' == "false" = Just False - | otherwise = Nothing - where - s' = map toLower s diff --git a/Git/Command.hs b/Git/Command.hs index bb82d1339..35f0838ba 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -1,6 +1,6 @@ {- running git commands - - - Copyright 2010, 2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -18,11 +18,12 @@ import Git.Types {- Constructs a git command line operating on the specified repo. -} gitCommandLine :: [CommandParam] -> Repo -> [CommandParam] -gitCommandLine params repo@(Repo { location = Dir _ } ) = - -- force use of specified repo via --git-dir and --work-tree - [ Param ("--git-dir=" ++ gitDir repo) - , Param ("--work-tree=" ++ workTree repo) - ] ++ params +gitCommandLine params Repo { location = l@(Local _ _ ) } = setdir : settree ++ params + where + setdir = Param $ "--git-dir=" ++ gitdir l + settree = case worktree l of + Nothing -> [] + Just t -> [Param $ "--work-tree=" ++ t] gitCommandLine _ repo = assertLocal repo $ error "internal" {- Runs git in the specified repo. -} diff --git a/Git/Config.hs b/Git/Config.hs index 38b9ade45..e37b43707 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -1,15 +1,14 @@ {- git repository configuration handling - - - Copyright 2010,2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} module Git.Config where -import System.Posix.Directory -import Control.Exception (bracket_) import qualified Data.Map as M +import Data.Char import Common import Git @@ -30,17 +29,14 @@ getMaybe key repo = M.lookup key (config repo) {- Runs git config and populates a repo with its config. -} read :: Repo -> IO Repo -read repo@(Repo { location = Dir d }) = bracketcd d $ - {- Cannot use pipeRead because it relies on the config having - been already read. Instead, chdir to the repo. -} +read repo@(Repo { location = Local { gitdir = d } }) = read' repo d +read repo@(Repo { location = LocalUnknown d }) = read' repo d +read r = assertLocal r $ error "internal" +{- Cannot use pipeRead because it relies on the config having + been already read. Instead, chdir to the repo. -} +read' :: Repo -> FilePath -> IO Repo +read' repo d = bracketCd d $ pOpen ReadFromPipe "git" ["config", "--null", "--list"] $ hRead repo - where - bracketcd to a = bracketcd' to a =<< getCurrentDirectory - bracketcd' to a cwd - | dirContains to cwd = a - | otherwise = bracket_ (changeWorkingDirectory to) (changeWorkingDirectory cwd) a -read r = assertLocal r $ - error $ "internal error; trying to read config of " ++ show r {- Reads git config from a handle and populates a repo with it. -} hRead :: Repo -> Handle -> IO Repo @@ -48,19 +44,42 @@ hRead repo h = do val <- hGetContentsStrict h store val repo -{- Stores a git config into a repo, returning the new version of the repo. - - The git config may be multiple lines, or a single line. Config settings - - can be updated inrementally. -} +{- Stores a git config into a Repo, returning the new version of the Repo. + - The git config may be multiple lines, or a single line. + - Config settings can be updated incrementally. + -} store :: String -> Repo -> IO Repo store s repo = do let c = parse s - let repo' = repo + let repo' = updateLocation $ repo { config = (M.map Prelude.head c) `M.union` config repo , fullconfig = M.unionWith (++) c (fullconfig repo) } + print repo' rs <- Git.Construct.fromRemotes repo' return $ repo' { remotes = rs } +{- Updates the location of a repo, based on its configuration. + - + - Git.Construct makes LocalUknown repos, of which only a directory is + - known. Once the config is read, this can be fixed up to a Local repo, + - based on the core.bare and core.worktree settings. + -} +updateLocation :: Repo -> Repo +updateLocation r = go $ location r + where + go (LocalUnknown d) + | isbare = ret $ Local d Nothing + | otherwise = ret $ Local (d </> ".git") (Just d) + go l@(Local {}) = ret l + go _ = r + isbare = fromMaybe False $ isTrue =<< getMaybe "core.bare" r + ret l = r { location = l' } + where + l' = maybe l (setworktree l) $ + getMaybe "core.worktree" r + setworktree l t = l { worktree = Just t } + {- Parses git config --list or git config --null --list output into a - config map. -} parse :: String -> M.Map String [String] @@ -74,3 +93,12 @@ parse s ls = lines s sep c = M.fromListWith (++) . map (\(k,v) -> (k, [v])) . map (separate (== c)) + +{- Checks if a string from git config is a true value. -} +isTrue :: String -> Maybe Bool +isTrue s + | s' == "true" = Just True + | s' == "false" = Just False + | otherwise = Nothing + where + s' = map toLower s diff --git a/Git/Construct.hs b/Git/Construct.hs index 3f3ea9747..45ea0f64d 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -1,6 +1,6 @@ {- Construction of Git Repo objects - - - Copyright 2010,2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -58,7 +58,7 @@ fromCurrent = do fromCwd :: IO Repo fromCwd = getCurrentDirectory >>= seekUp isRepoTop >>= maybe norepo makerepo where - makerepo = newFrom . Dir + makerepo = newFrom . LocalUnknown norepo = error "Not in a git repository." {- Local Repo constructor, accepts a relative or absolute path. -} @@ -74,7 +74,7 @@ fromAbsPath dir | otherwise = error $ "internal error, " ++ dir ++ " is not absolute" where - ret = newFrom . Dir + ret = newFrom . LocalUnknown {- Git always looks for "dir.git" in preference to - to "dir", even if dir ends in a "/". -} canondir = dropTrailingPathSeparator dir @@ -122,7 +122,7 @@ localToUrl reference r absurl = Url.scheme reference ++ "//" ++ Url.authority reference ++ - workTree r + repoPath r {- Calculates a list of a repo's configured remotes, by parsing its config. -} fromRemotes :: Repo -> IO [Repo] @@ -191,7 +191,7 @@ fromRemoteLocation s repo = gen $ calcloc s fromRemotePath :: FilePath -> Repo -> IO Repo fromRemotePath dir repo = do dir' <- expandTilde dir - fromAbsPath $ workTree repo </> dir' + fromAbsPath $ repoPath repo </> dir' {- Git remotes can have a directory that is specified relative - to the user's home directory, or that contains tilde expansions. diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 201d76d1d..06d4b9f44 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -69,7 +69,7 @@ typeChanged' ps l repo = do fs <- pipeNullSplit (prefix ++ ps ++ suffix) repo -- git diff returns filenames relative to the top of the git repo; -- convert to filenames relative to the cwd, like git ls-files. - let top = workTree repo + let top = repoPath repo cwd <- getCurrentDirectory return $ map (\f -> relPathDirToFile cwd $ top </> f) fs where diff --git a/Git/Types.hs b/Git/Types.hs index 6063ad213..deb14ebd4 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -1,6 +1,6 @@ {- git data types - - - Copyright 2010,2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,9 +10,21 @@ module Git.Types where import Network.URI import qualified Data.Map as M -{- There are two types of repositories; those on local disk and those - - accessed via an URL. -} -data RepoLocation = Dir FilePath | Url URI | Unknown +{- Support repositories on local disk, and repositories accessed via an URL. + - + - Repos on local disk have a git directory, and unless bare, a worktree. + - + - A local repo may not have had its config read yet, in which case all + - that's known about it is its path. + - + - Finally, an Unknown repository may be known to exist, but nothing + - else known about it. + -} +data RepoLocation + = Local { gitdir :: FilePath, worktree :: Maybe FilePath } + | LocalUnknown FilePath + | Url URI + | Unknown deriving (Show, Eq) data Repo = Repo { @@ -72,7 +72,7 @@ unlessBare :: Annex () -> Annex () unlessBare = unlessM $ fromRepo Git.repoIsLocalBare preCommitHook :: Annex FilePath -preCommitHook = (</>) <$> fromRepo Git.gitDir <*> pure "hooks/pre-commit" +preCommitHook = (</>) <$> fromRepo Git.localGitDir <*> pure "hooks/pre-commit" preCommitScript :: String preCommitScript = diff --git a/Locations.hs b/Locations.hs index 67abf2166..46a85e0ee 100644 --- a/Locations.hs +++ b/Locations.hs @@ -85,28 +85,24 @@ gitAnnexLocation key r | Git.repoIsLocalBare r = {- Bare repositories default to hashDirLower for new - content, as it's more portable. -} - check (map inrepo $ annexLocations key) + check $ map inrepo $ annexLocations key | otherwise = {- Non-bare repositories only use hashDirMixed, so - don't need to do any work to check if the file is - present. -} - return $ inrepo ".git" </> annexLocation key hashDirMixed + return $ inrepo $ annexLocation key hashDirMixed where - inrepo d = Git.workTree r </> d + inrepo d = Git.localGitDir r </> d check locs@(l:_) = fromMaybe l <$> firstM doesFileExist locs check [] = error "internal" {- The annex directory of a repository. -} gitAnnexDir :: Git.Repo -> FilePath -gitAnnexDir r - | Git.repoIsLocalBare r = addTrailingPathSeparator $ Git.workTree r </> annexDir - | otherwise = addTrailingPathSeparator $ Git.workTree r </> ".git" </> annexDir +gitAnnexDir r = addTrailingPathSeparator $ Git.localGitDir r </> annexDir {- The part of the annex directory where file contents are stored. -} gitAnnexObjectDir :: Git.Repo -> FilePath -gitAnnexObjectDir r - | Git.repoIsLocalBare r = addTrailingPathSeparator $ Git.workTree r </> objectDir - | otherwise = addTrailingPathSeparator $ Git.workTree r </> ".git" </> objectDir +gitAnnexObjectDir r = addTrailingPathSeparator $ Git.localGitDir r </> objectDir {- .git/annex/tmp/ is used for temp files -} gitAnnexTmpDir :: Git.Repo -> FilePath diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 108181594..3e7e9211f 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -184,7 +184,7 @@ storeBupUUID u buprepo = do onBupRemote :: Git.Repo -> (FilePath -> [CommandParam] -> IO a) -> FilePath -> [CommandParam] -> Annex a onBupRemote r a command params = do - let dir = shellEscape (Git.workTree r) + let dir = shellEscape (Git.repoPath r) sshparams <- sshToRepo r [Param $ "cd " ++ dir ++ " && " ++ unwords (command : toCommand params)] liftIO $ a "ssh" sshparams diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index 4c5eef0e6..f6742b89f 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -34,7 +34,7 @@ git_annex_shell r command params return $ Just ("ssh", sshparams) | otherwise = return Nothing where - dir = Git.workTree r + dir = Git.repoPath r shellcmd = "git-annex-shell" shellopts = Param command : File dir : params sshcmd uuid = unwords $ diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index ddf0728b6..280742f06 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -82,7 +82,7 @@ moveContent = do updateSymlinks :: Annex () updateSymlinks = do showAction "updating symlinks" - top <- fromRepo Git.workTree + top <- fromRepo Git.repoPath files <- inRepo $ LsFiles.inRepo [top] forM_ files fixlink where @@ -236,4 +236,4 @@ stateDir :: FilePath stateDir = addTrailingPathSeparator ".git-annex" gitStateDir :: Git.Repo -> FilePath -gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir +gitStateDir repo = addTrailingPathSeparator $ Git.repoPath repo </> stateDir diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index c57b0bf68..202ba5b16 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -134,4 +134,4 @@ gitAttributesUnWrite repo = do stateDir :: FilePath stateDir = addTrailingPathSeparator ".git-annex" gitStateDir :: Git.Repo -> FilePath -gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir +gitStateDir repo = addTrailingPathSeparator $ Git.repoPath repo </> stateDir diff --git a/Utility/Directory.hs b/Utility/Directory.hs index e6622d31e..3041361df 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -15,11 +15,14 @@ import Control.Monad import Control.Monad.IfElse import System.FilePath import Control.Applicative +import Control.Exception (bracket_) +import System.Posix.Directory import Utility.SafeCommand import Utility.TempFile import Utility.Exception import Utility.Monad +import Utility.Path {- Lists the contents of a directory. - Unlike getDirectoryContents, paths are not relative to the directory. -} @@ -60,3 +63,14 @@ moveFile src dest = tryIO (rename src dest) >>= onrename case r of (Left _) -> return False (Right s) -> return $ isDirectory s + +{- Runs an action in another directory. -} +bracketCd :: FilePath -> IO a -> IO a +bracketCd dir a = go =<< getCurrentDirectory + where + go cwd + | dirContains dir cwd = a + | otherwise = bracket_ + (changeWorkingDirectory dir) + (changeWorkingDirectory cwd) + a diff --git a/debian/changelog b/debian/changelog index a4e2b8b3e..4e61445c8 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,6 +2,7 @@ git-annex (3.20120512) UNRELEASED; urgency=low * Pass -a to cp even when it supports --reflink=auto, to preserve permissions. + * Clean up handling of git directory and git worktree. -- Joey Hess <joeyh@debian.org> Tue, 15 May 2012 14:17:49 -0400 diff --git a/git-union-merge.hs b/git-union-merge.hs index f44136bfc..182d8cf79 100644 --- a/git-union-merge.hs +++ b/git-union-merge.hs @@ -22,7 +22,7 @@ usage :: IO a usage = error $ "bad parameters\n\n" ++ header tmpIndex :: Git.Repo -> FilePath -tmpIndex g = Git.gitDir g </> "index.git-union-merge" +tmpIndex g = Git.localGitDir g </> "index.git-union-merge" setup :: Git.Repo -> IO () setup = cleanup -- idempotency |