From f0497312a77d59f24c8273245ac324b02bb1eb13 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 30 Jun 2011 13:25:37 -0400 Subject: rename GitQueue to Git.Queue --- Annex.hs | 2 +- AnnexQueue.hs | 12 ++++---- Git/Queue.hs | 89 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ GitQueue.hs | 89 ----------------------------------------------------------- 4 files changed, 96 insertions(+), 96 deletions(-) create mode 100644 Git/Queue.hs delete mode 100644 GitQueue.hs diff --git a/Annex.hs b/Annex.hs index e2f4a1020..c21cfb37c 100644 --- a/Annex.hs +++ b/Annex.hs @@ -19,7 +19,7 @@ module Annex ( import Control.Monad.State import qualified Git -import GitQueue +import Git.Queue import Types.Backend import Types.Remote import Types.Crypto diff --git a/AnnexQueue.hs b/AnnexQueue.hs index 58e77a6e8..4c35adfb8 100644 --- a/AnnexQueue.hs +++ b/AnnexQueue.hs @@ -16,7 +16,7 @@ import Control.Monad (when, unless) import Annex import Messages -import qualified GitQueue +import qualified Git.Queue import Utility {- Adds a git command to the queue, possibly running previously queued @@ -24,24 +24,24 @@ import Utility add :: String -> [CommandParam] -> FilePath -> Annex () add command params file = do q <- getState repoqueue - store $ GitQueue.add q command params file + store $ Git.Queue.add q command params file {- Runs the queue if it is full. Should be called periodically. -} flushWhenFull :: Annex () flushWhenFull = do q <- getState repoqueue - when (GitQueue.full q) $ flush False + when (Git.Queue.full q) $ flush False {- Runs (and empties) the queue. -} flush :: Bool -> Annex () flush silent = do q <- getState repoqueue - unless (0 == GitQueue.size q) $ do + unless (0 == Git.Queue.size q) $ do unless silent $ showSideAction "Recording state in git..." g <- gitRepo - q' <- liftIO $ GitQueue.flush g q + q' <- liftIO $ Git.Queue.flush g q store q' -store :: GitQueue.Queue -> Annex () +store :: Git.Queue.Queue -> Annex () store q = changeState $ \s -> s { repoqueue = q } diff --git a/Git/Queue.hs b/Git/Queue.hs new file mode 100644 index 000000000..e1ec0cd31 --- /dev/null +++ b/Git/Queue.hs @@ -0,0 +1,89 @@ +{- git repository command queue + - + - Copyright 2010 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Git.Queue ( + Queue, + empty, + add, + size, + full, + flush +) where + +import qualified Data.Map as M +import System.IO +import System.Cmd.Utils +import Data.String.Utils +import Control.Monad (unless, forM_) +import Utility + +import Git + +{- An action to perform in a git repository. The file to act on + - is not included, and must be able to be appended after the params. -} +data Action = Action { + getSubcommand :: String, + getParams :: [CommandParam] + } deriving (Show, Eq, Ord) + +{- 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. -} +data Queue = Queue Int (M.Map Action [FilePath]) + deriving (Show, Eq) + +{- A recommended maximum size for the queue, after which it should be + - run. + - + - 10240 is semi-arbitrary. If we assume git 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. -} +maxSize :: Int +maxSize = 10240 + +{- Constructor for empty queue. -} +empty :: Queue +empty = Queue 0 M.empty + +{- Adds an action to a queue. -} +add :: Queue -> String -> [CommandParam] -> FilePath -> Queue +add (Queue n m) subcommand params file = Queue (n + 1) m' + where + action = Action subcommand params + -- There are probably few items in the map, but there + -- can be a lot of files per item. So, optimise adding + -- files. + m' = M.insertWith' const action files m + files = file:(M.findWithDefault [] action m) + +{- Number of items in a queue. -} +size :: Queue -> Int +size (Queue n _) = n + +{- Is a queue large enough that it should be flushed? -} +full :: Queue -> Bool +full (Queue n _) = n > maxSize + +{- Runs a queue on a git repository. -} +flush :: Repo -> Queue -> IO Queue +flush repo (Queue _ m) = do + forM_ (M.toList m) $ uncurry $ runAction repo + return empty + +{- Runs an Action on a list of files in a git repository. + - + - Complicated by commandline length limits. -} +runAction :: Repo -> Action -> [FilePath] -> IO () +runAction repo action files = unless (null files) runxargs + where + runxargs = pOpen WriteToPipe "xargs" ("-0":"git":params) feedxargs + params = toCommand $ gitCommandLine repo + (Param (getSubcommand action):getParams action) + feedxargs h = hPutStr h $ join "\0" files diff --git a/GitQueue.hs b/GitQueue.hs deleted file mode 100644 index 5da3ba1d6..000000000 --- a/GitQueue.hs +++ /dev/null @@ -1,89 +0,0 @@ -{- git repository command queue - - - - Copyright 2010 Joey Hess - - - - Licensed under the GNU GPL version 3 or higher. - -} - -module GitQueue ( - Queue, - empty, - add, - size, - full, - flush -) where - -import qualified Data.Map as M -import System.IO -import System.Cmd.Utils -import Data.String.Utils -import Control.Monad (unless, forM_) -import Utility - -import qualified Git - -{- An action to perform in a git repository. The file to act on - - is not included, and must be able to be appended after the params. -} -data Action = Action { - getSubcommand :: String, - getParams :: [CommandParam] - } deriving (Show, Eq, Ord) - -{- 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. -} -data Queue = Queue Int (M.Map Action [FilePath]) - deriving (Show, Eq) - -{- A recommended maximum size for the queue, after which it should be - - run. - - - - 10240 is semi-arbitrary. If we assume git 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. -} -maxSize :: Int -maxSize = 10240 - -{- Constructor for empty queue. -} -empty :: Queue -empty = Queue 0 M.empty - -{- Adds an action to a queue. -} -add :: Queue -> String -> [CommandParam] -> FilePath -> Queue -add (Queue n m) subcommand params file = Queue (n + 1) m' - where - action = Action subcommand params - -- There are probably few items in the map, but there - -- can be a lot of files per item. So, optimise adding - -- files. - m' = M.insertWith' const action files m - files = file:(M.findWithDefault [] action m) - -{- Number of items in a queue. -} -size :: Queue -> Int -size (Queue n _) = n - -{- Is a queue large enough that it should be flushed? -} -full :: Queue -> Bool -full (Queue n _) = n > maxSize - -{- Runs a queue on a git repository. -} -flush :: Git.Repo -> Queue -> IO Queue -flush repo (Queue _ m) = do - forM_ (M.toList m) $ uncurry $ runAction repo - return empty - -{- Runs an Action on a list of files in a git repository. - - - - Complicated by commandline length limits. -} -runAction :: Git.Repo -> Action -> [FilePath] -> IO () -runAction repo action files = unless (null files) runxargs - where - runxargs = pOpen WriteToPipe "xargs" ("-0":"git":params) feedxargs - params = toCommand $ Git.gitCommandLine repo - (Param (getSubcommand action):getParams action) - feedxargs h = hPutStr h $ join "\0" files -- cgit v1.2.3