9aab70de66
Makes it safe to use git annex unlock with the watcher/assistant. And also to mix use of the watcher/assistant with regular files stored in git. Long ago, I had avoided doing this check, except during the startup scan, because it would be slow to run ls-files repeatedly. But then I added the lsof check, and to make that fast, got it to detect batch file adds. So let's move the ls-files check to also occur when it'll have a batch, and can check them all with one call. This does slow down adding a single file by just a bit, but really only a little bit. (The lsof check is probably more expensive.) It also speeds up the startup scan, especially when there are lots of new files found by the scan. Also, fixed the sleep for annex.delayadd to not run while the threadstate lock is held, so it doesn't unnecessarily freeze everything else. Also, --force no longer makes it skip the lsof check, which was not documented, and seems never a good idea.
84 lines
2.2 KiB
Haskell
84 lines
2.2 KiB
Haskell
{- git-annex assistant change tracking
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Assistant.Changes where
|
|
|
|
import Common.Annex
|
|
import qualified Annex.Queue
|
|
import Types.KeySource
|
|
import Utility.TSet
|
|
|
|
import Data.Time.Clock
|
|
|
|
data ChangeType = AddChange | LinkChange | RmChange | RmDirChange
|
|
deriving (Show, Eq)
|
|
|
|
type ChangeChan = TSet Change
|
|
|
|
data Change
|
|
= Change
|
|
{ changeTime :: UTCTime
|
|
, changeFile :: FilePath
|
|
, changeType :: ChangeType
|
|
}
|
|
| PendingAddChange
|
|
{ changeTime ::UTCTime
|
|
, changeFile :: FilePath
|
|
}
|
|
| InProcessAddChange
|
|
{ changeTime ::UTCTime
|
|
, keySource :: KeySource
|
|
}
|
|
deriving (Show)
|
|
|
|
newChangeChan :: IO ChangeChan
|
|
newChangeChan = newTSet
|
|
|
|
{- Handlers call this when they made a change that needs to get committed. -}
|
|
madeChange :: FilePath -> ChangeType -> Annex (Maybe Change)
|
|
madeChange f t = do
|
|
-- Just in case the commit thread is not flushing the queue fast enough.
|
|
Annex.Queue.flushWhenFull
|
|
liftIO $ Just <$> (Change <$> getCurrentTime <*> pure f <*> pure t)
|
|
|
|
noChange :: Annex (Maybe Change)
|
|
noChange = return Nothing
|
|
|
|
{- Indicates an add needs to be done, but has not started yet. -}
|
|
pendingAddChange :: FilePath -> Annex (Maybe Change)
|
|
pendingAddChange f =
|
|
liftIO $ Just <$> (PendingAddChange <$> getCurrentTime <*> pure f)
|
|
|
|
isPendingAddChange :: Change -> Bool
|
|
isPendingAddChange (PendingAddChange {}) = True
|
|
isPendingAddChange _ = False
|
|
|
|
isInProcessAddChange :: Change -> Bool
|
|
isInProcessAddChange (InProcessAddChange {}) = True
|
|
isInProcessAddChange _ = False
|
|
|
|
finishedChange :: Change -> Change
|
|
finishedChange c@(InProcessAddChange { keySource = ks }) = Change
|
|
{ changeTime = changeTime c
|
|
, changeFile = keyFilename ks
|
|
, changeType = AddChange
|
|
}
|
|
finishedChange c = c
|
|
|
|
{- Gets all unhandled changes.
|
|
- Blocks until at least one change is made. -}
|
|
getChanges :: ChangeChan -> IO [Change]
|
|
getChanges = getTSet
|
|
|
|
{- Puts unhandled changes back into the channel.
|
|
- Note: Original order is not preserved. -}
|
|
refillChanges :: ChangeChan -> [Change] -> IO ()
|
|
refillChanges = putTSet
|
|
|
|
{- Records a change in the channel. -}
|
|
recordChange :: ChangeChan -> Change -> IO ()
|
|
recordChange = putTSet1
|