deferred downloads
Now when a download is queued and there's no known remote to get it from, it's added to a deferred download list, which will be retried later. The Merger thread tries to queue any deferred downloads when it receives a push to the git-annex branch. Note that the Merger thread now also forces an update of the git-annex branch. The assistant was not updating this branch before, and it saw a (mostly) correct view of state, but now that incoming pushes go to synced/git-annex, it needs to be merged in.
This commit is contained in:
parent
7a86dc9443
commit
3c22977e44
4 changed files with 76 additions and 37 deletions
|
@ -9,6 +9,8 @@ module Assistant.Threads.Merger where
|
|||
|
||||
import Assistant.Common
|
||||
import Assistant.ThreadedMonad
|
||||
import Assistant.DaemonStatus
|
||||
import Assistant.TransferQueue
|
||||
import Utility.DirWatcher
|
||||
import Utility.Types.DirWatcher
|
||||
import qualified Annex.Branch
|
||||
|
@ -19,15 +21,14 @@ import qualified Git.Branch
|
|||
thisThread :: ThreadName
|
||||
thisThread = "Merger"
|
||||
|
||||
{- This thread watches for changes to .git/refs/, looking for
|
||||
- incoming pushes. It merges those pushes into the currently
|
||||
- checked out branch. -}
|
||||
mergeThread :: ThreadState -> NamedThread
|
||||
mergeThread st = thread $ do
|
||||
{- This thread watches for changes to .git/refs/, and handles incoming
|
||||
- pushes. -}
|
||||
mergeThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> NamedThread
|
||||
mergeThread st dstatus transferqueue = thread $ do
|
||||
g <- runThreadState st $ fromRepo id
|
||||
let dir = Git.localGitDir g </> "refs"
|
||||
createDirectoryIfMissing True dir
|
||||
let hook a = Just $ runHandler g a
|
||||
let hook a = Just $ runHandler st dstatus transferqueue g a
|
||||
let hooks = mkWatchHooks
|
||||
{ addHook = hook onAdd
|
||||
, errHook = hook onErr
|
||||
|
@ -37,21 +38,21 @@ mergeThread st = thread $ do
|
|||
where
|
||||
thread = NamedThread thisThread
|
||||
|
||||
type Handler = Git.Repo -> FilePath -> Maybe FileStatus -> IO ()
|
||||
type Handler = ThreadState -> DaemonStatusHandle -> TransferQueue -> Git.Repo -> FilePath -> Maybe FileStatus -> IO ()
|
||||
|
||||
{- Runs an action handler.
|
||||
-
|
||||
- Exceptions are ignored, otherwise a whole thread could be crashed.
|
||||
-}
|
||||
runHandler :: Git.Repo -> Handler -> FilePath -> Maybe FileStatus -> IO ()
|
||||
runHandler g handler file filestatus = void $
|
||||
runHandler :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Git.Repo -> Handler -> FilePath -> Maybe FileStatus -> IO ()
|
||||
runHandler st dstatus transferqueue g handler file filestatus = void $
|
||||
either print (const noop) =<< tryIO go
|
||||
where
|
||||
go = handler g file filestatus
|
||||
go = handler st dstatus transferqueue g file filestatus
|
||||
|
||||
{- Called when there's an error with inotify. -}
|
||||
onErr :: Handler
|
||||
onErr _ msg _ = error msg
|
||||
onErr _ _ _ _ msg _ = error msg
|
||||
|
||||
{- Called when a new branch ref is written.
|
||||
-
|
||||
|
@ -65,14 +66,16 @@ onErr _ msg _ = error msg
|
|||
- ran are merged in.
|
||||
-}
|
||||
onAdd :: Handler
|
||||
onAdd g file _
|
||||
onAdd st dstatus transferqueue g file _
|
||||
| ".lock" `isSuffixOf` file = noop
|
||||
| isAnnexBranch file = noop
|
||||
| "/synced/" `isInfixOf` file = go =<< Git.Branch.current g
|
||||
| isAnnexBranch file = runThreadState st $
|
||||
whenM Annex.Branch.forceUpdate $
|
||||
queueDeferredDownloads Later transferqueue dstatus
|
||||
| "/synced/" `isInfixOf` file = mergecurrent =<< Git.Branch.current g
|
||||
| otherwise = noop
|
||||
where
|
||||
changedbranch = fileToBranch file
|
||||
go (Just current)
|
||||
mergecurrent (Just current)
|
||||
| equivBranches changedbranch current = do
|
||||
liftIO $ debug thisThread
|
||||
[ "merging"
|
||||
|
@ -81,7 +84,7 @@ onAdd g file _
|
|||
, show current
|
||||
]
|
||||
void $ Git.Merge.mergeNonInteractive changedbranch g
|
||||
go _ = noop
|
||||
mergecurrent _ = noop
|
||||
|
||||
equivBranches :: Git.Ref -> Git.Ref -> Bool
|
||||
equivBranches x y = base x == base y
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue