diff options
| -rw-r--r-- | Annex.hs | 30 | ||||
| -rw-r--r-- | Annex/Direct/Fixup.hs | 31 |
2 files changed, 39 insertions, 22 deletions
@@ -40,12 +40,11 @@ import Control.Concurrent import Common import qualified Git import qualified Git.Config -import Git.Types hiding (remotes) +import Annex.Direct.Fixup import Git.CatFile import Git.CheckAttr import Git.CheckIgnore import Git.SharedRepository -import Git.Config import qualified Git.Queue import Types.Backend import Types.GitConfig @@ -112,9 +111,9 @@ data AnnexState = AnnexState , useragent :: Maybe String } -newState :: Git.Repo -> AnnexState -newState r = AnnexState - { repo = if annexDirect c then fixupDirect r else r +newState :: GitConfig -> Git.Repo -> AnnexState +newState c r = AnnexState + { repo = r , gitconfig = c , backends = [] , remotes = [] @@ -145,13 +144,14 @@ newState r = AnnexState , inodeschanged = Nothing , useragent = Nothing } - where - c = extractGitConfig r {- Makes an Annex state object for the specified git repo. - Ensures the config is read, if it was not already. -} new :: Git.Repo -> IO AnnexState -new = newState <$$> Git.Config.read +new r = do + r' <- Git.Config.read r + let c = extractGitConfig r' + newState c <$> if annexDirect c then fixupDirect r' else return r' {- Performs an action in the Annex monad from a starting state, - returning a new state. -} @@ -250,17 +250,3 @@ withCurrentState :: Annex a -> Annex (IO a) withCurrentState a = do s <- getState id return $ eval s a - -{- Direct mode repos have core.bare=true, but are not really bare. - - Fix up the Repo to be a non-bare repo, and arrange for git commands - - run by git-annex to be passed parameters that override this setting. -} -fixupDirect :: Git.Repo -> Git.Repo -fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = - r - { location = l { worktree = Just (parentDir d) } - , gitGlobalOpts = gitGlobalOpts r ++ - [ Param "-c" - , Param $ coreBare ++ "=" ++ boolConfig False - ] - } -fixupDirect r = r diff --git a/Annex/Direct/Fixup.hs b/Annex/Direct/Fixup.hs new file mode 100644 index 000000000..13485242a --- /dev/null +++ b/Annex/Direct/Fixup.hs @@ -0,0 +1,31 @@ +{- git-annex direct mode guard fixup + - + - Copyright 2013 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Direct.Fixup where + +import Git.Types +import Git.Config +import qualified Git.Construct as Construct +import Utility.Path +import Utility.SafeCommand + +{- Direct mode repos have core.bare=true, but are not really bare. + - Fix up the Repo to be a non-bare repo, and arrange for git commands + - run by git-annex to be passed parameters that override this setting. -} +fixupDirect :: Repo -> IO Repo +fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = do + let r' = r + { location = l { worktree = Just (parentDir d) } + , gitGlobalOpts = gitGlobalOpts r ++ + [ Param "-c" + , Param $ coreBare ++ "=" ++ boolConfig False + ] + } + -- Recalc now that the worktree is correct. + rs' <- Construct.fromRemotes r' + return $ r' { remotes = rs' } +fixupDirect r = return r |