use ShellParam type

So, I have a type checked safe handling of filenames starting with dashes,
throughout the code.

Annex.hs

@@ -24,6 +24,7 @@ import Control.Monad.State
 import qualified GitRepo as Git
 import qualified GitQueue
 import qualified BackendTypes
+import Utility
 
 -- git-annex's monad
 type Annex = StateT AnnexState IO
@@ -91,7 +92,7 @@ gitRepo :: Annex Git.Repo
 gitRepo = getState repo
 
 {- Adds a git command to the queue. -}
-queue :: String -> [String] -> FilePath -> Annex ()
+queue :: String -> [ShellParam] -> FilePath -> Annex ()
 queue command params file = do
 	state <- get
 	let q = repoqueue state
@@ -110,7 +111,7 @@ queueRun = do
 setConfig :: String -> String -> Annex ()
 setConfig k value = do
 	g <- Annex.gitRepo
-	liftIO $ Git.run g ["config", k, value]
+	liftIO $ Git.run g "config" [Param k, Param value]
 	-- re-read git config and update the repo's state
 	g' <- liftIO $ Git.configRead g
 	Annex.changeState $ \s -> s { Annex.repo = g' }

Backend/SHA1.hs

@@ -32,7 +32,7 @@ backend = Backend.File.backend {
 sha1 :: FilePath -> Annex String
 sha1 file = do
 	showNote "checksum..."
-	liftIO $ pOpen ReadFromPipe "sha1sum" [utilityEscape file] $ \h -> do
+	liftIO $ pOpen ReadFromPipe "sha1sum" (toShell [File file]) $ \h -> do
 		line <- hGetLine h
 		let bits = split " " line
 		if null bits

Backend/URL.hs

@@ -51,6 +51,6 @@ downloadUrl :: Key -> FilePath -> Annex Bool
 downloadUrl key file = do
 	showNote "downloading"
 	showProgress -- make way for curl progress bar
-	liftIO $ boolSystem "curl" ["-#", "-o", utilityEscape file, url]
+	liftIO $ boolSystem "curl" [Params "-# -o", File file, File url]
 	where
 		url = join ":" $ drop 1 $ split ":" $ show key 

Command/Add.hs

@@ -17,6 +17,7 @@ import LocationLog
 import Types
 import Content
 import Messages
+import Utility
 
 command :: [Command]
 command = [Command "add" paramPath seek "add files to annex"]
@@ -52,5 +53,5 @@ cleanup file key = do
 
 	link <- calcGitLink file key
 	liftIO $ createSymbolicLink link file
-	Annex.queue "add" ["--"] file
+	Annex.queue "add" [Param "--"] file
 	return True

Command/Fix.hs

@@ -44,5 +44,5 @@ perform file link = do
 
 cleanup :: FilePath -> CommandCleanup
 cleanup file = do
-	Annex.queue "add" ["--"] file
+	Annex.queue "add" [Param "--"] file
 	return True

Command/FromKey.hs

@@ -47,5 +47,5 @@ perform file = do
 
 cleanup :: FilePath -> CommandCleanup
 cleanup file = do
-	Annex.queue "add" ["--"] file
+	Annex.queue "add" [Param "--"] file
 	return True

Command/Init.hs

@@ -51,8 +51,12 @@ cleanup :: CommandCleanup
 cleanup = do
 	g <- Annex.gitRepo
 	logfile <- uuidLog
-	liftIO $ Git.run g ["add", logfile]
-	liftIO $ Git.run g ["commit", "-q", "-m", "git annex init", logfile]
+	liftIO $ Git.run g "add" [File logfile]
+	liftIO $ Git.run g "commit" 
+		[ Params "-q -m"
+		, Param "git annex init"
+		, File logfile
+		]
 	return True
 
 {- configure git to use union merge driver on state files, if it is not
@@ -72,9 +76,12 @@ gitAttributesWrite repo = do
 	where
 		attributes = Git.attributes repo
 		commit = do
-			Git.run repo ["add", attributes]
-			Git.run repo ["commit", "-q", "-m", "git-annex setup", 
-					attributes]
+			Git.run repo "add" [Param attributes]
+			Git.run repo "commit"
+				[ Params "-q -m"
+				, Param "git-annex setup"
+				, Param attributes
+				]
 
 attrLine :: String		
 attrLine = stateDir </> "*.log merge=union"

Command/Lock.hs

@@ -14,6 +14,7 @@ import Command
 import Messages
 import qualified Annex
 import qualified GitRepo as Git
+import Utility
 	
 command :: [Command]
 command = [Command "lock" paramPath seek "undo unlock command"]
@@ -32,7 +33,7 @@ perform file = do
 	liftIO $ removeFile file
 	g <- Annex.gitRepo
 	-- first reset the file to drop any changes checked into the index
-	liftIO $ Git.run g ["reset", "-q", "--", file]
+	liftIO $ Git.run g "reset" [Params "-q --", File file]
 	-- checkout the symlink
-	liftIO $ Git.run g ["checkout", "--", file]
+	liftIO $ Git.run g "checkout" [Param "--", File file]
 	return $ Just $ return True -- no cleanup needed

Command/Map.hs

@@ -44,7 +44,7 @@ start = do
 	liftIO $ writeFile file (drawMap rs umap trusted)
 	showLongNote $ "running: dot -Tx11 " ++ file
 	showProgress
-	r <- liftIO $ boolSystem "dot" ["-Tx11", file]
+	r <- liftIO $ boolSystem "dot" [Param "-Tx11", File file]
 	return $ Just $ return $ Just $ return r
 	where
 		file = "map.dot"
@@ -198,7 +198,7 @@ tryScan r
 				Left _ -> return Nothing
 				Right r' -> return $ Just r'
 		pipedconfig cmd params = safely $
-			pOpen ReadFromPipe cmd params $
+			pOpen ReadFromPipe cmd (toShell params) $
 				Git.hConfigRead r
 
 		configlist =
@@ -208,8 +208,9 @@ tryScan r
 			let sshcmd =
 				"cd " ++ shellEscape(Git.workTree r) ++ " && " ++
 				"git config --list"
-			liftIO $ pipedconfig "ssh" $
-				words sshoptions ++ [Git.urlHostFull r, sshcmd]
+			liftIO $ pipedconfig "ssh" $ map Param $ 
+					words sshoptions ++
+					[Git.urlHostFull r, sshcmd]
 
 		-- First, try sshing and running git config manually,
 		-- only fall back to git-annex-shell configlist if that

Command/Move.hs

@@ -56,7 +56,7 @@ remoteHasKey remote key present	= do
 	g <- Annex.gitRepo
 	remoteuuid <- getUUID remote
 	logfile <- liftIO $ logChange g key remoteuuid status
-	Annex.queue "add" ["--"] logfile
+	Annex.queue "add" [Param "--"] logfile
 	where
 		status = if present then ValuePresent else ValueMissing
 
@@ -130,9 +130,10 @@ fromPerform src move key = do
 fromCleanup :: Git.Repo -> Bool -> Key -> CommandCleanup
 fromCleanup src True key = do
 	ok <- Remotes.onRemote src (boolSystem, False) "dropkey" 
-		["--quiet", "--force",
-		"--backend=" ++ backendName key,
-		keyName key]
+		[ Params "--quiet --force"
+		, Param $ "--backend=" ++ backendName key
+		, Param $ keyName key
+		]
 	-- better safe than sorry: assume the src dropped the key
 	-- even if it seemed to fail; the failure could have occurred
 	-- after it really dropped it

Command/PreCommit.hs

@@ -15,6 +15,7 @@ import qualified GitRepo as Git
 import qualified Command.Add
 import qualified Command.Fix
 import Messages
+import Utility
 
 command :: [Command]
 command = [Command "pre-commit" paramPath seek "run by git pre-commit hook"]
@@ -41,6 +42,6 @@ cleanup file = do
 	-- drop that and run command queued by Add.state to
 	-- stage the symlink
 	g <- Annex.gitRepo
-	liftIO $ Git.run g ["reset", "-q", "--", file]
+	liftIO $ Git.run g "reset" [Params "-q --", File file]
 	Annex.queueRun
 	return True

Command/SetKey.hs

@@ -36,7 +36,7 @@ perform file = do
 	ok <- getViaTmp key $ \dest -> do
 		if dest /= file
 			then liftIO $
-				boolSystem "mv" [utilityEscape file, utilityEscape dest]
+				boolSystem "mv" [File file, File dest]
 			else return True
 	if ok
 		then return $ Just $ cleanup

Command/Unannex.hs

@@ -58,7 +58,7 @@ cleanup file key = do
 	g <- Annex.gitRepo
 
 	liftIO $ removeFile file
-	liftIO $ Git.run g ["rm", "--quiet", "--", file]
+	liftIO $ Git.run g "rm" [Params "--quiet --", File file]
 	-- git rm deletes empty directories; put them back
 	liftIO $ createDirectoryIfMissing True (parentDir file)
 
@@ -68,6 +68,6 @@ cleanup file key = do
 	-- Commit staged changes at end to avoid confusing the
 	-- pre-commit hook if this file is later added back to
 	-- git as a normal, non-annexed file.
-	Annex.queue "commit" ["-m", "content removed from git annex"] "-a"
+	Annex.queue "commit" [Params "-a -m", Param "content removed from git annex"] "-a"
 	
 	return True

Content.hs

@@ -60,7 +60,7 @@ logStatus key status = do
 	g <- Annex.gitRepo
 	u <- getUUID g
 	logfile <- liftIO $ logChange g key u status
-	Annex.queue "add" ["--"] logfile
+	Annex.queue "add" [Param "--"] logfile
 
 {- Runs an action, passing it a temporary filename to download,
  - and if the action succeeds, moves the temp file into 

CopyFile.hs

@@ -20,14 +20,12 @@ copyFile src dest = do
 	e <- doesFileExist dest
 	when e $
 		removeFile dest
-	boolSystem "cp" opts
+	boolSystem "cp" [params, File src, File dest]
 	where
-		opts = if SysConfig.cp_reflink_auto
-			then ["--reflink=auto", src', dest']
+		params = if SysConfig.cp_reflink_auto
+			then Params "--reflink=auto"
 			else if SysConfig.cp_a
-				then ["-a", src', dest']
+				then Params "-a"
 				else if SysConfig.cp_p
-					then ["-p", src', dest']
-					else [src', dest']
-		src' = utilityEscape src
-		dest' = utilityEscape dest
+					then Params "-p"
+					else Params ""

GitQueue.hs

@@ -17,6 +17,7 @@ import System.IO
 import System.Cmd.Utils
 import Data.String.Utils
 import Control.Monad (unless, forM_)
+import Utility
 
 import qualified GitRepo as Git
 
@@ -24,7 +25,7 @@ import qualified GitRepo as Git
  - is not included, and must be able to be appended after the params. -}
 data Action = Action {
 		getSubcommand :: String,
-		getParams :: [String]
+		getParams :: [ShellParam]
 	} deriving (Show, Eq, Ord)
 
 {- A queue of actions to perform (in any order) on a git repository,
@@ -37,7 +38,7 @@ empty :: Queue
 empty = M.empty
 
 {- Adds an action to a queue. -}
-add :: Queue -> String -> [String] -> FilePath -> Queue
+add :: Queue -> String -> [ShellParam] -> FilePath -> Queue
 add queue subcommand params file = M.insertWith (++) action [file] queue
 	where
 		action = Action subcommand params
@@ -55,7 +56,7 @@ runAction :: Git.Repo -> Action -> [FilePath] -> IO ()
 runAction repo action files = do
 	unless (null files) runxargs
 	where
-		runxargs = pOpen WriteToPipe "xargs" ("-0":gitcmd) feedxargs
-		gitcmd = "git" : Git.gitCommandLine repo
-			(getSubcommand action:getParams action)
+		runxargs = pOpen WriteToPipe "xargs" ("-0":"git":params) feedxargs
+		params = toShell $ Git.gitCommandLine repo
+			(Param (getSubcommand action):getParams action)
 		feedxargs h = hPutStr h $ join "\0" files

GitRepo.hs

@@ -243,16 +243,18 @@ urlPath Repo { location = Url u } = uriPath u
 urlPath repo = assertUrl repo $ error "internal"
 
 {- Constructs a git command line operating on the specified repo. -}
-gitCommandLine :: Repo -> [String] -> [String]
+gitCommandLine :: Repo -> [ShellParam] -> [ShellParam]
 gitCommandLine repo@(Repo { location = Dir d} ) params =
 	-- force use of specified repo via --git-dir and --work-tree
-	["--git-dir=" ++ d ++ "/" ++ gitDir repo, "--work-tree=" ++ d] ++ params
+	[ Param ("--git-dir=" ++ d ++ "/" ++ gitDir repo)
+	, Param ("--work-tree=" ++ d)
+	] ++ params
 gitCommandLine repo _ = assertLocal repo $ error "internal"
 
 {- Runs git in the specified repo, throwing an error if it fails. -}
-run :: Repo -> [String] -> IO ()
-run repo params = assertLocal repo $ do
-	ok <- boolSystem "git" (gitCommandLine repo params)
+run :: Repo -> String -> [ShellParam] -> IO ()
+run repo subcommand params = assertLocal repo $ do
+	ok <- boolSystem "git" (gitCommandLine repo ((Param subcommand):params))
 	unless ok $ error $ "git " ++ show params ++ " failed"
 
 {- Runs a git subcommand and returns it output, lazily. 
@@ -260,9 +262,9 @@ run repo params = assertLocal repo $ do
  - Note that this leaves the git process running, and so zombies will
  - result unless reap is called.
  -}
-pipeRead :: Repo -> [String] -> IO String
+pipeRead :: Repo -> [ShellParam] -> IO String
 pipeRead repo params = assertLocal repo $ do
-	(_, s) <- pipeFrom "git" (gitCommandLine repo params)
+	(_, s) <- pipeFrom "git" $ toShell $ gitCommandLine repo params
 	return s
 
 {- Reaps any zombie git processes. -}
@@ -277,13 +279,13 @@ reap = do
 {- Scans for files that are checked into git at the specified locations. -}
 inRepo :: Repo -> [FilePath] -> IO [FilePath]
 inRepo repo l = pipeNullSplit repo $
-	["ls-files", "--cached", "--exclude-standard", "-z", "--"] ++ l
+	[Params "ls-files --cached --exclude-standard -z --"] ++ map File l
 
 {- Scans for files at the specified locations that are not checked into git,
  - and not gitignored. -}
 notInRepo :: Repo -> [FilePath] -> IO [FilePath]
 notInRepo repo l = pipeNullSplit repo $
-	["ls-files", "--others", "--exclude-standard", "-z", "--"] ++ l
+	[Params "ls-files --others --exclude-standard -z --"] ++ map File l
 
 {- Returns a list of all files that are staged for commit. -}
 stagedFiles :: Repo -> [FilePath] -> IO [FilePath]
@@ -292,38 +294,38 @@ stagedFiles repo l = stagedFiles' repo l []
 {- Returns a list of the files, staged for commit, that are being added,
  - moved, or changed (but not deleted), from the specified locations. -}
 stagedFilesNotDeleted :: Repo -> [FilePath] -> IO [FilePath]
-stagedFilesNotDeleted repo l = stagedFiles' repo l ["--diff-filter=ACMRT"]
+stagedFilesNotDeleted repo l = stagedFiles' repo l [Param "--diff-filter=ACMRT"]
 
-stagedFiles' :: Repo -> [FilePath] -> [String] -> IO [FilePath]
+stagedFiles' :: Repo -> [FilePath] -> [ShellParam] -> IO [FilePath]
 stagedFiles' repo l middle = pipeNullSplit repo $ start ++ middle ++ end
 	where
-		start = ["diff", "--cached", "--name-only", "-z"]
-		end = ["--"] ++ l
+		start = [Params "diff --cached --name-only -z"]
+		end = [Param "--"] ++ map File l
 
 {- Returns a list of files that have unstaged changes. -}
 changedUnstagedFiles :: Repo -> [FilePath] -> IO [FilePath]
 changedUnstagedFiles repo l = pipeNullSplit repo $
-	["diff", "--name-only", "-z", "--"] ++ l
+	[Params "diff --name-only -z --"] ++ map File l
 
 {- Returns a list of the files in the specified locations that are staged
  - for commit, and whose type has changed. -}
 typeChangedStagedFiles :: Repo -> [FilePath] -> IO [FilePath]
-typeChangedStagedFiles repo l = typeChangedFiles' repo l ["--cached"]
+typeChangedStagedFiles repo l = typeChangedFiles' repo l [Param "--cached"]
 
 {- Returns a list of the files in the specified locations whose type has
  - changed.  Files only staged for commit will not be included. -}
 typeChangedFiles :: Repo -> [FilePath] -> IO [FilePath]
 typeChangedFiles repo l = typeChangedFiles' repo l []
 
-typeChangedFiles' :: Repo -> [FilePath] -> [String] -> IO [FilePath]
+typeChangedFiles' :: Repo -> [FilePath] -> [ShellParam] -> IO [FilePath]
 typeChangedFiles' repo l middle = pipeNullSplit repo $ start ++ middle ++ end
 	where
-		start = ["diff", "--name-only", "--diff-filter=T", "-z"]
-		end = ["--"] ++ l
+		start = [Params "diff --name-only --diff-filter=T -z"]
+		end = [Param "--"] ++ map File l
 
 {- Reads null terminated output of a git command (as enabled by the -z 
  - parameter), and splits it into a list of files. -}
-pipeNullSplit :: Repo -> [String] -> IO [FilePath]
+pipeNullSplit :: Repo -> [ShellParam] -> IO [FilePath]
 pipeNullSplit repo params = do
 	fs0 <- pipeRead repo params
 	return $ split0 fs0
@@ -408,11 +410,11 @@ checkAttr repo attr files = do
 	-- directory. Convert to absolute, and then convert the filenames
 	-- in its output back to relative.
 	absfiles <- mapM absPath files
-	(_, s) <- pipeBoth "git" params $ join "\0" absfiles
+	(_, s) <- pipeBoth "git" (toShell params) $ join "\0" absfiles
 	cwd <- getCurrentDirectory
 	return $ map (topair $ cwd++"/") $ lines s
 	where
-		params = gitCommandLine repo ["check-attr", attr, "-z", "--stdin"]
+		params = gitCommandLine repo [Param "check-attr", Param attr, Params "-z --stdin"]
 		topair cwd l = (relfile, value)
 			where 
 				relfile 

Remotes.hs

@@ -64,7 +64,7 @@ tryGitConfigRead r
 				Left _ -> return r
 				Right r' -> return r'
 		pipedconfig cmd params = safely $
-			pOpen ReadFromPipe cmd params $
+			pOpen ReadFromPipe cmd (toShell params) $
 				Git.hConfigRead r
 		store a = do
 			r' <- a
@@ -154,7 +154,7 @@ inAnnex r key = if Git.repoIsUrl r
 		checkremote = do
 			showNote ("checking " ++ Git.repoDescribe r ++ "...")
 			inannex <- onRemote r (boolSystem, False) "inannex" 
-				["--backend=" ++ backendName key, keyName key]
+				[Param ("--backend=" ++ backendName key), Param (keyName key)]
 			return $ Right inannex
 
 {- Cost Ordered list of remotes. -}
@@ -263,28 +263,31 @@ rsynchelper r sending key file = do
 
 {- Generates rsync parameters that ssh to the remote and asks it
  - to either receive or send the key's content. -}
-rsyncParams :: Git.Repo -> Bool -> Key -> FilePath -> Annex [String]
+rsyncParams :: Git.Repo -> Bool -> Key -> FilePath -> Annex [ShellParam]
 rsyncParams r sending key file = do
-	-- Note that the command is terminated with "--", because
-	-- rsync will tack on its own options to this command,
-	-- and they need to be ignored.
-	shellcmd <- git_annex_shell r
+	Just (shellcmd, shellparams) <- git_annex_shell r
 		(if sending then "sendkey" else "recvkey")
-		["--backend=" ++ backendName key, keyName key, "--"]
+		[ Param $ "--backend=" ++ backendName key
+		, Param $ keyName key
+		-- Command is terminated with "--", because
+		-- rsync will tack on its own options afterwards,
+		-- and they need to be ignored.
+		, Param "--"
+		]
 	-- Convert the ssh command into rsync command line.
-	let eparam = rsyncShell $ fromJust shellcmd
+	let eparam = rsyncShell (Param shellcmd:shellparams)
 	o <- repoConfig r "rsync-options" ""
-	let base = options ++ words o ++ eparam
+	let base = options ++ map Param (words o) ++ eparam
 	if sending
-		then return $ base ++ [dummy, file]
-		else return $ base ++ [file, dummy]
+		then return $ base ++ [dummy, File file]
+		else return $ base ++ [File file, dummy]
 	where
 		-- inplace makes rsync resume partial files
-		options = ["-p", "--progress", "--inplace"]
+		options = [Params "-p --progress --inplace"]
 		-- the rsync shell parameter controls where rsync
 		-- goes, so the source/dest parameter can be a dummy value,
 		-- that just enables remote rsync mode.
-		dummy = ":"
+		dummy = Param ":"
 
 {- Uses a supplied function to run a git-annex-shell command on a remote.
  -
@@ -292,30 +295,31 @@ rsyncParams r sending key file = do
  - a specified error value. -}
 onRemote 
 	:: Git.Repo
-	-> (String -> [String] -> IO a, a)
+	-> (FilePath -> [ShellParam] -> IO a, a)
 	-> String
-	-> [String]
+	-> [ShellParam]
 	-> Annex a
 onRemote r (with, errorval) command params = do
 	s <- git_annex_shell r command params
 	case s of
-		Just shellcmd -> liftIO $ with (shellcmd !! 0) (tail shellcmd)
+		Just (c, ps) -> liftIO $ with c ps
 		Nothing -> return errorval
 
 {- Generates parameters to run a git-annex-shell command on a remote. -}
-git_annex_shell :: Git.Repo -> String -> [String] -> Annex (Maybe [String])
+git_annex_shell :: Git.Repo -> String -> [ShellParam] -> Annex (Maybe (FilePath, [ShellParam]))
 git_annex_shell r command params
-	| not $ Git.repoIsUrl r = return $ Just (shellcmd:shellopts)
+	| not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts)
 	| Git.repoIsSsh r = do
 		sshoptions <- repoConfig r "ssh-options" ""
-		return $ Just $ ["ssh"] ++ words sshoptions ++ 
-			[Git.urlHostFull r, sshcmd]
+		return $ Just ("ssh", map Param (words sshoptions) ++ 
+			[Param (Git.urlHostFull r), Param sshcmd])
 	| otherwise = return Nothing
 	where
 		dir = Git.workTree r
 		shellcmd = "git-annex-shell"
-		shellopts = command:dir:params
-		sshcmd = shellcmd ++ " " ++ unwords (map shellEscape shellopts)
+		shellopts = (Param command):(File dir):params
+		sshcmd = shellcmd ++ " " ++ 
+			unwords (map shellEscape $ toShell shellopts)
 
 {- Looks up a per-remote config option in git config.
  - Failing that, tries looking for a global config option. -}

RsyncFile.hs

@@ -14,8 +14,8 @@ import Utility
 
 {- Generates parameters to make rsync use a specified command as its remote
  - shell. -}
-rsyncShell :: [String] -> [String]
-rsyncShell command = ["-e", unwords $ map escape command]
+rsyncShell :: [ShellParam] -> [ShellParam]
+rsyncShell command = [Param "-e", Param $ unwords $ map escape (toShell command)]
 	where
 		{- rsync requires some weird, non-shell like quoting in
                  - here. A doubled single quote inside the single quoted
@@ -25,22 +25,25 @@ rsyncShell command = ["-e", unwords $ map escape command]
 {- Runs rsync in server mode to send a file, and exits. -}
 rsyncServerSend :: FilePath -> IO ()
 rsyncServerSend file = rsyncExec $
-	rsyncServerParams ++ ["--sender", utilityEscape file]
+	rsyncServerParams ++ [Param "--sender", File file]
 
 {- Runs rsync in server mode to receive a file. -}
 rsyncServerReceive :: FilePath -> IO Bool
-rsyncServerReceive file = rsync $ rsyncServerParams ++ [utilityEscape file]
+rsyncServerReceive file = rsync $ rsyncServerParams ++ [File file]
 
-rsyncServerParams :: [String]
+rsyncServerParams :: [ShellParam]
 rsyncServerParams =
-	[ "--server"
-	, "-p"		-- preserve permissions
-	, "--inplace"	-- allow resuming of transfers of big files
-	, "-e.Lsf", "."	-- other options rsync normally uses in server mode
+	[ Param "--server"
+	-- preserve permissions
+	, Param "-p"
+	-- allow resuming of transfers of big files
+	, Param "--inplace"
+	-- other options rsync normally uses in server mode
+	, Params "-e.Lsf ."
 	]
 
-rsync :: [String] -> IO Bool
-rsync params = boolSystem "rsync" params 
+rsync :: [ShellParam] -> IO Bool
+rsync = boolSystem "rsync"
 
-rsyncExec :: [String] -> IO ()
-rsyncExec params = executeFile "rsync" True params Nothing
+rsyncExec :: [ShellParam] -> IO ()
+rsyncExec params = executeFile "rsync" True (toShell params) Nothing

Trust.hs

@@ -81,8 +81,12 @@ trustSet uuid level = do
 	        logfile <- trustLog
 	        liftIO $ safeWriteFile logfile (serialize m')
 		g <- Annex.gitRepo
-		liftIO $ Git.run g ["add", logfile]
-		liftIO $ Git.run g ["commit", "-q", "-m", "git annex trust change", logfile]
+		liftIO $ Git.run g "add" [File logfile]
+		liftIO $ Git.run g "commit"
+			[ Params "-q -m"
+			, Param "git annex trust change"
+			, File logfile
+			]
         where
                 serialize m = unlines $ map showpair $ M.toList m
 		showpair (u, t) = u ++ " " ++ show t

Upgrade.hs

@@ -22,6 +22,7 @@ import qualified Annex
 import qualified Backend
 import Messages
 import Version
+import Utility
 
 {- Uses the annex.version git config setting to automate upgrades. -}
 upgrade :: Annex Bool
@@ -62,7 +63,7 @@ upgradeFrom0 = do
 					link <- calcGitLink f k
 					liftIO $ removeFile f
 					liftIO $ createSymbolicLink link f
-					Annex.queue "add" ["--"] f
+					Annex.queue "add" [Param "--"] f
 			fixlinks fs
 
 getKeysPresent0' :: FilePath -> Annex [Key]

Utility.hs

@@ -1,6 +1,6 @@
 {- git-annex utility functions
  -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -50,16 +50,17 @@ import Control.Monad (liftM2)
 data ShellParam = Params String | Param String | File FilePath
 	deriving (Eq, Show, Ord)
 
-{- When converting ShellParam to a String in preparation for passing to
- - a shell command, Files that start with a dash are modified to avoid
- - the shell command interpreting them as options. -}
+{- Used to pass a list of ShellParams to a function that runs
+ - a shell command and expects Strings. -}
 toShell :: [ShellParam] -> [String]
 toShell l = concat $ map unwrap l
 	where
 		unwrap (Param s) = [s]
 		unwrap (Params s) = filter (not . null) (split " " s)
+		-- Files that start with a dash are modified to avoid
+		-- the shell command interpreting them as options.
 		unwrap (File ('-':s)) = ["./-" ++ s]
-		unwrap (File (s)) = [s]
+		unwrap (File s) = [s]
 
 {- Run a system command, and returns True or False
  - if it succeeded or failed.

git-annex-shell.hs

@@ -66,7 +66,7 @@ builtin cmd dir params = do
 
 external :: [String] -> IO ()
 external params = do
-	ret <- boolSystem "git-shell" ("-c":(filterparams params))
+	ret <- boolSystem "git-shell" $ map Param $ ("-c":filterparams params)
 	when (not ret) $
 		error "git-shell failed"
 

test.hs

@@ -105,8 +105,8 @@ test_add = "git-annex add" ~: TestList [basic, sha1dup]
 			git_annex "add" ["-q", annexedfile] @? "add failed"
 			annexed_present annexedfile
 			writeFile ingitfile $ content ingitfile
-			Utility.boolSystem "git" ["add", ingitfile] @? "git add failed"
-			Utility.boolSystem "git" ["commit", "-q", "-a", "-m", "commit"] @? "git commit failed"
+			Utility.boolSystem "git" [Utility.Param "add", Utility.File ingitfile] @? "git add failed"
+			Utility.boolSystem "git" [Utility.Params "commit -q -a -m commit"] @? "git commit failed"
 			git_annex "add" ["-q", ingitfile] @? "add ingitfile should be no-op"
 			unannexed ingitfile
 		sha1dup = TestCase $ intmpclonerepo $ do
@@ -125,7 +125,7 @@ test_setkey = "git-annex setkey/fromkey" ~: TestCase $ inmainrepo $ do
 	let sha1 = BackendTypes.keyName $ fromJust r
 	git_annex "setkey" ["-q", "--backend", "SHA1", "--key", sha1, tmp] @? "setkey failed"
 	git_annex "fromkey" ["-q", "--backend", "SHA1", "--key", sha1, sha1annexedfile] @? "fromkey failed"
-	Utility.boolSystem "git" ["commit", "-q", "-a", "-m", "commit"] @? "git commit failed"
+	Utility.boolSystem "git" [Utility.Params "commit -q -a -m commit"] @? "git commit failed"
 	annexed_present sha1annexedfile
 	where
 		tmp = "tmpfile"
@@ -139,7 +139,7 @@ test_unannex = "git-annex unannex" ~: TestList [nocopy, withcopy]
 			annexed_notpresent annexedfile
 		withcopy = "with content" ~: intmpclonerepo $ do
 			git_annex "get" ["-q", annexedfile] @? "get failed"
-			Utility.boolSystem "git" ["commit", "-q", "-a", "-m", "state changed"]
+			Utility.boolSystem "git" [Utility.Params "commit -q -a -m statechanged"]
 				@? "git commit of state failed"
 			annexed_present annexedfile
 			git_annex "unannex" ["-q", annexedfile, sha1annexedfile] @? "unannex failed"
@@ -154,9 +154,9 @@ test_drop = "git-annex drop" ~: TestList [noremote, withremote, untrustedremote]
 	where
 		noremote = "no remotes" ~: TestCase $ intmpclonerepo $ do
 			git_annex "get" ["-q", annexedfile] @? "get failed"
-			Utility.boolSystem "git" ["commit", "-q", "-a", "-m", "state changed"]
+			Utility.boolSystem "git" [Utility.Params "commit -q -a -m statechanged"]
 				@? "git commit of state failed"
-			Utility.boolSystem "git" ["remote", "rm", "origin"]
+			Utility.boolSystem "git" [Utility.Params "remote rm origin"]
 				@? "git remote rm origin failed"
 			r <- git_annex "drop" ["-q", annexedfile]
 			not r @? "drop wrongly succeeded with no known copy of file"
@@ -287,12 +287,12 @@ test_edit = "git-annex edit/commit" ~: TestList [t False, t True]
 			then do
 				-- pre-commit depends on the file being
 				-- staged, normally git commit does this
-				Utility.boolSystem "git" ["add", annexedfile]
+				Utility.boolSystem "git" [Utility.Param "add", Utility.File annexedfile]
 					@? "git add of edited file failed"
 				git_annex "pre-commit" ["-q"]
 					@? "pre-commit failed"
 			else do
-				Utility.boolSystem "git" ["commit", "-q", "-a", "-m", "content changed"]
+				Utility.boolSystem "git" [Utility.Params "commit -q -a -m contentchanged"]
 					@? "git commit of edited file failed"
 		runchecks [checklink, checkunwritable] annexedfile
 		c <- readFile annexedfile
@@ -310,7 +310,7 @@ test_fix = "git-annex fix" ~: intmpclonerepo $ do
 	git_annex "fix" ["-q", annexedfile] @? "fix of present file failed"
 	annexed_present annexedfile
 	createDirectory subdir
-	Utility.boolSystem "git" ["mv", annexedfile, subdir]
+	Utility.boolSystem "git" [Utility.Param "mv", Utility.File annexedfile, Utility.File subdir]
 		@? "git mv failed"
 	git_annex "fix" ["-q", newfile] @? "fix of moved file failed"
 	runchecks [checklink, checkunwritable] newfile
@@ -350,9 +350,9 @@ test_fsck = "git-annex fsck" ~: TestList [basicfsck, withlocaluntrusted, withrem
 	where
 		basicfsck = TestCase $ intmpclonerepo $ do
 			git_annex "fsck" ["-q"] @? "fsck failed"
-			Utility.boolSystem "git" ["config", "annex.numcopies", "2"] @? "git config failed"
+			Utility.boolSystem "git" [Utility.Params "config annex.numcopies 2"] @? "git config failed"
 			fsck_should_fail "numcopies unsatisfied"
-			Utility.boolSystem "git" ["config", "annex.numcopies", "1"] @? "git config failed"
+			Utility.boolSystem "git" [Utility.Params "config annex.numcopies 1"] @? "git config failed"
 			corrupt annexedfile
 			corrupt sha1annexedfile
 		withlocaluntrusted = TestCase $ intmpclonerepo $ do
@@ -363,7 +363,7 @@ test_fsck = "git-annex fsck" ~: TestList [basicfsck, withlocaluntrusted, withrem
 			git_annex "trust" ["-q", "."] @? "trust of current repo failed"
 			git_annex "fsck" ["-q", annexedfile] @? "fsck failed on file present in trusted repo"
 		withremoteuntrusted = TestCase $ intmpclonerepo $ do
-			Utility.boolSystem "git" ["config", "annex.numcopies", "2"] @? "git config failed"
+			Utility.boolSystem "git" [Utility.Params "config annex.numcopies 2"] @? "git config failed"
 			git_annex "get" ["-q", annexedfile] @? "get failed"
 			git_annex "get" ["-q", sha1annexedfile] @? "get failed"
 			git_annex "fsck" ["-q"] @? "fsck failed with numcopies=2 and 2 copies"
@@ -433,9 +433,9 @@ test_unused = "git-annex unused/dropunused" ~: intmpclonerepo $ do
 	git_annex "get" ["-q", annexedfile] @? "get of file failed"
 	git_annex "get" ["-q", sha1annexedfile] @? "get of file failed"
 	checkunused []
-	Utility.boolSystem "git" ["rm", "-q", annexedfile] @? "git rm failed"
+	Utility.boolSystem "git" [Utility.Params "rm -q", Utility.File annexedfile] @? "git rm failed"
 	checkunused [annexedfilekey]
-	Utility.boolSystem "git" ["rm", "-q", sha1annexedfile] @? "git rm failed"
+	Utility.boolSystem "git" [Utility.Params "rm -q", Utility.File sha1annexedfile] @? "git rm failed"
 	checkunused [annexedfilekey, sha1annexedfilekey]
 
 	-- good opportunity to test dropkey also
@@ -511,10 +511,10 @@ setuprepo :: FilePath -> IO FilePath
 setuprepo dir = do
 	cleanup dir
 	ensuretmpdir
-	Utility.boolSystem "git" ["init", "-q", dir] @? "git init failed"
+	Utility.boolSystem "git" [Utility.Params "init -q", Utility.File dir] @? "git init failed"
 	indir dir $ do
-		Utility.boolSystem "git" ["config", "user.name", "Test User"] @? "git config failed"
-		Utility.boolSystem "git" ["config", "user.email", "test@example.com"] @? "git config failed"
+		Utility.boolSystem "git" [Utility.Params "config user.name", Utility.Param "Test User"] @? "git config failed"
+		Utility.boolSystem "git" [Utility.Params "config user.email test@example.com"] @? "git config failed"
 	return dir
 
 -- clones are always done as local clones; we cannot test ssh clones
@@ -522,7 +522,7 @@ clonerepo :: FilePath -> FilePath -> IO FilePath
 clonerepo old new = do
 	cleanup new
 	ensuretmpdir
-	Utility.boolSystem "git" ["clone", "-q", old, new] @? "git clone failed"
+	Utility.boolSystem "git" [Utility.Params "clone -q", Utility.File old, Utility.File new] @? "git clone failed"
 	indir new $ git_annex "init" ["-q", new] @? "git annex init failed"
 	return new