diff options
Diffstat (limited to 'Command/Sync.hs')
| -rw-r--r-- | Command/Sync.hs | 117 |
1 files changed, 83 insertions, 34 deletions
diff --git a/Command/Sync.hs b/Command/Sync.hs index 36c4eeef0..a9089463d 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -9,20 +9,41 @@ module Command.Sync where import Common.Annex import Command +import qualified Remote import qualified Annex.Branch import qualified Git.Command import qualified Git.Config import qualified Git.Ref import qualified Git +import qualified Command.Merge import qualified Data.ByteString.Lazy.Char8 as L def :: [Command] -def = [command "sync" paramPaths seek "synchronize local repository with remote"] +def = [command "sync" (paramOptional (paramRepeating paramRemote)) + [seek] "synchronize local repository with remote repositories"] -- syncing involves several operations, any of which can independantly fail -seek :: [CommandSeek] -seek = map withNothing [commit, pull, push] +seek :: CommandSeek +seek args = do + remotes <- if null args + then defaultSyncRemotes + else mapM Remote.byName args + branch <- currentBranch + showStart "syncing" $ "branch " ++ Git.Ref.describe branch ++ " with remote repositories " ++ intercalate "," (map Remote.name remotes) + showOutput + return $ + [ commit + , mergeLocal branch + ] ++ + [ fetch remote | remote <- remotes ] ++ + [ mergeRemote remote branch | remote <- remotes ] ++ + [ Command.Merge.start ] ++ + [ pushLocal branch ] ++ + [ pushRemote remote branch | remote <- remotes ] + +defaultSyncRemotes :: Annex [Remote.Remote Annex] +defaultSyncRemotes = undefined commit :: CommandStart commit = do @@ -31,44 +52,72 @@ commit = do showOutput -- Commit will fail when the tree is clean, so ignore failure. _ <- inRepo $ Git.Command.runBool "commit" - [Param "-a", Param "-m", Param "sync"] + [Param "-a", Param "-m", Param "git-annex automatic sync"] return True -pull :: CommandStart -pull = do - remote <- defaultRemote - showStart "pull" remote +mergeLocal :: Git.Ref -> CommandStart +mergeLocal branch = + mergeFromIfExists $ Git.Ref $ "refs/heads/synced/" ++ Git.Ref.describe branch + +pushLocal :: Git.Ref -> CommandStart +pushLocal branch = do + let syncBranch = Git.Ref $ "refs/heads/synced/" ++ Git.Ref.describe branch + ex <- inRepo $ Git.Ref.exists syncBranch + if ex then do + showStart "updateing" $ + Git.Ref.describe syncBranch ++ + " to the state of " ++ Git.Ref.describe branch ++ "..." + next $ next $ + inRepo $ Git.Command.runBool "branch" [Param "-f", Param (Git.Ref.describe syncBranch)] + else + return Nothing + +mergeFromIfExists :: Git.Ref -> CommandStart +mergeFromIfExists fromBranch = do + ex <- inRepo $ Git.Ref.exists fromBranch + if ex then do + showStart "merging" $ Git.Ref.describe fromBranch ++ "..." + next $ next $ + inRepo $ Git.Command.runBool "merge" [Param (show fromBranch)] + else do + showNote $ Git.Ref.describe fromBranch ++ " does not exist, not merging." + showOutput + return Nothing + + +fetch :: Remote.Remote Annex -> CommandStart +fetch remote = do + showStart "fetching from" (Remote.name remote) next $ next $ do showOutput checkRemote remote - inRepo $ Git.Command.runBool "pull" [Param remote] + inRepo $ Git.Command.runBool "fetch" [Param (Remote.name remote)] -push :: CommandStart -push = do - remote <- defaultRemote - showStart "push" remote - next $ next $ do - Annex.Branch.update - showOutput - inRepo $ Git.Command.runBool "push" [Param remote, matchingbranches] - where - -- git push may be configured to not push matching - -- branches; this should ensure it always does. - matchingbranches = Param ":" - --- the remote defaults to origin when not configured -defaultRemote :: Annex String -defaultRemote = do - branch <- currentBranch - fromRepo $ Git.Config.get ("branch." ++ branch ++ ".remote") "origin" - -currentBranch :: Annex String -currentBranch = Git.Ref.describe . Git.Ref . firstLine . L.unpack <$> +mergeRemote :: Remote.Remote Annex -> Git.Ref -> CommandStart +mergeRemote remote branch = + mergeFromIfExists $ Git.Ref $ "refs/remotes/" ++ Remote.name remote ++ "/synced/" ++ Git.Ref.describe branch + +pushRemote :: Remote.Remote Annex -> Git.Ref -> CommandStart +pushRemote remote branch = do + showStart "pushing to" (Remote.name remote) + let syncbranch = Git.Ref $ "refs/heads/synced/" ++ Git.Ref.describe branch + let syncbranchRemote = Git.Ref $ "refs/remotes/" ++ Remote.name remote ++ "/" ++ Git.Ref.describe syncbranch + let refspec = Git.Ref.describe branch ++ ":" ++ Git.Ref.describe syncbranch + ex <- inRepo $ Git.Ref.exists syncbranchRemote + next $ next $ do + showOutput + inRepo $ Git.Command.runBool "push" $ + [ Param (Remote.name remote) + , Param (Git.Ref.describe Annex.Branch.name) ] ++ + [ Param refspec | ex ] + +currentBranch :: Annex Git.Ref +currentBranch = Git.Ref . firstLine . L.unpack <$> inRepo (Git.Command.pipeRead [Param "symbolic-ref", Param "HEAD"]) -checkRemote :: String -> Annex () +checkRemote :: Remote.Remote Annex -> Annex () checkRemote remote = do remoteurl <- fromRepo $ - Git.Config.get ("remote." ++ remote ++ ".url") "" - when (null remoteurl) $ do - error $ "No url is configured for the remote: " ++ remote + Git.Config.get ("remote." ++ Remote.name remote ++ ".url") "" + when (null remoteurl) $ + error $ "No url is configured for the remote: " ++ Remote.name remote |