Git.Queue: allow providing git common options like -c

This commit is contained in:
Joey Hess 2021-01-04 12:51:55 -04:00
parent 36f691e7e5
commit 1c5fc8f047
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
9 changed files with 41 additions and 27 deletions

View file

@ -147,7 +147,7 @@ resolveMerge us them inoverlay = do
unless inoverlay $ do unless inoverlay $ do
(deleted, cleanup2) <- inRepo (LsFiles.deleted [] [top]) (deleted, cleanup2) <- inRepo (LsFiles.deleted [] [top])
unless (null deleted) $ unless (null deleted) $
Annex.Queue.addCommand "rm" Annex.Queue.addCommand [] "rm"
[Param "--quiet", Param "-f", Param "--"] [Param "--quiet", Param "-f", Param "--"]
(map fromRawFilePath deleted) (map fromRawFilePath deleted)
void $ liftIO cleanup2 void $ liftIO cleanup2
@ -288,8 +288,13 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
resolveby ks a = do resolveby ks a = do
{- Remove conflicted file from index so merge can be resolved. -} {- Remove conflicted file from index so merge can be resolved. -}
Annex.Queue.addCommand "rm" Annex.Queue.addCommand [] "rm"
[Param "--quiet", Param "-f", Param "--cached", Param "--"] [file] [ Param "--quiet"
, Param "-f"
, Param "--cached"
, Param "--"
]
[file]
void a void a
return (ks, Just file) return (ks, Just file)

View file

@ -308,7 +308,8 @@ addLink ci file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig)
( do ( do
_ <- makeLink file key mcache _ <- makeLink file key mcache
ps <- gitAddParams ci ps <- gitAddParams ci
Annex.Queue.addCommand "add" (ps++[Param "--"]) [fromRawFilePath file] Annex.Queue.addCommand [] "add" (ps++[Param "--"])
[fromRawFilePath file]
, do , do
l <- makeLink file key mcache l <- makeLink file key mcache
addAnnexLink l file addAnnexLink l file

View file

@ -1,6 +1,6 @@
{- git-annex command queue {- git-annex command queue
- -
- Copyright 2011, 2012, 2019 Joey Hess <id@joeyh.name> - Copyright 2011-2021 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -25,11 +25,11 @@ import qualified Git.Queue
import qualified Git.UpdateIndex import qualified Git.UpdateIndex
{- Adds a git command to the queue. -} {- Adds a git command to the queue. -}
addCommand :: String -> [CommandParam] -> [FilePath] -> Annex () addCommand :: [CommandParam] -> String -> [CommandParam] -> [FilePath] -> Annex ()
addCommand command params files = do addCommand commonparams command params files = do
q <- get q <- get
store =<< flushWhenFull =<< store =<< flushWhenFull =<<
(Git.Queue.addCommand command params files q =<< gitRepo) (Git.Queue.addCommand commonparams command params files q =<< gitRepo)
addInternalAction :: Git.Queue.InternalActionRunner Annex -> [(RawFilePath, IO Bool)] -> Annex () addInternalAction :: Git.Queue.InternalActionRunner Annex -> [(RawFilePath, IO Bool)] -> Annex ()
addInternalAction runner files = do addInternalAction runner files = do

View file

@ -198,7 +198,7 @@ add :: GetFileMatcher -> FilePath -> Assistant (Maybe Change)
add largefilematcher file = ifM (liftAnnex $ checkFileMatcher largefilematcher (toRawFilePath file)) add largefilematcher file = ifM (liftAnnex $ checkFileMatcher largefilematcher (toRawFilePath file))
( pendingAddChange file ( pendingAddChange file
, do , do
liftAnnex $ Annex.Queue.addCommand "add" liftAnnex $ Annex.Queue.addCommand [] "add"
[Param "--force", Param "--"] [file] [Param "--force", Param "--"] [file]
madeChange file AddFileChange madeChange file AddFileChange
) )

View file

@ -147,7 +147,8 @@ addSmallOverridden o file = do
addFile :: CheckGitIgnore -> RawFilePath -> Annex Bool addFile :: CheckGitIgnore -> RawFilePath -> Annex Bool
addFile ci file = do addFile ci file = do
ps <- gitAddParams ci ps <- gitAddParams ci
Annex.Queue.addCommand "add" (ps++[Param "--"]) [fromRawFilePath file] Annex.Queue.addCommand [] "add" (ps++[Param "--"])
[fromRawFilePath file]
return True return True
start :: AddOptions -> SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart start :: AddOptions -> SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart

View file

@ -107,5 +107,5 @@ fixSymlink file link = do
cleanupSymlink :: FilePath -> CommandCleanup cleanupSymlink :: FilePath -> CommandCleanup
cleanupSymlink file = do cleanupSymlink file = do
Annex.Queue.addCommand "add" [Param "--force", Param "--"] [file] Annex.Queue.addCommand [] "add" [Param "--force", Param "--"] [file]
return True return True

View file

@ -97,7 +97,8 @@ perform key file = lookupKeyNotHidden file >>= \case
link <- calcRepo $ gitAnnexLink file key link <- calcRepo $ gitAnnexLink file key
createWorkTreeDirectory (parentDir file) createWorkTreeDirectory (parentDir file)
liftIO $ R.createSymbolicLink link file liftIO $ R.createSymbolicLink link file
Annex.Queue.addCommand "add" [Param "--"] [fromRawFilePath file] Annex.Queue.addCommand [] "add" [Param "--"]
[fromRawFilePath file]
next $ return True next $ return True
) )
Just k Just k

View file

@ -1,6 +1,6 @@
{- git repository command queue {- git repository command queue
- -
- Copyright 2010-2019 Joey Hess <id@joeyh.name> - Copyright 2010-2021 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -37,8 +37,12 @@ data Action m
{- A git command to run, on a list of files that can be added to {- A git command to run, on a list of files that can be added to
- as the queue grows. -} - as the queue grows. -}
| CommandAction | CommandAction
{ getSubcommand :: String { getCommonParams :: [CommandParam]
-- ^ parameters that come before the git subcommand
-- (in addition to the Repo's gitGlobalOpts.
, getSubcommand :: String
, getParams :: [CommandParam] , getParams :: [CommandParam]
-- ^ parameters that come after the git subcommand
, getFiles :: [CommandParam] , getFiles :: [CommandParam]
} }
{- An internal action to run, on a list of files that can be added {- An internal action to run, on a list of files that can be added
@ -57,13 +61,13 @@ instance Eq (InternalActionRunner m) where
{- A key that can uniquely represent an action in a Map. -} {- A key that can uniquely represent an action in a Map. -}
data ActionKey data ActionKey
= UpdateIndexActionKey = UpdateIndexActionKey
| CommandActionKey String [CommandParam] | CommandActionKey [CommandParam] String [CommandParam]
| InternalActionKey String | InternalActionKey String
deriving (Eq, Ord) deriving (Eq, Ord)
actionKey :: Action m -> ActionKey actionKey :: Action m -> ActionKey
actionKey (UpdateIndexAction _) = UpdateIndexActionKey actionKey (UpdateIndexAction _) = UpdateIndexActionKey
actionKey CommandAction { getSubcommand = s, getParams = p } = CommandActionKey s p actionKey CommandAction { getCommonParams = c, getSubcommand = s, getParams = p } = CommandActionKey c s p
actionKey InternalAction { getRunner = InternalActionRunner s _ } = InternalActionKey s actionKey InternalAction { getRunner = InternalActionRunner s _ } = InternalActionKey s
{- A queue of actions to perform (in any order) on a git repository, {- A queue of actions to perform (in any order) on a git repository,
@ -95,14 +99,15 @@ new lim = Queue 0 (fromMaybe defaultLimit lim) M.empty
- -
- Git commands with the same subcommand but different parameters are - Git commands with the same subcommand but different parameters are
- assumed to be equivilant enough to perform in any order with the same - assumed to be equivilant enough to perform in any order with the same
- result. - end result.
-} -}
addCommand :: MonadIO m => String -> [CommandParam] -> [FilePath] -> Queue m -> Repo -> m (Queue m) addCommand :: MonadIO m => [CommandParam] -> String -> [CommandParam] -> [FilePath] -> Queue m -> Repo -> m (Queue m)
addCommand subcommand params files q repo = addCommand commonparams subcommand params files q repo =
updateQueue action different (length files) q repo updateQueue action different (length files) q repo
where where
action = CommandAction action = CommandAction
{ getSubcommand = subcommand { getCommonParams = commonparams
, getSubcommand = subcommand
, getParams = params , getParams = params
, getFiles = map File files , getFiles = map File files
} }
@ -155,8 +160,8 @@ updateQueue !action different sizeincrease q repo
- the old value. So, the list append of the new value first is more - the old value. So, the list append of the new value first is more
- efficient. -} - efficient. -}
combineNewOld :: Action m -> Action m -> Action m combineNewOld :: Action m -> Action m -> Action m
combineNewOld (CommandAction _sc1 _ps1 fs1) (CommandAction sc2 ps2 fs2) = combineNewOld (CommandAction _cps1 _sc1 _ps1 fs1) (CommandAction cps2 sc2 ps2 fs2) =
CommandAction sc2 ps2 (fs1++fs2) CommandAction cps2 sc2 ps2 (fs1++fs2)
combineNewOld (UpdateIndexAction s1) (UpdateIndexAction s2) = combineNewOld (UpdateIndexAction s1) (UpdateIndexAction s2) =
UpdateIndexAction (s1++s2) UpdateIndexAction (s1++s2)
combineNewOld (InternalAction _r1 fs1) (InternalAction r2 fs2) = combineNewOld (InternalAction _r1 fs1) (InternalAction r2 fs2) =
@ -209,7 +214,8 @@ runAction repo action@(CommandAction {}) = liftIO $ do
#endif #endif
where where
gitparams = gitCommandLine gitparams = gitCommandLine
(Param (getSubcommand action):getParams action) repo (getCommonParams action++Param (getSubcommand action):getParams action)
repo
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
go p (Just h) _ _ pid = do go p (Just h) _ _ pid = do
hPutStr h $ intercalate "\0" $ toCommand $ getFiles action hPutStr h $ intercalate "\0" $ toCommand $ getFiles action

View file

@ -100,7 +100,7 @@ updateSymlinks = do
<$> calcRepo (gitAnnexLink (toRawFilePath f) k) <$> calcRepo (gitAnnexLink (toRawFilePath f) k)
liftIO $ removeFile f liftIO $ removeFile f
liftIO $ createSymbolicLink link f liftIO $ createSymbolicLink link f
Annex.Queue.addCommand "add" [Param "--"] [f] Annex.Queue.addCommand [] "add" [Param "--"] [f]
moveLocationLogs :: Annex () moveLocationLogs :: Annex ()
moveLocationLogs = do moveLocationLogs = do
@ -127,9 +127,9 @@ moveLocationLogs = do
old <- liftIO $ readLog1 f old <- liftIO $ readLog1 f
new <- liftIO $ readLog1 dest new <- liftIO $ readLog1 dest
liftIO $ writeLog1 dest (old++new) liftIO $ writeLog1 dest (old++new)
Annex.Queue.addCommand "add" [Param "--"] [dest] Annex.Queue.addCommand [] "add" [Param "--"] [dest]
Annex.Queue.addCommand "add" [Param "--"] [f] Annex.Queue.addCommand [] "add" [Param "--"] [f]
Annex.Queue.addCommand "rm" [Param "--quiet", Param "-f", Param "--"] [f] Annex.Queue.addCommand [] "rm" [Param "--quiet", Param "-f", Param "--"] [f]
oldlog2key :: FilePath -> Maybe (FilePath, Key) oldlog2key :: FilePath -> Maybe (FilePath, Key)
oldlog2key l oldlog2key l