mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

include HEAD in CanPush shas

Browse source
This commit is contained in:
Joey Hess 2013-05-21 20:04:38 -04:00
parent 20710d4c24
commit a600471a23
2 changed files with 12 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Assistant/Sync.hs
View file

@ -115,7 +115,8 @@ pushToRemotes' now notifypushes remotes = do
ret <- go True branch g u normalremotes
unless (null xmppremotes) $ do
shas <- liftAnnex $ map fst <$>
inRepo (Git.Ref.matching [Annex.Branch.fullname, Git.Ref.headRef])
inRepo (Git.Ref.matchingWithHEAD
[Annex.Branch.fullname, Git.Ref.headRef])
forM_ xmppremotes $ \r -> sendNetMessage $
Pushing (getXMPPClientID r) (CanPush u shas)
return ret

12
Git/Ref.hs
View file

@ -59,8 +59,16 @@ sha branch repo = process <$> showref repo
{- List of (shas, branches) matching a given ref or refs. -}
matching :: [Ref] -> Repo -> IO [(Sha, Branch)]
matching refs repo = map gen . lines <$>
pipeReadStrict (Param "show-ref" : map (Param . show) refs) repo
matching refs repo = matching' (map show refs) repo
{- Includes HEAD in the output, if asked for it. -}
matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)]
matchingWithHEAD refs repo = matching' ("--head" : map show refs) repo
{- List of (shas, branches) matching a given ref or refs. -}
matching' :: [String] -> Repo -> IO [(Sha, Branch)]
matching' ps repo = map gen . lines <$>
pipeReadStrict (Param "show-ref" : map Param ps) repo
where
gen l = let (r, b) = separate (== ' ') l
in (Ref r, Ref b)