diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-26 15:59:50 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-26 15:59:50 -0400 |
commit | ef26076a5a3df9b8740883e3f7b3b68585b47ad5 (patch) | |
tree | 4866077b46f25ba1446ddebf7d5b151fc98fd8ac /GitQueue.hs | |
parent | 4cda7b6e7c2f08c99b0c4c14bb86e691903a985b (diff) |
add git queue to Annex monad
not used anywhere just yet..
Diffstat (limited to 'GitQueue.hs')
-rw-r--r-- | GitQueue.hs | 64 |
1 files changed, 64 insertions, 0 deletions
diff --git a/GitQueue.hs b/GitQueue.hs new file mode 100644 index 000000000..b7210ccb5 --- /dev/null +++ b/GitQueue.hs @@ -0,0 +1,64 @@ +{- git repository command queues + -} + +module GitQueue ( + Queue, + empty, + add, + run +) where + +import qualified Data.Map as M + +import qualified GitRepo as 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 { + subcommand :: String, + params :: [String] + } 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. -} +type Queue = M.Map Action [FilePath] + +{- Constructor for empty queue. -} +empty :: Queue +empty = M.empty + +{- Adds an action to a queue. -} +add :: Queue -> String -> [String] -> FilePath -> Queue +add queue subcommand params file = M.insertWith (++) action [file] queue + where + action = Action subcommand params + +{- Runs a queue on a git repository. -} +run :: Git.Repo -> Queue -> IO () +run repo queue = do + mapM (\(k, v) -> runAction repo k v) $ M.toList queue + return () + +{- 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 = do + xargs [] 0 files + where + arg_max = 2048 -- TODO get better ARG_MAX + maxlen = arg_max - cmdlen + c = (subcommand action):(params action) + cmdlen = (length "git") + + (foldl (\a b -> a + b + 1) 1 $ map length c) + xargs collect _ [] = exec collect + xargs collect len (f:fs) = do + let len' = len + 1 + length f + if (len' >= maxlen) + then do + exec collect + xargs [f] (length f) fs + else xargs (f:collect) len' fs + exec [] = return () + exec fs = Git.run repo $ c ++ fs |