1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
{- git-annex command
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
- Copyright 2011 Joachim Breitner <mail@joachim-breitner.de>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE BangPatterns #-}
module Command.Sync where
import Common.Annex
import Command
import qualified Remote
import qualified Annex
import qualified Annex.Branch
import qualified Git.Command
import qualified Git.Branch
import qualified Git.Ref
import qualified Git
import qualified Types.Remote
import qualified Remote.Git
import qualified Data.Map as M
def :: [Command]
def = [command "sync" (paramOptional (paramRepeating paramRemote))
[seek] "synchronize local repository with remotes"]
-- syncing involves several operations, any of which can independently fail
seek :: CommandSeek
seek rs = do
branch <- currentBranch
remotes <- syncRemotes rs
return $ concat
[ [ commit ]
, [ mergeLocal branch ]
, [ pullRemote remote branch | remote <- remotes ]
, [ mergeAnnex ]
, [ pushLocal branch ]
, [ pushRemote remote branch | remote <- remotes ]
]
currentBranch :: Annex Git.Ref
currentBranch = do
!branch <- fromMaybe nobranch <$> inRepo Git.Branch.current
return branch
where
nobranch = error "no branch is checked out"
syncBranch :: Git.Ref -> Git.Ref
syncBranch = Git.Ref.under "refs/heads/synced/"
remoteBranch :: Remote -> Git.Ref -> Git.Ref
remoteBranch remote = Git.Ref.under $ "refs/remotes/" ++ Remote.name remote
syncRemotes :: [String] -> Annex [Remote]
syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )
where
pickfast = (++) <$> listed <*> (good =<< fastest <$> available)
wanted
| null rs = good =<< concat . byspeed <$> available
| otherwise = listed
listed = do
l <- catMaybes <$> mapM (Remote.byName . Just) rs
let s = filter special l
unless (null s) $
error $ "cannot sync special remotes: " ++
unwords (map Types.Remote.name s)
return l
available = filter nonspecial <$> Remote.enabledRemoteList
good = filterM $ Remote.Git.repoAvail . Types.Remote.repo
nonspecial r = Types.Remote.remotetype r == Remote.Git.remote
special = not . nonspecial
fastest = fromMaybe [] . headMaybe . byspeed
byspeed = map snd . sort . M.toList . costmap
costmap = M.fromListWith (++) . map costpair
costpair r = (Types.Remote.cost r, [r])
commit :: CommandStart
commit = do
showStart "commit" ""
next $ next $ do
showOutput
Annex.Branch.commit "update"
-- Commit will fail when the tree is clean, so ignore failure.
_ <- inRepo $ Git.Command.runBool "commit"
[Param "-a", Param "-m", Param "git-annex automatic sync"]
return True
mergeLocal :: Git.Ref -> CommandStart
mergeLocal branch = go =<< needmerge
where
syncbranch = syncBranch branch
needmerge = do
unlessM (inRepo $ Git.Ref.exists syncbranch) $
inRepo $ updateBranch syncbranch
inRepo $ Git.Branch.changed branch syncbranch
go False = stop
go True = do
showStart "merge" $ Git.Ref.describe syncbranch
next $ next $ mergeFrom syncbranch
pushLocal :: Git.Ref -> CommandStart
pushLocal branch = do
inRepo $ updateBranch $ syncBranch branch
stop
updateBranch :: Git.Ref -> Git.Repo -> IO ()
updateBranch syncbranch g =
unlessM go $ error $ "failed to update " ++ show syncbranch
where
go = Git.Command.runBool "branch"
[ Param "-f"
, Param $ show $ Git.Ref.base syncbranch
] g
pullRemote :: Remote -> Git.Ref -> CommandStart
pullRemote remote branch = do
showStart "pull" (Remote.name remote)
next $ do
showOutput
stopUnless fetch $
next $ mergeRemote remote branch
where
fetch = inRepo $ Git.Command.runBool "fetch"
[Param $ Remote.name remote]
{- The remote probably has both a master and a synced/master branch.
- Which to merge from? Well, the master has whatever latest changes
- were committed, while the synced/master may have changes that some
- other remote synced to this remote. So, merge them both. -}
mergeRemote :: Remote -> Git.Ref -> CommandCleanup
mergeRemote remote branch = all id <$> (mapM merge =<< tomerge)
where
merge = mergeFrom . remoteBranch remote
tomerge = filterM (changed remote) [branch, syncBranch branch]
pushRemote :: Remote -> Git.Ref -> CommandStart
pushRemote remote branch = go =<< needpush
where
needpush = anyM (newer remote) [syncBranch branch, Annex.Branch.name]
go False = stop
go True = do
showStart "push" (Remote.name remote)
next $ next $ do
showOutput
inRepo $ pushBranch remote branch
pushBranch :: Remote -> Git.Ref -> Git.Repo -> IO Bool
pushBranch remote branch g =
Git.Command.runBool "push"
[ Param (Remote.name remote)
, Param (show Annex.Branch.name)
, Param refspec
] g
where
refspec = concat
[ show $ Git.Ref.base branch
, ":"
, show $ Git.Ref.base $ syncBranch branch
]
mergeAnnex :: CommandStart
mergeAnnex = do
Annex.Branch.forceUpdate
stop
mergeFrom :: Git.Ref -> CommandCleanup
mergeFrom branch = do
showOutput
inRepo $ Git.Command.runBool "merge" [Param $ show branch]
changed :: Remote -> Git.Ref -> Annex Bool
changed remote b = do
let r = remoteBranch remote b
ifM (inRepo $ Git.Ref.exists r)
( inRepo $ Git.Branch.changed b r
, return False
)
newer :: Remote -> Git.Ref -> Annex Bool
newer remote b = do
let r = remoteBranch remote b
ifM (inRepo $ Git.Ref.exists r)
( inRepo $ Git.Branch.changed r b
, return True
)
|
