diff options
| -rw-r--r-- | Assistant/Threads/MountWatcher.hs | 23 | ||||
| -rw-r--r-- | Assistant/Threads/Pusher.hs | 8 | ||||
| -rw-r--r-- | Command/Sync.hs | 9 | ||||
| -rw-r--r-- | Git/Branch.hs | 23 |
4 files changed, 36 insertions, 27 deletions
diff --git a/Assistant/Threads/MountWatcher.hs b/Assistant/Threads/MountWatcher.hs index 2cde0f183..ca359a268 100644 --- a/Assistant/Threads/MountWatcher.hs +++ b/Assistant/Threads/MountWatcher.hs @@ -22,8 +22,8 @@ import Utility.ThreadScheduler import Utility.Mounts import Remote.List import qualified Types.Remote as Remote -import qualified Command.Sync import Assistant.Threads.Merger +import qualified Git.Branch import Control.Concurrent import qualified Control.Exception as E @@ -161,15 +161,18 @@ handleMount st dstatus scanremotes dir = do debug thisThread ["detected mount of", dir] rs <- remotesUnder st dstatus dir unless (null rs) $ do - branch <- runThreadState st $ Command.Sync.currentBranch - let nonspecial = filter (Git.repoIsLocal . Remote.repo) rs - unless (null nonspecial) $ - void $ alertWhile dstatus (syncMountAlert dir nonspecial) $ do - debug thisThread ["syncing with", show nonspecial] - runThreadState st $ manualPull branch nonspecial - now <- getCurrentTime - pushToRemotes thisThread now st Nothing nonspecial - addScanRemotes scanremotes rs + go rs =<< runThreadState st (inRepo Git.Branch.current) + where + go _ Nothing = noop + go rs (Just branch) = do + let nonspecial = filter (Git.repoIsLocal . Remote.repo) rs + unless (null nonspecial) $ + void $ alertWhile dstatus (syncMountAlert dir nonspecial) $ do + debug thisThread ["syncing with", show nonspecial] + runThreadState st $ manualPull branch nonspecial + now <- getCurrentTime + pushToRemotes thisThread now st Nothing nonspecial + addScanRemotes scanremotes rs {- Finds remotes located underneath the mount point. - diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index ab0274db1..5e110b77d 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -17,6 +17,7 @@ import Assistant.DaemonStatus import qualified Command.Sync import Utility.ThreadScheduler import Utility.Parallel +import qualified Git.Branch import Data.Time.Clock import qualified Data.Map as M @@ -84,10 +85,11 @@ shouldPush _now commits pushToRemotes :: ThreadName -> UTCTime -> ThreadState -> (Maybe FailedPushMap) -> [Remote] -> IO Bool pushToRemotes threadname now st mpushmap remotes = do (g, branch) <- runThreadState st $ - (,) <$> fromRepo id <*> Command.Sync.currentBranch + (,) <$> fromRepo id <*> inRepo Git.Branch.current go True branch g remotes where - go shouldretry branch g rs = do + go _ Nothing _ _ = return True -- no branch, so nothing to do + go shouldretry (Just branch) g rs = do debug threadname [ "pushing to" , show rs @@ -117,4 +119,4 @@ pushToRemotes threadname now st mpushmap remotes = do retry branch g rs = do debug threadname [ "trying manual pull to resolve failed pushes" ] runThreadState st $ manualPull branch rs - go False branch g rs + go False (Just branch) g rs diff --git a/Command/Sync.hs b/Command/Sync.hs index dfaed5949..7bf3048de 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -6,8 +6,6 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE BangPatterns #-} - module Command.Sync where import Common.Annex @@ -39,7 +37,7 @@ def = [command "sync" (paramOptional (paramRepeating paramRemote)) -- syncing involves several operations, any of which can independently fail seek :: CommandSeek seek rs = do - branch <- currentBranch + branch <- fromMaybe nobranch <$> inRepo Git.Branch.current remotes <- syncRemotes rs return $ concat [ [ commit ] @@ -49,11 +47,6 @@ seek rs = do , [ 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" diff --git a/Git/Branch.hs b/Git/Branch.hs index 4d239d8fc..098aa1a1a 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE BangPatterns #-} + module Git.Branch where import Common @@ -12,13 +14,22 @@ import Git import Git.Sha import Git.Command -{- The currently checked out branch. -} +{- The currently checked out branch. + - + - In a just initialized git repo before the first commit, + - symbolic-ref will show the master branch, even though that + - branch is not created yet. So, this also looks at show-ref HEAD + - to double-check. + -} current :: Repo -> IO (Maybe Git.Ref) -current r = parse <$> pipeRead [Param "symbolic-ref", Param "HEAD"] r - where - parse v - | null v = Nothing - | otherwise = Just $ Git.Ref $ firstLine v +current r = do + branch <- firstLine <$> pipeRead [Param "symbolic-ref", Param "HEAD"] r + if null branch + then return Nothing + else ifM (null <$> pipeRead [Param "show-ref", Param branch] r) + ( return Nothing + , return $ Just $ Git.Ref branch + ) {- Checks if the second branch has any commits not present on the first - branch. -} |