use queue when upgrading, flushing every so often
Added a cheap way to query the size of a queue. runQueueAt is not the default yet only because there may be some code that expects to be able to queue some suff, do something else, and run the whole queue at the end. 10240 is an arbitrary size for the queue. If we assume annexed filenames are between 10 and 255 characters long, then the queue will build up between 100kb and 2550kb long commands. The max command line length on linux is somewhere above 20k, so this is a fairly good balance -- the queue will buffer only a few megabytes of stuff and a minimal number of commands will be run by xargs. Also, insert queue items strictly, this should save memory.
This commit is contained in:
parent
0f8edc99ee
commit
bc21502b9a
4 changed files with 34 additions and 18 deletions
8
Annex.hs
8
Annex.hs
|
@ -16,6 +16,7 @@ module Annex (
|
|||
gitRepo,
|
||||
queue,
|
||||
queueRun,
|
||||
queueRunAt,
|
||||
setConfig,
|
||||
repoConfig
|
||||
) where
|
||||
|
@ -109,6 +110,13 @@ queueRun = do
|
|||
liftIO $ GitQueue.run g q
|
||||
put state { repoqueue = GitQueue.empty }
|
||||
|
||||
{- Runs the queue if the specified number of items have been queued. -}
|
||||
queueRunAt :: Integer -> Annex ()
|
||||
queueRunAt n = do
|
||||
state <- get
|
||||
let q = repoqueue state
|
||||
when (GitQueue.size q >= n) queueRun
|
||||
|
||||
{- Changes a git config setting in both internal state and .git/config -}
|
||||
setConfig :: String -> String -> Annex ()
|
||||
setConfig k value = do
|
||||
|
|
|
@ -99,7 +99,7 @@ startup = do
|
|||
shutdown :: Annex Bool
|
||||
shutdown = do
|
||||
q <- Annex.getState Annex.repoqueue
|
||||
unless (q == GitQueue.empty) $ do
|
||||
unless (0 == GitQueue.size q) $ do
|
||||
showSideAction "Recording state in git..."
|
||||
Annex.queueRun
|
||||
|
||||
|
|
17
GitQueue.hs
17
GitQueue.hs
|
@ -9,6 +9,7 @@ module GitQueue (
|
|||
Queue,
|
||||
empty,
|
||||
add,
|
||||
size,
|
||||
run
|
||||
) where
|
||||
|
||||
|
@ -31,22 +32,28 @@ data Action = Action {
|
|||
{- A queue of actions to perform (in any order) on a git repository,
|
||||
- with lists of files to perform them on. This allows coalescing
|
||||
- similar git commands. -}
|
||||
type Queue = M.Map Action [FilePath]
|
||||
data Queue = Queue Integer (M.Map Action [FilePath])
|
||||
deriving (Show, Eq)
|
||||
|
||||
{- Constructor for empty queue. -}
|
||||
empty :: Queue
|
||||
empty = M.empty
|
||||
empty = Queue 0 M.empty
|
||||
|
||||
{- Adds an action to a queue. -}
|
||||
add :: Queue -> String -> [CommandParam] -> FilePath -> Queue
|
||||
add queue subcommand params file = M.insertWith (++) action [file] queue
|
||||
add (Queue n m) subcommand params file = Queue (n + 1) m'
|
||||
where
|
||||
action = Action subcommand params
|
||||
m' = M.insertWith' (++) action [file] m
|
||||
|
||||
{- Number of items in a queue. -}
|
||||
size :: Queue -> Integer
|
||||
size (Queue n _) = n
|
||||
|
||||
{- Runs a queue on a git repository. -}
|
||||
run :: Git.Repo -> Queue -> IO ()
|
||||
run repo queue = do
|
||||
forM_ (M.toList queue) $ uncurry $ runAction repo
|
||||
run repo (Queue _ m) = do
|
||||
forM_ (M.toList m) $ uncurry $ runAction repo
|
||||
return ()
|
||||
|
||||
{- Runs an Action on a list of files in a git repository.
|
||||
|
|
|
@ -66,9 +66,10 @@ upgrade = do
|
|||
updateSymlinks
|
||||
moveLocationLogs
|
||||
|
||||
Annex.queueRun
|
||||
|
||||
-- add new line to auto-merge hashed location logs
|
||||
-- this commits, so has to come after the upgrade
|
||||
g <- Annex.gitRepo
|
||||
liftIO $ Command.Init.gitAttributesWrite g
|
||||
|
||||
setVersion
|
||||
|
@ -92,18 +93,18 @@ updateSymlinks :: Annex ()
|
|||
updateSymlinks = do
|
||||
g <- Annex.gitRepo
|
||||
files <- liftIO $ Git.inRepo g [Git.workTree g]
|
||||
forM_ files $ (fixlink g)
|
||||
forM_ files $ fixlink
|
||||
where
|
||||
fixlink g f = do
|
||||
fixlink f = do
|
||||
r <- lookupFile1 f
|
||||
case r of
|
||||
Nothing -> return ()
|
||||
Just (k, _) -> do
|
||||
link <- calcGitLink f k
|
||||
liftIO $ do
|
||||
removeFile f
|
||||
createSymbolicLink link f
|
||||
Git.run g "add" [Param "--", File f]
|
||||
liftIO $ removeFile f
|
||||
liftIO $ createSymbolicLink link f
|
||||
Annex.queue "add" [Param "--"] f
|
||||
Annex.queueRunAt 1024
|
||||
|
||||
moveLocationLogs :: Annex ()
|
||||
moveLocationLogs = do
|
||||
|
@ -127,11 +128,11 @@ moveLocationLogs = do
|
|||
-- logs that have been pulled from elsewhere
|
||||
old <- liftIO $ readLog f
|
||||
new <- liftIO $ readLog dest
|
||||
liftIO $ do
|
||||
writeLog dest (old++new)
|
||||
Git.run g "add" [Param "--", File dest]
|
||||
Git.run g "add" [Param "--", File f]
|
||||
Git.run g "rm" [Param "--quiet", Param "-f", Param "--", File f]
|
||||
liftIO $ writeLog dest (old++new)
|
||||
Annex.queue "add" [Param "--"] dest
|
||||
Annex.queue "add" [Param "--"] f
|
||||
Annex.queue "rm" [Param "--quiet", Param "-f", Param "--"] f
|
||||
Annex.queueRunAt 1024
|
||||
|
||||
oldlog2key :: FilePath -> Maybe (FilePath, Key)
|
||||
oldlog2key l =
|
||||
|
|
Loading…
Reference in a new issue