implement simple working copy based scan
Works.. could be more efficient.
This commit is contained in:
parent
2b7f9c8442
commit
b665ffe36f
1 changed files with 37 additions and 7 deletions
|
@ -12,8 +12,13 @@ import Assistant.ScanRemotes
|
||||||
import Assistant.TransferQueue
|
import Assistant.TransferQueue
|
||||||
import Assistant.ThreadedMonad
|
import Assistant.ThreadedMonad
|
||||||
import Logs.Transfer
|
import Logs.Transfer
|
||||||
|
import Logs.Location
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
|
import qualified Remote
|
||||||
import Utility.ThreadScheduler
|
import Utility.ThreadScheduler
|
||||||
|
import qualified Git.LsFiles as LsFiles
|
||||||
|
import Command
|
||||||
|
import Annex.Content
|
||||||
|
|
||||||
thisThread :: ThreadName
|
thisThread :: ThreadName
|
||||||
thisThread = "TransferScanner"
|
thisThread = "TransferScanner"
|
||||||
|
@ -28,14 +33,39 @@ transferScannerThread :: ThreadState -> ScanRemoteMap -> TransferQueue -> IO ()
|
||||||
transferScannerThread st scanremotes transferqueue = do
|
transferScannerThread st scanremotes transferqueue = do
|
||||||
runEvery (Seconds 2) $ do
|
runEvery (Seconds 2) $ do
|
||||||
r <- getScanRemote scanremotes
|
r <- getScanRemote scanremotes
|
||||||
needtransfer <- scan st r
|
liftIO $ debug thisThread ["starting scan of", show r]
|
||||||
|
needtransfer <- runThreadState st $ scan r
|
||||||
forM_ needtransfer $ \(f, t) ->
|
forM_ needtransfer $ \(f, t) ->
|
||||||
queueTransferAt smallsize Later transferqueue f t
|
queueTransferAt smallsize Later transferqueue f t r
|
||||||
|
liftIO $ debug thisThread ["finished scan of", show r]
|
||||||
where
|
where
|
||||||
smallsize = 10
|
smallsize = 10
|
||||||
|
|
||||||
{- -}
|
{- This is a naive scan through the git work tree. -}
|
||||||
scan :: ThreadState -> Remote -> IO [(AssociatedFile, Transfer)]
|
scan :: Remote -> Annex [(AssociatedFile, Transfer)]
|
||||||
scan st r = do
|
scan r = do
|
||||||
debug thisThread ["scanning", show r]
|
files <- inRepo $ LsFiles.inRepo []
|
||||||
return [] -- TODO
|
catMaybes <$> forM files (whenAnnexed go)
|
||||||
|
where
|
||||||
|
u = Remote.uuid r
|
||||||
|
|
||||||
|
go file (key, _) =
|
||||||
|
ifM (inAnnex key)
|
||||||
|
( check Upload False =<< remotehas key
|
||||||
|
, check Download True =<< remotehas key
|
||||||
|
)
|
||||||
|
where
|
||||||
|
check direction x y
|
||||||
|
| x == y = return $
|
||||||
|
Just (Just file, Transfer direction u key)
|
||||||
|
| otherwise = return Nothing
|
||||||
|
|
||||||
|
{- Look directly in remote for the key when it's cheap;
|
||||||
|
- otherwise rely on the location log. -}
|
||||||
|
remotehas key
|
||||||
|
| Remote.hasKeyCheap r = (==)
|
||||||
|
<$> pure (Right True)
|
||||||
|
<*> Remote.hasKey r key
|
||||||
|
| otherwise = elem
|
||||||
|
<$> pure u
|
||||||
|
<*> loggedLocations key
|
||||||
|
|
Loading…
Add table
Reference in a new issue