implement simple working copy based scan

Works.. could be more efficient.
This commit is contained in:
Joey Hess 2012-07-25 14:15:09 -04:00
parent 2b7f9c8442
commit b665ffe36f

View file

@ -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