summaryrefslogtreecommitdiff
path: root/Assistant/Threads/TransferScanner.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-18 15:22:28 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-18 15:22:28 -0400
commit3e369ace228e984224c417c6f3524f0b4f5900ac (patch)
tree01811ab6f0a1d49bd83a66ddbe556c0406fa81e8 /Assistant/Threads/TransferScanner.hs
parentb9138b54db85610ce16d31ef1d1e74c18ee25b87 (diff)
split
Diffstat (limited to 'Assistant/Threads/TransferScanner.hs')
-rw-r--r--Assistant/Threads/TransferScanner.hs44
1 files changed, 2 insertions, 42 deletions
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 6606bdc35..5eb3784bd 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -13,19 +13,17 @@ import Assistant.TransferQueue
import Assistant.ThreadedMonad
import Assistant.DaemonStatus
import Assistant.Alert
+import Assistant.Drop
import Logs.Transfer
import Logs.Location
-import Logs.Trust
import Logs.Web (webUUID)
import qualified Remote
import qualified Types.Remote as Remote
import Utility.ThreadScheduler
import qualified Git.LsFiles as LsFiles
-import qualified Command.Drop
import Command
import Annex.Content
import Annex.Wanted
-import Config
import qualified Data.Set as S
@@ -127,7 +125,7 @@ expensiveScan st dstatus transferqueue rs = unless onlyweb $ do
syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
present <- inAnnex key
- handleDrops locs syncrs present f key
+ handleDrops' locs syncrs present f key
let slocs = S.fromList locs
let use a = return $ catMaybes $ map (a key slocs) syncrs
@@ -144,44 +142,6 @@ genTransfer direction want key slocs r
(r, Transfer direction (Remote.uuid r) key)
| otherwise = Nothing
-{- Drop from local or remote when allowed by the preferred content and
- - numcopies settings. -}
-handleDrops :: [UUID] -> [Remote] -> Bool -> FilePath -> Key -> Annex ()
-handleDrops locs rs present f key
- | present = do
- n <- getcopies
- if checkcopies n
- then go rs =<< dropl n
- else go rs n
- | otherwise = go rs =<< getcopies
- where
- getcopies = do
- have <- length . snd <$> trustPartition UnTrusted locs
- numcopies <- getNumCopies =<< numCopies f
- return (have, numcopies)
- checkcopies (have, numcopies) = have > numcopies
- decrcopies (have, numcopies) = (have - 1, numcopies)
-
- go [] _ = noop
- go (r:rest) n
- | checkcopies n = dropr r n >>= go rest
- | otherwise = noop
-
- checkdrop n@(_, numcopies) u a =
- ifM (wantDrop u (Just f))
- ( ifM (doCommand $ a (Just numcopies))
- ( return $ decrcopies n
- , return n
- )
- , return n
- )
-
- dropl n = checkdrop n Nothing $ \numcopies ->
- Command.Drop.startLocal f numcopies key
-
- dropr r n = checkdrop n (Just $ Remote.uuid r) $ \numcopies ->
- Command.Drop.startRemote f numcopies key r
-
remoteHas :: Remote -> Key -> Annex Bool
remoteHas r key = elem
<$> pure (Remote.uuid r)