git style quoting for ActionItemOther

Added StringContainingQuotedPath, which is used for ActionItemOther.

In the process, checked every ActionItemOther for those containing
filenames, and made them use quoting.

Sponsored-by: Graham Spencer on Patreon

Command/AddUrl.hs

@@ -402,7 +402,7 @@ startingAddUrl si url o p = starting "addurl" ai si $ do
 	-- available and get added to it. That's ok, this is only
 	-- used to prevent two threads running concurrently when that would
 	-- likely fail.
-	ai = OnlyActionOn urlkey (ActionItemOther (Just url))
+	ai = OnlyActionOn urlkey (ActionItemOther (Just (UnquotedString url)))
 	urlkey = Backend.URL.fromUrl url Nothing
 
 showDestinationFile :: FilePath -> Annex ()

Command/Config.hs

@@ -61,7 +61,7 @@ seek (SetConfig ck@(ConfigKey name) val) = checkIsGlobalConfig ck $ commandActio
 			setConfig ck (fromConfigValue val)
 		next $ return True
   where
-	ai = ActionItemOther (Just (fromConfigValue val))
+	ai = ActionItemOther (Just (UnquotedString (fromConfigValue val)))
 	si = SeekInput [decodeBS name]
 seek (UnsetConfig ck@(ConfigKey name)) = checkIsGlobalConfig ck $ commandAction $
 	startingUsualMessages (decodeBS name) ai si $ do

Command/Describe.hs

@@ -26,7 +26,7 @@ start (name:description) | not (null description) = do
 	starting "describe" ai si $
 		perform u $ unwords description
   where
-	ai = ActionItemOther (Just name)
+	ai = ActionItemOther (Just (UnquotedString name))
 	si = SeekInput [name]
 start _ = giveup "Specify a repository and a description."	
 

Command/EnableRemote.hs

@@ -71,7 +71,7 @@ startNormalRemote name restparams r
 	| otherwise = giveup $
 		"That is a normal git remote; passing these parameters does not make sense: " ++ unwords restparams
   where
-	ai = ActionItemOther (Just name)
+	ai = ActionItemOther (Just (UnquotedString name))
 	si = SeekInput [name]
 
 startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> [(UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> CommandStart
@@ -92,7 +92,7 @@ startSpecialRemote name config ((u, c, mcu):[]) =
 			=<< Remote.byUUID u
 		performSpecialRemote t u c fullconfig gc mcu
   where
-	ai = ActionItemOther (Just name)
+	ai = ActionItemOther (Just (UnquotedString name))
 	si = SeekInput [name]
 startSpecialRemote _ _ _ =
 	giveup "Multiple remotes have that name. Either use git-annex renameremote to rename them, or specify the uuid of the remote to enable."

Command/Expire.hs

@@ -79,7 +79,7 @@ start (Expire expire) noact actlog descs u =
 			return $ "last active: " ++ fromDuration d ++ " ago"
 		_  -> return "no activity"
 	desc = fromUUID u ++ " " ++ fromUUIDDesc (fromMaybe mempty (M.lookup u descs))
-	ai = ActionItemOther (Just desc)
+	ai = ActionItemOther (Just (UnquotedString desc))
 	si = SeekInput []
 	notexpired ent = case ent of
 		Unknown -> False

Command/Export.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2017-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2017-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -413,13 +413,15 @@ startMoveToTempName r db f ek =
 	loc = mkExportLocation f'
 	f' = getTopFilePath f
 	tmploc = exportTempName ek
-	ai = ActionItemOther $ Just $ fromRawFilePath f' ++ " -> " ++ fromRawFilePath (fromExportLocation tmploc)
+	ai = ActionItemOther $ Just $ 
+		QuotedPath f' <> " -> " <> QuotedPath (fromExportLocation tmploc)
 	si = SeekInput []
 
 startMoveFromTempName :: Remote -> ExportHandle -> Key -> TopFilePath -> CommandStart
 startMoveFromTempName r db ek f = do
 	let tmploc = exportTempName ek
-	let ai = ActionItemOther (Just (fromRawFilePath (fromExportLocation tmploc) ++ " -> " ++ fromRawFilePath f'))
+	let ai = ActionItemOther $ Just $
+		QuotedPath (fromExportLocation tmploc) <> " -> " <> QuotedPath f'
 	stopUnless (liftIO $ elem tmploc <$> getExportedLocation db ek) $
 		starting ("rename " ++ name r) ai si $
 			performRename r db ek tmploc loc

Command/Forget.hs

@@ -42,7 +42,7 @@ start o = starting "forget" ai si $ do
 		else basets
 	perform ts =<< Annex.getRead Annex.force
   where
-	ai = ActionItemOther (Just (fromRef Branch.name))
+	ai = ActionItemOther (Just (UnquotedString (fromRef Branch.name)))
 	si = SeekInput []
 
 perform :: Transitions -> Bool -> CommandPerform

Command/Fsck.hs

@@ -42,7 +42,6 @@ import qualified Database.Keys
 import qualified Database.Fsck as FsckDb
 import Types.CleanupActions
 import Types.Key
-import Types.ActionItem
 import qualified Utility.RawFilePath as R
 
 import Data.Time.Clock.POSIX

Command/Group.hs

@@ -27,7 +27,7 @@ start ps@(name:g:[]) = do
 	startingUsualMessages "group" ai si $
 		setGroup u (toGroup g)
   where
-	ai = ActionItemOther (Just name)
+	ai = ActionItemOther (Just (UnquotedString name))
 	si = SeekInput ps
 start (name:[]) = do
 	u <- Remote.nameToUUID name

Command/GroupWanted.hs

@@ -27,6 +27,6 @@ start (g:[]) = startingCustomOutput (ActionItemOther Nothing) $
 start ps@(g:expr:[]) = startingUsualMessages "groupwanted" ai si $
 	performSet groupPreferredContentSet expr (toGroup g)
   where
-	ai = ActionItemOther (Just g)
+	ai = ActionItemOther (Just (UnquotedString g))
 	si = SeekInput ps
 start _ = giveup "Specify a group."

Command/Import.hs

@@ -351,7 +351,7 @@ listContents remote importtreeconfig ci tvar = starting "list" ai si $
 		liftIO $ atomically $ writeTVar tvar importable
 		next $ return True
   where
-	ai = ActionItemOther (Just (Remote.name remote))
+	ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
 	si = SeekInput []
 
 listContents' :: Remote -> ImportTreeConfig -> CheckGitIgnore -> (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, Remote.ByteSize)) -> Annex a) -> Annex a
@@ -373,7 +373,7 @@ commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig
 		importcommit <- buildImportCommit remote importtreeconfig importcommitconfig importable
 		next $ updateremotetrackingbranch importcommit
   where
-	ai = ActionItemOther (Just $ fromRef $ fromRemoteTrackingBranch tb)
+	ai = ActionItemOther (Just $ UnquotedString $ fromRef $ fromRemoteTrackingBranch tb)
 	si = SeekInput []
 	-- Update the tracking branch. Done even when there
 	-- is nothing new to import, to make sure it exists.

Command/Info.hs

@@ -43,7 +43,6 @@ import Logs.Transfer
 import Types.Key
 import Types.TrustLevel
 import Types.FileMatcher
-import Types.ActionItem
 import qualified Limit
 import Messages.JSON (DualDisp(..), ObjectMap(..))
 import Annex.BloomFilter

Command/Init.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Command.Init where
 
 import Command
@@ -62,7 +64,7 @@ start os
 		starting "init" (ActionItemOther (Just "autoenable")) si $
 			performAutoEnableOnly
 	| otherwise = 
-		starting "init" (ActionItemOther (Just $ initDesc os)) si $
+		starting "init" (ActionItemOther (Just $ UnquotedString $ initDesc os)) si $
 			perform os
   where
 	si = SeekInput []

Command/InitRemote.hs

@@ -81,7 +81,7 @@ start o (name:ws) = ifM (not . null <$> findExisting name)
 			if whatElse o
 				then startingCustomOutput (ActionItemOther Nothing) $
 					describeOtherParamsFor c t
-				else starting "initremote" (ActionItemOther (Just name)) si $
+				else starting "initremote" (ActionItemOther (Just (UnquotedString name))) si $
 					perform t name c o
 		)
 	)

Command/Merge.hs

@@ -48,7 +48,7 @@ mergeAnnexBranch = starting "merge" ai si $ do
 	Annex.Branch.commit =<< Annex.Branch.commitMessage
 	next $ return True
   where
-	ai = ActionItemOther (Just (fromRef Annex.Branch.name))
+	ai = ActionItemOther (Just (UnquotedString (fromRef Annex.Branch.name)))
 	si = SeekInput []
 
 mergeSyncedBranch :: MergeOptions -> CommandStart
@@ -63,5 +63,5 @@ mergeBranch o r = starting "merge" ai si $ do
 	let so = def { notOnlyAnnexOption = True }
 	next $ merge currbranch mc so Git.Branch.ManualCommit r
   where
-	ai = ActionItemOther (Just (Git.fromRef r))
+	ai = ActionItemOther (Just (UnquotedString (Git.fromRef r)))
 	si = SeekInput []

Command/MinCopies.hs

@@ -35,5 +35,5 @@ startSet n = startingUsualMessages "mincopies" ai si $ do
 	setGlobalMinCopies $ configuredMinCopies n
 	next $ return True
   where
-	ai = ActionItemOther (Just $ show n)
+	ai = ActionItemOther (Just $ UnquotedString $ show n)
 	si = SeekInput [show n]

Command/NumCopies.hs

@@ -49,5 +49,5 @@ startSet n = startingUsualMessages "numcopies" ai si $ do
 	setGlobalNumCopies $ configuredNumCopies n
 	next $ return True
   where
-	ai = ActionItemOther (Just $ show n)
+	ai = ActionItemOther (Just $ UnquotedString $ show n)
 	si = SeekInput [show n]

Command/P2P.hs

@@ -101,7 +101,7 @@ linkRemote :: RemoteName -> CommandStart
 linkRemote remotename = starting "p2p link" ai si $
 	next promptaddr
   where
-	ai = ActionItemOther (Just remotename)
+	ai = ActionItemOther (Just (UnquotedString remotename))
 	si = SeekInput []
 	promptaddr = do
 		liftIO $ putStrLn ""
@@ -131,7 +131,7 @@ startPairing remotename addrs = ifM (liftIO Wormhole.isInstalled)
 	, giveup "Magic Wormhole is not installed, and is needed for pairing. Install it from your distribution or from https://github.com/warner/magic-wormhole/"
 	)
   where
-	ai = ActionItemOther (Just remotename)
+	ai = ActionItemOther (Just (UnquotedString remotename))
 	si = SeekInput []
 
 performPairing :: RemoteName -> [P2PAddress] -> CommandPerform

Command/RegisterUrl.hs

@@ -63,7 +63,7 @@ start' a o (si, (key, url)) =
 	starting "registerurl" ai si $
 		perform a o key url
   where
-	ai = ActionItemOther (Just url)
+	ai = ActionItemOther (Just (UnquotedString url))
 
 perform :: (Remote -> Key -> URLString -> Annex ()) -> RegisterUrlOptions -> Key -> URLString -> CommandPerform
 perform a o key url = do

Command/Reinit.hs

@@ -24,9 +24,10 @@ seek :: CmdParams -> CommandSeek
 seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
-start ws = starting "reinit" (ActionItemOther (Just s)) (SeekInput ws) $
+start ws = starting "reinit" ai (SeekInput ws) $
 	perform s
   where
+	ai = ActionItemOther (Just (UnquotedString s))
 	s = unwords ws
 
 perform :: String -> CommandPerform

Command/Reinject.hs

@@ -56,7 +56,7 @@ startSrcDest ps@(src:dest:[])
 			( perform src' key
 			, giveup $ src ++ " does not have expected content of " ++ dest
 			)
-	ai = ActionItemOther (Just src)
+	ai = ActionItemOther (Just (QuotedPath src'))
 	si = SeekInput ps
 startSrcDest _ = giveup "specify a src file and a dest file"
 
@@ -73,7 +73,7 @@ startKnown src = notAnnexed src' $
   where
 	src' = toRawFilePath src
 	ks = KeySource src' src' Nothing
-	ai = ActionItemOther (Just src)
+	ai = ActionItemOther (Just (QuotedPath src'))
 	si = SeekInput [src]
 
 notAnnexed :: RawFilePath -> CommandStart -> CommandStart

Command/Schedule.hs

@@ -31,7 +31,7 @@ start = parse
 			performGet u
 	parse ps@(name:expr:[]) = do
 		u <- Remote.nameToUUID name
-		let ai = ActionItemOther (Just name)
+		let ai = ActionItemOther (Just (UnquotedString name))
 		let si = SeekInput ps
 		startingUsualMessages "schedule" ai si $
 			performSet expr u

Command/SetKey.hs

@@ -21,10 +21,11 @@ seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
 start ps@(keyname:file:[]) = starting "setkey" ai si $
-	perform (toRawFilePath file) (keyOpt keyname)
+	perform file' (keyOpt keyname)
   where
-	ai = ActionItemOther (Just file)
+	ai = ActionItemOther (Just (QuotedPath file'))
 	si = SeekInput ps
+	file' = toRawFilePath file
 start _ = giveup "specify a key and a content file"
 
 keyOpt :: String -> Key

Command/Sync.hs

@@ -392,7 +392,7 @@ mergeLocal' mergeconfig o currbranch@(Just branch, _) =
 	needMerge currbranch branch >>= \case
 		Nothing -> stop
 		Just syncbranch -> do
-			let ai = ActionItemOther (Just $ Git.Ref.describe syncbranch)
+			let ai = ActionItemOther (Just $ UnquotedString $ Git.Ref.describe syncbranch)
 			let si = SeekInput []
 			starting "merge" ai si $
 				next $ merge currbranch mergeconfig o Git.Branch.ManualCommit syncbranch
@@ -400,7 +400,7 @@ mergeLocal' _ _ currbranch@(Nothing, _) = inRepo Git.Branch.currentUnsafe >>= \c
 	Just branch -> needMerge currbranch branch >>= \case
 		Nothing -> stop
 		Just syncbranch -> do
-			let ai = ActionItemOther (Just $ Git.Ref.describe syncbranch)
+			let ai = ActionItemOther (Just $ UnquotedString $ Git.Ref.describe syncbranch)
 			let si = SeekInput []
 			starting "merge" ai si $ do
 				warning $ "There are no commits yet to branch " ++ Git.fromRef branch ++ ", so cannot merge " ++ Git.fromRef syncbranch ++ " into it."
@@ -513,7 +513,7 @@ pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && want
 				, Just $ Param $ Remote.name remote
 				] ++ map Param bs
 	wantpull = remoteAnnexPull (Remote.gitconfig remote)
-	ai = ActionItemOther (Just (Remote.name remote))
+	ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
 	si = SeekInput []
 
 importRemote :: Bool -> SyncOptions -> Remote -> CurrBranch -> CommandSeek
@@ -559,7 +559,7 @@ pullThirdPartyPopulated o remote
 		Nothing -> next $ return False
 	go Nothing = next $ return True -- unchanged from before
 
-	ai = ActionItemOther (Just (Remote.name remote))
+	ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
 	si = SeekInput []
 	
 	wantpull = remoteAnnexPull (Remote.gitconfig remote)
@@ -607,7 +607,7 @@ pushRemote o remote (Just branch, _) = do
 					warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ]
 					return ok
   where
-	ai = ActionItemOther (Just (Remote.name remote))
+	ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
 	si = SeekInput []
 	gc = Remote.gitconfig remote
 	needpush mainbranch
@@ -1003,7 +1003,7 @@ cleanupRemote remote (Just b, _) =
 				Git.Ref.base $ Annex.Branch.name
 			]
   where
-	ai = ActionItemOther (Just (Remote.name remote))
+	ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
 	si = SeekInput []
 
 shouldSyncContent :: SyncOptions -> Annex Bool

Command/TestRemote.hs

@@ -73,7 +73,7 @@ seek :: TestRemoteOptions -> CommandSeek
 seek = commandAction . start 
 
 start :: TestRemoteOptions -> CommandStart
-start o = starting "testremote" (ActionItemOther (Just (testRemote o))) si $ do
+start o = starting "testremote" (ActionItemOther (Just (UnquotedString (testRemote o)))) si $ do
 	fast <- Annex.getRead Annex.fast
 	cache <- liftIO newRemoteVariantCache
 	r <- either giveup (disableExportTree cache)

Command/Trust.hs

@@ -30,7 +30,7 @@ trustCommand c level ps = withStrings (commandAction . start) ps
 	start name = do
 		u <- Remote.nameToUUID name
 		let si = SeekInput [name]
-		starting c (ActionItemOther (Just name)) si (perform name u)
+		starting c (ActionItemOther (Just (UnquotedString name))) si (perform name u)
 	perform name uuid = do
 		when (level >= Trusted) $
 			unlessM (Annex.getRead Annex.force) $

Command/Undo.hs

@@ -45,7 +45,7 @@ start :: FilePath -> CommandStart
 start p = starting "undo" ai si $
 	perform p
   where
-	ai = ActionItemOther (Just p)
+	ai = ActionItemOther (Just (QuotedPath (toRawFilePath p)))
 	si = SeekInput [p]
 
 perform :: FilePath -> CommandPerform

Command/Ungroup.hs

@@ -24,8 +24,9 @@ seek = withWords (commandAction . start)
 start :: [String] -> CommandStart
 start (name:g:[]) = do
 	u <- Remote.nameToUUID name
-	starting "ungroup" (ActionItemOther (Just name)) (SeekInput [name, g]) $
-		perform u (toGroup g)
+	starting "ungroup" (ActionItemOther (Just (UnquotedString name))) 
+		(SeekInput [name, g]) $
+			perform u (toGroup g)
 start _ = giveup "Specify a repository and a group."
 
 perform :: UUID -> Group -> CommandPerform

Command/Unused.hs

@@ -73,7 +73,7 @@ start o = do
 		Just "." -> (".", checkUnused refspec)
 		Just "here" -> (".", checkUnused refspec)
 		Just n -> (n, checkRemoteUnused n refspec)
-	starting "unused" (ActionItemOther (Just name)) (SeekInput []) perform
+	starting "unused" (ActionItemOther (Just (UnquotedString name))) (SeekInput []) perform
 
 checkUnused :: RefSpec -> CommandPerform
 checkUnused refspec = chain 0
@@ -337,6 +337,6 @@ startUnused message unused badunused tmpunused maps n = search
 		case M.lookup n m of
 			Nothing -> search rest
 			Just key -> starting message
-				(ActionItemOther $ Just $ show n)
+				(ActionItemOther $ Just $ UnquotedString $ show n)
 				(SeekInput [])
 				(a key)

Command/VPop.hs

@@ -48,6 +48,6 @@ start ps = go =<< currentView
 
 	num = fromMaybe 1 $ readish =<< headMaybe ps 
 	
-	ai = ActionItemOther (Just $ show num)
+	ai = ActionItemOther (Just $ UnquotedString $ show num)
 	
 	si = SeekInput ps

Command/Wanted.hs

@@ -39,7 +39,7 @@ cmd' name desc getter setter = noMessages $
 	start ps@(rname:expr:[]) = do
 		u <- Remote.nameToUUID rname
 		let si = SeekInput ps
-		let ai = ActionItemOther (Just rname)
+		let ai = ActionItemOther (Just (UnquotedString rname))
 		startingUsualMessages name ai si $
 			performSet setter expr u
 	start _ = giveup "Specify a repository."