From 0a11b35d89104fa0b9653f15963d273a0d3585c3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 7 Jun 2012 15:19:44 -0400 Subject: extend Git.Queue to be able to queue more than simple git commands While I was in there, I noticed and fixed a bug in the queue size calculations. It was never encountered only because Queue.add was only ever run with 1 file in the list. --- Git/Queue.hs | 111 +++++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 81 insertions(+), 30 deletions(-) (limited to 'Git') diff --git a/Git/Queue.hs b/Git/Queue.hs index 956e9adb1..5870bf866 100644 --- a/Git/Queue.hs +++ b/Git/Queue.hs @@ -10,7 +10,8 @@ module Git.Queue ( Queue, new, - add, + addCommand, + addUpdateIndex, size, full, flush, @@ -25,19 +26,31 @@ import Utility.SafeCommand import Common import Git import Git.Command +import qualified Git.UpdateIndex + +{- Queable actions that can be performed in a git repository. + -} +data Action + {- Updating the index file, using a list of streamers that can + - be added to as the queue grows. -} + = UpdateIndexAction + { getStreamers :: [Git.UpdateIndex.Streamer] + } + {- A git command to run, on a list of files that can be added to + - as the queue grows. -} + | CommandAction + { getSubcommand :: String + , getParams :: [CommandParam] + , getFiles :: [FilePath] + } -{- 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 key that can uniquely represent an action in a Map. -} +data ActionKey = UpdateIndexActionKey | CommandActionKey String + deriving (Eq, Ord) -{- Compares two actions by subcommand. -} -(===) :: Action -> Action -> Bool -a === b = getSubcommand a == getSubcommand b -(/==) :: Action -> Action -> Bool -a /== b = not $ a === b +actionKey :: Action -> ActionKey +actionKey (UpdateIndexAction _) = UpdateIndexActionKey +actionKey CommandAction { getSubcommand = s } = CommandActionKey s {- A queue of actions to perform (in any order) on a git repository, - with lists of files to perform them on. This allows coalescing @@ -45,9 +58,8 @@ a /== b = not $ a === b data Queue = Queue { size :: Int , _limit :: Int - , _items :: M.Map Action [FilePath] + , items :: M.Map ActionKey Action } - deriving (Show, Eq) {- A recommended maximum size for the queue, after which it should be - run. @@ -65,20 +77,58 @@ defaultLimit = 10240 new :: Maybe Int -> Queue new lim = Queue 0 (fromMaybe defaultLimit lim) M.empty -{- Adds an action to a queue. If the queue already contains a different +{- Adds a command to a queue. If the queue already contains a different - action, it will be flushed; this is to ensure that conflicting actions, - - like add and rm, are run in the right order. -} -add :: Queue -> String -> [CommandParam] -> [FilePath] -> Repo -> IO Queue -add q@(Queue _ _ m) subcommand params files repo - | null (filter (/== action) (M.keys m)) = go q - | otherwise = go =<< flush q repo + - like add and rm, are run in the right order. + - + - Actions with the same subcommand but different parameters are + - roughly equivilant; assumed equivilant enough to perform in any order + - with the same result. + -} +addCommand :: String -> [CommandParam] -> [FilePath] -> Queue -> Repo -> IO Queue +addCommand subcommand params files q repo = + updateQueue action different (length newfiles) q repo + where + key = actionKey action + action = CommandAction + { getSubcommand = subcommand + , getParams = params + , getFiles = newfiles + } + newfiles = files ++ maybe [] getFiles (M.lookup key $ items q) + + different (CommandAction { getSubcommand = s }) = s /= subcommand + different _ = True + +addUpdateIndex :: Git.UpdateIndex.Streamer -> Queue -> Repo -> IO Queue +addUpdateIndex streamer q repo = + updateQueue action different 0 q repo + where + key = actionKey action + -- streamer is added to the end of the list, since + -- order does matter for update-index input + action = UpdateIndexAction $ streamers ++ [streamer] + streamers = maybe [] getStreamers $ M.lookup key $ items q + + different (UpdateIndexAction _) = False + different _ = True + +{- Updates or adds an action in the queue. If the queue already contains a + - different action, it will be flushed; this is to ensure that conflicting + - actions, like add and rm, are run in the right order.-} +updateQueue :: Action -> (Action -> Bool) -> Int -> Queue -> Repo -> IO Queue +updateQueue action different sizeincrease q repo + | null (filter different (M.elems (items q))) = return $ go q + | otherwise = go <$> flush q repo where - action = Action subcommand params - go (Queue cur lim m') = - return $ Queue (cur + 1) lim $ - M.insertWith' const action fs m' - where - !fs = files ++ M.findWithDefault [] action m' + go q' = newq + where + !newq = q' + { size = newsize + , items = newitems + } + !newsize = size q' + sizeincrease + !newitems = M.insertWith' const (actionKey action) action (items q') {- Is a queue large enough that it should be flushed? -} full :: Queue -> Bool @@ -87,7 +137,7 @@ full (Queue cur lim _) = cur > lim {- Runs a queue on a git repository. -} flush :: Queue -> Repo -> IO Queue flush (Queue _ lim m) repo = do - forM_ (M.toList m) $ uncurry $ runAction repo + forM_ (M.elems m) $ runAction repo return $ Queue 0 lim M.empty {- Runs an Action on a list of files in a git repository. @@ -96,12 +146,13 @@ flush (Queue _ lim m) repo = do - - Intentionally runs the command even if the list of files is empty; - this allows queueing commands that do not need a list of files. -} -runAction :: Repo -> Action -> [FilePath] -> IO () -runAction repo action files = +runAction :: Repo -> Action -> IO () +runAction _repo _action@(UpdateIndexAction {}) = error "TODO" +runAction repo action@(CommandAction {}) = pOpen WriteToPipe "xargs" ("-0":"git":params) feedxargs where params = toCommand $ gitCommandLine (Param (getSubcommand action):getParams action) repo feedxargs h = do fileEncoding h - hPutStr h $ join "\0" files + hPutStr h $ join "\0" $ getFiles action -- cgit v1.2.3