more LiveUpdate plumbing
This commit is contained in:
parent
eb841ab004
commit
3f8675f339
3 changed files with 27 additions and 23 deletions
|
@ -21,6 +21,7 @@ import qualified Data.Set as S
|
|||
|
||||
updateRepoSize :: LiveUpdate -> UUID -> Key -> LogStatus -> Annex ()
|
||||
updateRepoSize lu u k s = do
|
||||
-- XXX call finishedLiveUpdate
|
||||
rsv <- Annex.getRead Annex.reposizes
|
||||
liftIO (takeMVar rsv) >>= \case
|
||||
Nothing -> liftIO (putMVar rsv Nothing)
|
||||
|
@ -54,13 +55,6 @@ accumRepoSizes k (newlocs, removedlocs) sizemap =
|
|||
let !sizemap' = foldl' (flip $ M.alter $ addKeyRepoSize k) sizemap newlocs
|
||||
in foldl' (flip $ M.alter $ removeKeyRepoSize k) sizemap' removedlocs
|
||||
|
||||
-- Called when a preferred content check indicates that a live update is
|
||||
-- needed. Can be called more than once.
|
||||
startLiveUpdate :: LiveUpdate -> Annex ()
|
||||
startLiveUpdate (LiveUpdate startv _donev) =
|
||||
liftIO $ void $ tryPutMVar startv ()
|
||||
startLiveUpdate NoLiveUpdate = noop
|
||||
|
||||
-- When the UUID is Nothing, it's a live update of the local repository.
|
||||
prepareLiveUpdate :: Maybe UUID -> Key -> SizeChange -> Annex LiveUpdate
|
||||
prepareLiveUpdate mu k sc = do
|
||||
|
@ -79,7 +73,7 @@ prepareLiveUpdate mu k sc = do
|
|||
waitdone donev h u
|
||||
Left _ -> noop
|
||||
|
||||
{- Wait for endLiveUpdate to be called, or for the LiveUpdate to
|
||||
{- Wait for finishedLiveUpdate to be called, or for the LiveUpdate to
|
||||
- get garbage collected in the case where the change didn't
|
||||
- actually happen. -}
|
||||
waitdone donev h u = tryNonAsync (takeMVar donev) >>= \case
|
||||
|
@ -94,6 +88,13 @@ prepareLiveUpdate mu k sc = do
|
|||
Left _ -> done h u
|
||||
done h u = Db.finishedLiveSizeChange h u k sc
|
||||
|
||||
-- Called when a preferred content check indicates that a live update is
|
||||
-- needed. Can be called more than once.
|
||||
startLiveUpdate :: LiveUpdate -> Annex ()
|
||||
startLiveUpdate (LiveUpdate startv _donev) =
|
||||
liftIO $ void $ tryPutMVar startv ()
|
||||
startLiveUpdate NoLiveUpdate = noop
|
||||
|
||||
finishedLiveUpdate :: LiveUpdate -> Bool -> UUID -> Key -> SizeChange -> IO ()
|
||||
finishedLiveUpdate (LiveUpdate _startv donev) succeeded u k sc =
|
||||
putMVar donev (succeeded, u, k, sc)
|
||||
|
|
|
@ -125,7 +125,7 @@ fixupReq req@(Req {}) opts =
|
|||
unlessM (inAnnex k) $
|
||||
commandAction $
|
||||
starting "get" ai si $
|
||||
Command.Get.perform k af
|
||||
Command.Get.perform NoLiveUpdate k af
|
||||
repoint k
|
||||
where
|
||||
ai = OnlyActionOn k (ActionItemKey k)
|
||||
|
|
|
@ -926,38 +926,41 @@ syncFile o ebloom rs af k = do
|
|||
|
||||
return (got || not (null putrs))
|
||||
where
|
||||
wantget have inhere = allM id
|
||||
wantget lu have inhere = allM id
|
||||
[ pure (pullOption o || operationMode o == SatisfyMode)
|
||||
, pure (not $ null have)
|
||||
, pure (not inhere)
|
||||
, wantGet True (Just k) af
|
||||
, wantGet lu True (Just k) af
|
||||
]
|
||||
handleget have inhere = ifM (wantget have inhere)
|
||||
( return [ get have ]
|
||||
, return []
|
||||
)
|
||||
get have = includeCommandAction $ starting "get" ai si $
|
||||
stopUnless (getKey' k af have) $
|
||||
handleget have inhere = do
|
||||
lu <- prepareLiveUpdate Nothing k AddingKey
|
||||
ifM (wantget lu have inhere)
|
||||
( return [ get lu have ]
|
||||
, return []
|
||||
)
|
||||
get lu have = includeCommandAction $ starting "get" ai si $
|
||||
stopUnless (getKey' lu k af have) $
|
||||
next $ return True
|
||||
|
||||
wantput r
|
||||
wantput lu r
|
||||
| pushOption o == False && operationMode o /= SatisfyMode = return False
|
||||
| Remote.readonly r || remoteAnnexReadOnly (Remote.gitconfig r) = return False
|
||||
| isImport r && not (isExport r) = return False
|
||||
| isExport r && not (exportHasAnnexObjects r) = return False
|
||||
| isThirdPartyPopulated r = return False
|
||||
| otherwise = wantGetBy True (Just k) af (Remote.uuid r)
|
||||
| otherwise = wantGetBy lu True (Just k) af (Remote.uuid r)
|
||||
handleput lack inhere
|
||||
| inhere = catMaybes <$>
|
||||
( forM lack $ \r ->
|
||||
ifM (wantput r <&&> put r)
|
||||
( forM lack $ \r -> do
|
||||
lu <- prepareLiveUpdate (Just (Remote.uuid r)) k AddingKey
|
||||
ifM (wantput lu r <&&> put lu r)
|
||||
( return (Just (Remote.uuid r))
|
||||
, return Nothing
|
||||
)
|
||||
)
|
||||
| otherwise = return []
|
||||
put dest = includeCommandAction $
|
||||
Command.Move.toStart' dest Command.Move.RemoveNever af k ai si
|
||||
put lu dest = includeCommandAction $
|
||||
Command.Move.toStart' lu dest Command.Move.RemoveNever af k ai si
|
||||
|
||||
ai = mkActionItem (k, af)
|
||||
si = SeekInput []
|
||||
|
|
Loading…
Add table
Reference in a new issue