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 :: LiveUpdate -> UUID -> Key -> LogStatus -> Annex ()
|
||||||
updateRepoSize lu u k s = do
|
updateRepoSize lu u k s = do
|
||||||
|
-- XXX call finishedLiveUpdate
|
||||||
rsv <- Annex.getRead Annex.reposizes
|
rsv <- Annex.getRead Annex.reposizes
|
||||||
liftIO (takeMVar rsv) >>= \case
|
liftIO (takeMVar rsv) >>= \case
|
||||||
Nothing -> liftIO (putMVar rsv Nothing)
|
Nothing -> liftIO (putMVar rsv Nothing)
|
||||||
|
@ -54,13 +55,6 @@ accumRepoSizes k (newlocs, removedlocs) sizemap =
|
||||||
let !sizemap' = foldl' (flip $ M.alter $ addKeyRepoSize k) sizemap newlocs
|
let !sizemap' = foldl' (flip $ M.alter $ addKeyRepoSize k) sizemap newlocs
|
||||||
in foldl' (flip $ M.alter $ removeKeyRepoSize k) sizemap' removedlocs
|
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.
|
-- When the UUID is Nothing, it's a live update of the local repository.
|
||||||
prepareLiveUpdate :: Maybe UUID -> Key -> SizeChange -> Annex LiveUpdate
|
prepareLiveUpdate :: Maybe UUID -> Key -> SizeChange -> Annex LiveUpdate
|
||||||
prepareLiveUpdate mu k sc = do
|
prepareLiveUpdate mu k sc = do
|
||||||
|
@ -79,7 +73,7 @@ prepareLiveUpdate mu k sc = do
|
||||||
waitdone donev h u
|
waitdone donev h u
|
||||||
Left _ -> noop
|
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
|
- get garbage collected in the case where the change didn't
|
||||||
- actually happen. -}
|
- actually happen. -}
|
||||||
waitdone donev h u = tryNonAsync (takeMVar donev) >>= \case
|
waitdone donev h u = tryNonAsync (takeMVar donev) >>= \case
|
||||||
|
@ -94,6 +88,13 @@ prepareLiveUpdate mu k sc = do
|
||||||
Left _ -> done h u
|
Left _ -> done h u
|
||||||
done h u = Db.finishedLiveSizeChange h u k sc
|
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 -> Bool -> UUID -> Key -> SizeChange -> IO ()
|
||||||
finishedLiveUpdate (LiveUpdate _startv donev) succeeded u k sc =
|
finishedLiveUpdate (LiveUpdate _startv donev) succeeded u k sc =
|
||||||
putMVar donev (succeeded, u, k, sc)
|
putMVar donev (succeeded, u, k, sc)
|
||||||
|
|
|
@ -125,7 +125,7 @@ fixupReq req@(Req {}) opts =
|
||||||
unlessM (inAnnex k) $
|
unlessM (inAnnex k) $
|
||||||
commandAction $
|
commandAction $
|
||||||
starting "get" ai si $
|
starting "get" ai si $
|
||||||
Command.Get.perform k af
|
Command.Get.perform NoLiveUpdate k af
|
||||||
repoint k
|
repoint k
|
||||||
where
|
where
|
||||||
ai = OnlyActionOn k (ActionItemKey k)
|
ai = OnlyActionOn k (ActionItemKey k)
|
||||||
|
|
|
@ -926,38 +926,41 @@ syncFile o ebloom rs af k = do
|
||||||
|
|
||||||
return (got || not (null putrs))
|
return (got || not (null putrs))
|
||||||
where
|
where
|
||||||
wantget have inhere = allM id
|
wantget lu have inhere = allM id
|
||||||
[ pure (pullOption o || operationMode o == SatisfyMode)
|
[ pure (pullOption o || operationMode o == SatisfyMode)
|
||||||
, pure (not $ null have)
|
, pure (not $ null have)
|
||||||
, pure (not inhere)
|
, pure (not inhere)
|
||||||
, wantGet True (Just k) af
|
, wantGet lu True (Just k) af
|
||||||
]
|
]
|
||||||
handleget have inhere = ifM (wantget have inhere)
|
handleget have inhere = do
|
||||||
( return [ get have ]
|
lu <- prepareLiveUpdate Nothing k AddingKey
|
||||||
, return []
|
ifM (wantget lu have inhere)
|
||||||
)
|
( return [ get lu have ]
|
||||||
get have = includeCommandAction $ starting "get" ai si $
|
, return []
|
||||||
stopUnless (getKey' k af have) $
|
)
|
||||||
|
get lu have = includeCommandAction $ starting "get" ai si $
|
||||||
|
stopUnless (getKey' lu k af have) $
|
||||||
next $ return True
|
next $ return True
|
||||||
|
|
||||||
wantput r
|
wantput lu r
|
||||||
| pushOption o == False && operationMode o /= SatisfyMode = return False
|
| pushOption o == False && operationMode o /= SatisfyMode = return False
|
||||||
| Remote.readonly r || remoteAnnexReadOnly (Remote.gitconfig r) = return False
|
| Remote.readonly r || remoteAnnexReadOnly (Remote.gitconfig r) = return False
|
||||||
| isImport r && not (isExport r) = return False
|
| isImport r && not (isExport r) = return False
|
||||||
| isExport r && not (exportHasAnnexObjects r) = return False
|
| isExport r && not (exportHasAnnexObjects r) = return False
|
||||||
| isThirdPartyPopulated 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
|
handleput lack inhere
|
||||||
| inhere = catMaybes <$>
|
| inhere = catMaybes <$>
|
||||||
( forM lack $ \r ->
|
( forM lack $ \r -> do
|
||||||
ifM (wantput r <&&> put r)
|
lu <- prepareLiveUpdate (Just (Remote.uuid r)) k AddingKey
|
||||||
|
ifM (wantput lu r <&&> put lu r)
|
||||||
( return (Just (Remote.uuid r))
|
( return (Just (Remote.uuid r))
|
||||||
, return Nothing
|
, return Nothing
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
| otherwise = return []
|
| otherwise = return []
|
||||||
put dest = includeCommandAction $
|
put lu dest = includeCommandAction $
|
||||||
Command.Move.toStart' dest Command.Move.RemoveNever af k ai si
|
Command.Move.toStart' lu dest Command.Move.RemoveNever af k ai si
|
||||||
|
|
||||||
ai = mkActionItem (k, af)
|
ai = mkActionItem (k, af)
|
||||||
si = SeekInput []
|
si = SeekInput []
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue