Git.Queue: allow providing git common options like -c
This commit is contained in:
parent
36f691e7e5
commit
1c5fc8f047
9 changed files with 41 additions and 27 deletions
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
)
|
)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
28
Git/Queue.hs
28
Git/Queue.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue