diff --git a/CmdLine.hs b/CmdLine.hs index ff1758f0dc..0590f11124 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -19,7 +19,6 @@ import Control.Monad (when) import qualified Annex import qualified AnnexQueue import qualified Git -import qualified Branch import Content import Types import Command @@ -60,16 +59,7 @@ parseCmd argv header cmds options = do {- Checks that the command can be run in the current environment. -} checkCmdEnviron :: Command -> Annex () -checkCmdEnviron command = do - when (cmdusesrepo command) $ checkVersion $ do - {- Automatically initialize if there is already a git-annex - branch from somewhere. Otherwise, require a manual init - to avoid git-annex accidentially being run in git - repos that did not intend to use it. -} - annexed <- Branch.hasSomeBranch - if annexed - then initialize - else error "First run: git-annex init" +checkCmdEnviron command = when (cmdusesrepo command) $ checkVersion $ initializeSafe {- Usage message with lists of commands and options. -} usage :: String -> [Command] -> [Option] -> String diff --git a/Init.hs b/Init.hs index 41256a9530..36d3ed0fac 100644 --- a/Init.hs +++ b/Init.hs @@ -5,7 +5,11 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Init (initialize, uninitialize) where +module Init ( + initialize, + initializeSafe, + uninitialize +) where import Control.Monad.State (liftIO) import Control.Monad (unless) @@ -34,6 +38,17 @@ uninitialize = do g <- Annex.gitRepo gitPreCommitHookUnWrite g +{- Call to automatically initialize if there is already a git-annex + branch from somewhere. Otherwise, require a manual init + to avoid git-annex accidentially being run in git + repos that did not intend to use it. -} +initializeSafe :: Annex () +initializeSafe = do + annexed <- Branch.hasSomeBranch + if annexed + then initialize + else error "First run: git-annex init" + {- set up a git pre-commit hook, if one is not already present -} gitPreCommitHookWrite :: Git.Repo -> Annex () gitPreCommitHookWrite repo = do diff --git a/Remote/Git.hs b/Remote/Git.hs index d4847d6105..c588cc73bb 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -28,6 +28,7 @@ import Utility.RsyncFile import Remote.Helper.Ssh import qualified Remote.Helper.Url as Url import Config +import Init remote :: RemoteType Annex remote = RemoteType { @@ -79,7 +80,9 @@ tryGitConfigRead r | Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" [] | Git.repoIsHttp r = store $ safely $ geturlconfig | Git.repoIsUrl r = return r - | otherwise = store $ safely $ Git.configRead r + | otherwise = store $ safely $ do + onLocal r initializeSafe + Git.configRead r where -- Reading config can fail due to IO error or -- for other reasons; catch all possible exceptions. @@ -124,11 +127,7 @@ inAnnex r key | Git.repoIsUrl r = checkremote | otherwise = safely checklocal where - checklocal = do - -- run a local check inexpensively, - -- by making an Annex monad using the remote - a <- Annex.new r - Annex.eval a (Content.inAnnex key) + checklocal = onLocal r (Content.inAnnex key) checkremote = do showAction $ "checking " ++ Git.repoDescribe r inannex <- onRemote r (boolSystem, False) "inannex" @@ -137,6 +136,13 @@ inAnnex r key checkhttp = Url.exists $ keyUrl r key safely a = liftIO (try a ::IO (Either IOException Bool)) +{- Runs an action on a local repository inexpensively, by making an annex + - monad using that repository. -} +onLocal :: Git.Repo -> Annex a -> IO a +onLocal r a = do + annex <- Annex.new r + Annex.eval annex a + keyUrl :: Git.Repo -> Key -> String keyUrl r key = Git.repoLocation r ++ "/" ++ annexLocation key @@ -163,13 +169,11 @@ copyToRemote r key g <- Annex.gitRepo let keysrc = gitAnnexLocation g key -- run copy from perspective of remote - liftIO $ do - a <- Annex.new r - Annex.eval a $ do - ok <- Content.getViaTmp key $ - rsyncOrCopyFile r keysrc - Content.saveState - return ok + liftIO $ onLocal r $ do + ok <- Content.getViaTmp key $ + rsyncOrCopyFile r keysrc + Content.saveState + return ok | Git.repoIsSsh r = do g <- Annex.gitRepo let keysrc = gitAnnexLocation g key