git subcommand cleanup

Pass subcommand as a regular param, which allows passing git parameters
like -c before it. This was already done in the pipeing set of functions,
but not the command running set.

Annex/Branch.hs

@@ -76,8 +76,8 @@ getBranch :: Annex Git.Ref
 getBranch = maybe (hasOrigin >>= go >>= use) return =<< branchsha
   where
 	go True = do
-		inRepo $ Git.Command.run "branch"
+		inRepo $ Git.Command.run
-			[Param $ show name, Param $ show originname]
+			[Param "branch", Param $ show name, Param $ show originname]
 		fromMaybe (error $ "failed to create " ++ show name)
 			<$> branchsha
 	go False = withIndex' True $

Assistant/MakeRemote.hs

@@ -77,9 +77,8 @@ makeSpecialRemote name remotetype config = do
  - remote at the location, returns its name. -}
 makeGitRemote :: String -> String -> Annex String
 makeGitRemote basename location = makeRemote basename location $ \name ->
-	void $ inRepo $
+	void $ inRepo $ Git.Command.runBool
-		Git.Command.runBool "remote"
+		[Param "remote", Param "add", Param name, Param location]
-			[Param "add", Param name, Param location]
 
 {- If there's not already a remote at the location, adds it using the
  - action, which is passed the name of the remote to make.

Assistant/Sync.hs

@@ -141,13 +141,13 @@ pushToRemotes now notifypushes remotes = do
  - uuid in them. While ugly, those branches are reserved for pushing by us,
  - and so our pushes will never conflict with other pushes. -}
 pushFallback :: UUID -> Git.Ref -> Remote -> Git.Repo -> IO Bool
-pushFallback u branch remote = Git.Command.runBool "push" params
+pushFallback u branch remote = Git.Command.runBool
+	[ Param "push"
+	, Param $ Remote.name remote
+	, Param $ refspec Annex.Branch.name
+	, Param $ refspec branch
+	]
   where
-	params = 
-		[ Param $ Remote.name remote
-		, Param $ refspec Annex.Branch.name
-		, Param $ refspec branch
-		]
 	{- Push to refs/synced/uuid/branch; this
 	 - avoids cluttering up the branch display. -}
 	refspec b = concat
@@ -162,7 +162,7 @@ manualPull :: Maybe Git.Ref -> [Remote] -> Assistant ([Bool], Bool)
 manualPull currentbranch remotes = do
 	g <- liftAnnex gitRepo
 	results <- liftIO $ forM remotes $ \r ->
-		Git.Command.runBool "fetch" [Param $ Remote.name r] g
+		Git.Command.runBool [Param "fetch", Param $ Remote.name r] g
 	haddiverged <- liftAnnex Annex.Branch.forceUpdate
 	forM_ remotes $ \r ->
 		liftAnnex $ Command.Sync.mergeRemote r currentbranch

Assistant/Threads/Committer.hs

@@ -81,9 +81,9 @@ commitStaged = do
 		Left _ -> return False
 		Right _ -> do
 			direct <- isDirect
-			let params = nomessage $
+			let params = nomessage $ catMaybes
-				catMaybes
+				[ Just $ Param "commit"
-				[ Just $ Param "--quiet"
+				, Just $ Param "--quiet"
 				{- In indirect mode, avoid running the
 				 - usual git-annex pre-commit hook;
 				 - watch does the same symlink fixing,
@@ -95,7 +95,7 @@ commitStaged = do
 			 - each other out, etc. Git returns nonzero on those,
 			 - so don't propigate out commit failures. -}
 			void $ inRepo $ catchMaybeIO . 
-				Git.Command.runQuiet "commit" params
+				Git.Command.runQuiet params
 			return True
   where
 	nomessage ps

Assistant/WebApp/Configurators/Edit.hs

@@ -76,10 +76,11 @@ setRepoConfig uuid mremote oldc newc = do
 			let remotefetch = "remote." ++ T.unpack (repoName oldc) ++ ".fetch"
 			needfetch <- isNothing <$> fromRepo (Git.Config.getMaybe remotefetch)
 			when needfetch $
-				inRepo $ Git.Command.run "config"
+				inRepo $ Git.Command.run
-					[Param remotefetch, Param ""]
+					[Param "config", Param remotefetch, Param ""]
-			inRepo $ Git.Command.run "remote"
+			inRepo $ Git.Command.run
-				[ Param "rename"
+				[ Param "remote"
+				, Param "rename"
 				, Param $ T.unpack $ repoName oldc
 				, Param name
 				]

Assistant/WebApp/Configurators/Local.hs

@@ -305,8 +305,9 @@ initRepo primary_assistant_repo dir desc = inDir dir $ do
 	unlessM (Git.Config.isBare <$> gitRepo) $
 		{- Initialize the master branch, so things that expect
 		 - to have it will work, before any files are added. -}
-		void $ inRepo $ Git.Command.runBool "commit"
+		void $ inRepo $ Git.Command.runBool
-			[ Param "--quiet"
+			[ Param "commit"
+			, Param "--quiet"
 			, Param "--allow-empty"
 			, Param "-m"
 			, Param "created repository"

Command/Direct.hs

@@ -30,8 +30,12 @@ perform :: CommandPerform
 perform = do
 	showStart "commit" ""
 	showOutput
-	_ <- inRepo $ Git.Command.runBool "commit"
+	_ <- inRepo $ Git.Command.runBool
-		[Param "-a", Param "-m", Param "commit before switching to direct mode"]
+		[ Param "commit"
+		, Param "-a"
+		, Param "-m"
+		, Param "commit before switching to direct mode"
+		]
 	showEndOk
 
 	top <- fromRepo Git.repoPath

Command/Indirect.hs

@@ -43,8 +43,11 @@ perform = do
 	showStart "commit" ""
 	whenM (stageDirect) $ do
 		showOutput
-		void $ inRepo $ Git.Command.runBool "commit"
+		void $ inRepo $ Git.Command.runBool
-			[Param "-m", Param "commit before switching to indirect mode"]
+			[ Param "commit"
+			, Param "-m"
+			, Param "commit before switching to indirect mode"
+			]
 	showEndOk
 
 	-- Note that we set indirect mode early, so that we can use

Command/Sync.hs

@@ -91,7 +91,7 @@ commit = next $ next $ do
 		showOutput
 		Annex.Branch.commit "update"
 		-- Commit will fail when the tree is clean, so ignore failure.
-		_ <- inRepo $ Git.Command.runBool "commit" $ ps ++
+		_ <- inRepo $ Git.Command.runBool $ (Param "commit") : ps ++
 			[Param "-m", Param "git-annex automatic sync"]
 		return True
 
@@ -117,8 +117,9 @@ updateBranch :: Git.Ref -> Git.Repo -> IO ()
 updateBranch syncbranch g = 
 	unlessM go $ error $ "failed to update " ++ show syncbranch
   where
-	go = Git.Command.runBool "branch"
+	go = Git.Command.runBool
-		[ Param "-f"
+		[ Param "branch"
+		, Param "-f"
 		, Param $ show $ Git.Ref.base syncbranch
 		] g
 
@@ -130,8 +131,8 @@ pullRemote remote branch = do
 		stopUnless fetch $
 			next $ mergeRemote remote (Just branch)
   where
-	fetch = inRepo $ Git.Command.runBool "fetch"
+	fetch = inRepo $ Git.Command.runBool
-		[Param $ Remote.name remote]
+		[Param "fetch", Param $ Remote.name remote]
 
 {- The remote probably has both a master and a synced/master branch.
  - Which to merge from? Well, the master has whatever latest changes
@@ -162,8 +163,9 @@ pushRemote remote branch = go =<< needpush
 
 pushBranch :: Remote -> Git.Ref -> Git.Repo -> IO Bool
 pushBranch remote branch g =
-	Git.Command.runBool "push"
+	Git.Command.runBool
-		[ Param $ Remote.name remote
+		[ Param "push"
+		, Param $ Remote.name remote
 		, Param $ refspec Annex.Branch.name
 		, Param $ refspec branch
 		] g
@@ -233,8 +235,11 @@ resolveMerge = do
 	
 	when merged $ do
 		Annex.Queue.flush
-		void $ inRepo $ Git.Command.runBool "commit"
+		void $ inRepo $ Git.Command.runBool
-			[Param "-m", Param "git-annex automatic merge conflict fix"]
+			[ Param "commit"
+			, Param "-m"
+			, Param "git-annex automatic merge conflict fix"
+			]
 	return merged
 
 resolveMerge' :: LsFiles.Unmerged -> Annex Bool

Command/Unannex.hs

@@ -34,7 +34,7 @@ cleanup :: FilePath -> Key -> CommandCleanup
 cleanup file key = do
 	liftIO $ removeFile file
 	-- git rm deletes empty directory without --cached
-	inRepo $ Git.Command.run "rm" [Params "--cached --quiet --", File file]
+	inRepo $ Git.Command.run [Params "rm --cached --quiet --", File file]
 	
 	-- If the file was already committed, it is now staged for removal.
 	-- Commit that removal now, to avoid later confusing the
@@ -42,10 +42,12 @@ cleanup file key = do
 	-- git as a normal, non-annexed file.
 	(s, clean) <- inRepo $ LsFiles.staged [file]
 	when (not $ null s) $ do
-		inRepo $ Git.Command.run "commit" [
+		inRepo $ Git.Command.run
-			Param "-q",
+			[ Param "commit"
-			Params "-m", Param "content removed from git annex",
+			, Param "-q"
-			Param "--", File file]
+			, Param "-m", Param "content removed from git annex"
+			, Param "--", File file
+			]
 	void $ liftIO clean
 
 	ifM (Annex.getState Annex.fast)

Command/Uninit.hs

@@ -67,6 +67,6 @@ start = next $ next $ do
 	liftIO $ removeDirectoryRecursive annexdir
 	-- avoid normal shutdown
 	saveState False
-	inRepo $ Git.Command.run "branch"
+	inRepo $ Git.Command.run
-		[Param "-D", Param $ show Annex.Branch.name]
+		[Param "branch", Param "-D", Param $ show Annex.Branch.name]
 	liftIO exitSuccess

Config.hs

@@ -23,13 +23,13 @@ getConfig (ConfigKey key) def = fromRepo $ Git.Config.get key def
 {- Changes a git config setting in both internal state and .git/config -}
 setConfig :: ConfigKey -> String -> Annex ()
 setConfig (ConfigKey key) value = do
-	inRepo $ Git.Command.run "config" [Param key, Param value]
+	inRepo $ Git.Command.run [Param "config", Param key, Param value]
 	Annex.changeGitRepo =<< inRepo Git.Config.reRead
 
 {- Unsets a git config setting. (Leaves it in state currently.) -}
 unsetConfig :: ConfigKey -> Annex ()
-unsetConfig (ConfigKey key) = inRepo $ Git.Command.run "config"
+unsetConfig (ConfigKey key) = inRepo $ Git.Command.run
-	[Param "--unset", Param key]
+	[Param "config", Param "--unset", Param key]
 
 {- A per-remote config setting in git config. -}
 remoteConfig :: Git.Repo -> UnqualifiedConfigKey -> ConfigKey

Git/Branch.hs

@@ -73,8 +73,7 @@ fastForward branch (first:rest) repo =
   where
 	no_ff = return False
 	do_ff to = do
-		run "update-ref"
+		run [Param "update-ref", Param $ show branch, Param $ show to] repo
-			[Param $ show branch, Param $ show to] repo
 		return True
 	findbest c [] = return $ Just c
 	findbest c (r:rs)
@@ -97,7 +96,7 @@ commit message branch parentrefs repo = do
 	sha <- getSha "commit-tree" $ pipeWriteRead
 		(map Param $ ["commit-tree", show tree] ++ ps)
 		message repo
-	run "update-ref" [Param $ show branch, Param $ show sha] repo
+	run [Param "update-ref", Param $ show branch, Param $ show sha] repo
 	return sha
   where
 	ps = concatMap (\r -> ["-p", show r]) parentrefs

Git/Command.hs

@@ -25,25 +25,25 @@ gitCommandLine params Repo { location = l@(Local _ _ ) } = setdir : settree ++ p
 gitCommandLine _ repo = assertLocal repo $ error "internal"
 
 {- Runs git in the specified repo. -}
-runBool :: String -> [CommandParam] -> Repo -> IO Bool
+runBool :: [CommandParam] -> Repo -> IO Bool
-runBool subcommand params repo = assertLocal repo $
+runBool params repo = assertLocal repo $
 	boolSystemEnv "git"
-		(gitCommandLine (Param subcommand : params) repo)
+		(gitCommandLine params repo)
 		(gitEnv repo)
 
 {- Runs git in the specified repo, throwing an error if it fails. -}
-run :: String -> [CommandParam] -> Repo -> IO ()
+run :: [CommandParam] -> Repo -> IO ()
-run subcommand params repo = assertLocal repo $
+run params repo = assertLocal repo $
-	unlessM (runBool subcommand params repo) $
+	unlessM (runBool params repo) $
-		error $ "git " ++ subcommand ++ " " ++ show params ++ " failed"
+		error $ "git " ++ show params ++ " failed"
 
 {- Runs git and forces it to be quiet, throwing an error if it fails. -}
-runQuiet :: String -> [CommandParam] -> Repo -> IO ()
+runQuiet :: [CommandParam] -> Repo -> IO ()
-runQuiet subcommand params repo = withQuietOutput createProcessSuccess $
+runQuiet params repo = withQuietOutput createProcessSuccess $
-	(proc "git" $ toCommand $ gitCommandLine (Param subcommand : params) repo)
+	(proc "git" $ toCommand $ gitCommandLine (params) repo)
 		{ env = gitEnv repo }
 
-{- Runs a git subcommand and returns its output, lazily.
+{- Runs a git command and returns its output, lazily.
  -
  - Also returns an action that should be used when the output is all
  - read (or no more is needed), that will wait on the command, and
@@ -58,7 +58,7 @@ pipeReadLazy params repo = assertLocal repo $ do
   where
 	p  = gitCreateProcess params repo
 
-{- Runs a git subcommand, and returns its output, strictly.
+{- Runs a git command, and returns its output, strictly.
  -
  - Nonzero exit status is ignored.
  -}
@@ -72,7 +72,7 @@ pipeReadStrict params repo = assertLocal repo $
   where
 	p  = gitCreateProcess params repo
 
-{- Runs a git subcommand, feeding it input, and returning its output,
+{- Runs a git command, feeding it input, and returning its output,
  - which is expected to be fairly small, since it's all read into memory
  - strictly. -}
 pipeWriteRead :: [CommandParam] -> String -> Repo -> IO String
@@ -80,7 +80,7 @@ pipeWriteRead params s repo = assertLocal repo $
 	writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo) 
 		(gitEnv repo) s (Just fileEncoding)
 
-{- Runs a git subcommand, feeding it input on a handle with an action. -}
+{- Runs a git command, feeding it input on a handle with an action. -}
 pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()
 pipeWrite params repo = withHandle StdinHandle createProcessSuccess $
 	gitCreateProcess params repo

Git/Merge.hs

@@ -15,5 +15,7 @@ import Git.Version
 {- Avoids recent git's interactive merge. -}
 mergeNonInteractive :: Ref -> Repo -> IO Bool
 mergeNonInteractive branch
-	| older "1.7.7.6" = runBool "merge" [Param $ show branch]
+	| older "1.7.7.6" = merge [Param $ show branch]
-	| otherwise = runBool "merge" [Param "--no-edit", Param $ show branch]
+	| otherwise = merge [Param "--no-edit", Param $ show branch]
+  where
+	merge ps = runBool $ Param "merge" : ps

Git/Ref.hs

@@ -34,8 +34,8 @@ under dir r = Ref $ dir </> show (base r)
 
 {- Checks if a ref exists. -}
 exists :: Ref -> Repo -> IO Bool
-exists ref = runBool "show-ref" 
+exists ref = runBool
-	[Param "--verify", Param "-q", Param $ show ref]
+	[Param "show-ref", Param "show-ref", Param "--verify", Param "-q", Param $ show ref]
 
 {- Checks if HEAD exists. It generally will, except for in a repository
  - that was just created. -}

Remote/Bup.hs

@@ -204,8 +204,11 @@ storeBupUUID u buprepo = do
 			r' <- Git.Config.read r
 			let olduuid = Git.Config.get "annex.uuid" "" r'
 			when (olduuid == "") $
-				Git.Command.run "config"
+				Git.Command.run
-					[Param "annex.uuid", Param v] r'
+					[ Param "config"
+					, Param "annex.uuid"
+					, Param v
+					] r'
   where
 	v = fromUUID u
 

Remote/Git.hs

@@ -141,10 +141,10 @@ tryGitConfigRead r
 				{- Is this remote just not available, or does
 				 - it not have git-annex-shell?
 				 - Find out by trying to fetch from the remote. -}
-				whenM (inRepo $ Git.Command.runBool "fetch" [Param "--quiet", Param n]) $ do
+				whenM (inRepo $ Git.Command.runBool [Param "fetch", Param "--quiet", Param n]) $ do
 					let k = "remote." ++ n ++ ".annex-ignore"
 					warning $ "Remote " ++ n ++ " does not have git-annex installed; setting " ++ k
-					inRepo $ Git.Command.run "config" [Param k, Param "true"]
+					inRepo $ Git.Command.run [Param "config", Param k, Param "true"]
 				return r
 			_ -> return r
 	| Git.repoIsHttp r = do

Remote/Helper/Special.hs

@@ -34,7 +34,7 @@ gitConfigSpecialRemote u c k v = do
 	set ("annex-"++k) v
 	set ("annex-uuid") (fromUUID u)
   where
-	set a b = inRepo $ Git.Command.run "config"
+	set a b = inRepo $ Git.Command.run
-		[Param (configsetting a), Param b]
+		[Param "config", Param (configsetting a), Param b]
 	remotename = fromJust (M.lookup "name" c)
 	configsetting s = "remote." ++ remotename ++ "." ++ s

Upgrade/V2.hs

@@ -54,7 +54,7 @@ upgrade = do
 	showProgress
 
 	when e $ do
-		inRepo $ Git.Command.run "rm" [Param "-r", Param "-f", Param "-q", File old]
+		inRepo $ Git.Command.run [Param "rm", Param "-r", Param "-f", Param "-q", File old]
 		unless bare $ inRepo gitAttributesUnWrite
 	showProgress
 
@@ -105,8 +105,8 @@ push = do
 			Annex.Branch.update -- just in case
 			showAction "pushing new git-annex branch to origin"
 			showOutput
-			inRepo $ Git.Command.run "push"
+			inRepo $ Git.Command.run
-				[Param "origin", Param $ show Annex.Branch.name]
+				[Param "push", Param "origin", Param $ show Annex.Branch.name]
 		_ -> do
 			-- no origin exists, so just let the user
 			-- know about the new branch
@@ -129,7 +129,7 @@ gitAttributesUnWrite repo = do
 		c <- readFileStrict attributes
 		liftIO $ viaTmp writeFile attributes $ unlines $
 			filter (`notElem` attrLines) $ lines c
-		Git.Command.run "add" [File attributes] repo
+		Git.Command.run [Param "add", File attributes] repo
 
 stateDir :: FilePath
 stateDir = addTrailingPathSeparator ".git-annex"