2011-04-07 17:59:31 +00:00
|
|
|
{- git-annex command queue
|
|
|
|
-
|
2012-06-07 19:40:44 +00:00
|
|
|
- Copyright 2011, 2012 Joey Hess <joey@kitenet.net>
|
2011-04-07 17:59:31 +00:00
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
2011-10-04 04:40:47 +00:00
|
|
|
module Annex.Queue (
|
2012-06-07 19:19:44 +00:00
|
|
|
addCommand,
|
2012-06-07 19:40:44 +00:00
|
|
|
addUpdateIndex,
|
2011-04-07 17:59:31 +00:00
|
|
|
flush,
|
2012-06-10 17:56:04 +00:00
|
|
|
flushWhenFull,
|
|
|
|
size
|
2011-04-07 17:59:31 +00:00
|
|
|
) where
|
|
|
|
|
2011-10-05 20:02:51 +00:00
|
|
|
import Common.Annex
|
2012-02-15 15:13:13 +00:00
|
|
|
import Annex hiding (new)
|
2011-06-30 17:25:37 +00:00
|
|
|
import qualified Git.Queue
|
2012-06-07 19:40:44 +00:00
|
|
|
import qualified Git.UpdateIndex
|
2011-04-07 17:59:31 +00:00
|
|
|
|
2011-08-21 16:59:49 +00:00
|
|
|
{- Adds a git command to the queue. -}
|
2012-06-07 19:19:44 +00:00
|
|
|
addCommand :: String -> [CommandParam] -> [FilePath] -> Annex ()
|
|
|
|
addCommand command params files = do
|
2012-02-15 15:13:13 +00:00
|
|
|
q <- get
|
2012-06-14 04:01:48 +00:00
|
|
|
store <=< inRepo $ Git.Queue.addCommand command params files q
|
2011-04-07 17:59:31 +00:00
|
|
|
|
2012-06-07 19:40:44 +00:00
|
|
|
{- Adds an update-index stream to the queue. -}
|
|
|
|
addUpdateIndex :: Git.UpdateIndex.Streamer -> Annex ()
|
|
|
|
addUpdateIndex streamer = do
|
|
|
|
q <- get
|
2012-06-14 04:01:48 +00:00
|
|
|
store <=< inRepo $ Git.Queue.addUpdateIndex streamer q
|
2012-06-07 19:40:44 +00:00
|
|
|
|
2011-04-07 17:59:31 +00:00
|
|
|
{- Runs the queue if it is full. Should be called periodically. -}
|
|
|
|
flushWhenFull :: Annex ()
|
|
|
|
flushWhenFull = do
|
2012-02-15 15:13:13 +00:00
|
|
|
q <- get
|
2012-04-27 17:23:52 +00:00
|
|
|
when (Git.Queue.full q) flush
|
2011-04-07 17:59:31 +00:00
|
|
|
|
|
|
|
{- Runs (and empties) the queue. -}
|
2012-04-27 17:23:52 +00:00
|
|
|
flush :: Annex ()
|
|
|
|
flush = do
|
2012-02-15 15:13:13 +00:00
|
|
|
q <- get
|
2011-06-30 17:25:37 +00:00
|
|
|
unless (0 == Git.Queue.size q) $ do
|
2012-04-27 17:23:52 +00:00
|
|
|
showStoringStateAction
|
2011-11-08 19:34:10 +00:00
|
|
|
q' <- inRepo $ Git.Queue.flush q
|
2011-04-07 17:59:31 +00:00
|
|
|
store q'
|
|
|
|
|
2012-06-10 17:56:04 +00:00
|
|
|
{- Gets the size of the queue. -}
|
|
|
|
size :: Annex Int
|
|
|
|
size = Git.Queue.size <$> get
|
|
|
|
|
2012-02-15 15:13:13 +00:00
|
|
|
get :: Annex Git.Queue.Queue
|
|
|
|
get = maybe new return =<< getState repoqueue
|
|
|
|
|
|
|
|
new :: Annex Git.Queue.Queue
|
|
|
|
new = do
|
2013-01-01 17:52:47 +00:00
|
|
|
q <- Git.Queue.new . annexQueueSize <$> getGitConfig
|
2012-02-15 15:13:13 +00:00
|
|
|
store q
|
|
|
|
return q
|
|
|
|
|
2011-06-30 17:25:37 +00:00
|
|
|
store :: Git.Queue.Queue -> Annex ()
|
2012-02-15 15:13:13 +00:00
|
|
|
store q = changeState $ \s -> s { repoqueue = Just q }
|