more command-specific options

Made --from and --to command-specific options.

Added generic storage for values of command-specific options,
which allows removing some of the special case fields in AnnexState.

(Also added generic storage for command-specific flags, although there are
not yet any.)

Note that this storage uses a Map, so repeatedly looking up the same value
is slightly more expensive than looking up an AnnexState field. But, the
value can be looked up once in the seek stage, transformed as necessary,
and passed in a closure to the start stage, and this avoids that overhead.

Still, I'm hesitant to use this for things like force or fast flags.
It's probably best to reserve it for flags that are only used by a few
commands, or options like --from and --to that it's important only be
allowed to be used with commands that implement them, to avoid user
confusion.

Annex.hs

@@ -17,6 +17,10 @@ module Annex (
 	eval,
 	getState,
 	changeState,
+	setFlag,
+	setField,
+	getFlag,
+	getField,
 	gitRepo,
 	inRepo,
 	fromRepo,
@@ -38,7 +42,6 @@ import Types.BranchState
 import Types.TrustLevel
 import Types.UUID
 import qualified Utility.Matcher
-import qualified Utility.Format
 import qualified Data.Map as M
 
 -- git-annex's monad
@@ -76,17 +79,16 @@ data AnnexState = AnnexState
 	, force :: Bool
 	, fast :: Bool
 	, auto :: Bool
-	, format :: Maybe Utility.Format.Format
 	, branchstate :: BranchState
 	, catfilehandle :: Maybe CatFileHandle
 	, forcebackend :: Maybe String
 	, forcenumcopies :: Maybe Int
-	, toremote :: Maybe String
-	, fromremote :: Maybe String
 	, limit :: Matcher (FilePath -> Annex Bool)
 	, forcetrust :: [(UUID, TrustLevel)]
 	, trustmap :: Maybe TrustMap
 	, ciphers :: M.Map EncryptedCipher Cipher
+	, flags :: M.Map String Bool
+	, fields :: M.Map String String
 	}
 
 newState :: Git.Repo -> AnnexState
@@ -99,17 +101,16 @@ newState gitrepo = AnnexState
 	, force = False
 	, fast = False
 	, auto = False
-	, format = Nothing
 	, branchstate = startBranchState
 	, catfilehandle = Nothing
 	, forcebackend = Nothing
 	, forcenumcopies = Nothing
-	, toremote = Nothing
-	, fromremote = Nothing
 	, limit = Left []
 	, forcetrust = []
 	, trustmap = Nothing
 	, ciphers = M.empty
+	, flags = M.empty
+	, fields = M.empty
 	}
 
 {- Create and returns an Annex state object for the specified git repo. -}
@@ -134,6 +135,24 @@ getState = gets
 changeState :: (AnnexState -> AnnexState) -> Annex ()
 changeState = modify
 
+{- Sets a flag to True -}
+setFlag :: String -> Annex ()
+setFlag flag = changeState $ \s ->
+	s { flags = M.insert flag True $ flags s }
+
+{- Sets a field to a value -}
+setField :: String -> String -> Annex ()
+setField field value = changeState $ \s ->
+	s { fields = M.insert field value $ fields s }
+
+{- Checks if a flag was set. -}
+getFlag :: String -> Annex Bool
+getFlag flag = fromMaybe False . M.lookup flag <$> getState flags
+
+{- Gets the value of a field. -}
+getField :: String -> Annex (Maybe String)
+getField field = M.lookup field <$> getState fields
+
 {- Returns the annex's git repository. -}
 gitRepo :: Annex Git.Repo
 gitRepo = getState repo

Checks.hs

@@ -13,24 +13,13 @@ module Checks where
 import Common.Annex
 import Types.Command
 import Init
-import qualified Annex
 
 commonChecks :: [CommandCheck]
-commonChecks = [fromOpt, toOpt, repoExists]
+commonChecks = [repoExists]
 
 repoExists :: CommandCheck
 repoExists = CommandCheck 0 ensureInitialized
 
-fromOpt :: CommandCheck
-fromOpt = CommandCheck 1 $ do
-	v <- Annex.getState Annex.fromremote
-	unless (isNothing v) $ error "cannot use --from with this command"
-
-toOpt :: CommandCheck
-toOpt = CommandCheck 2 $ do
-	v <- Annex.getState Annex.toremote
-	unless (isNothing v) $ error "cannot use --to with this command"
-
 dontCheck :: CommandCheck -> Command -> Command
 dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c
 

Command/Copy.hs

@@ -12,15 +12,15 @@ import Command
 import qualified Command.Move
 
 def :: [Command]
-def = [dontCheck toOpt $ dontCheck fromOpt $ 
+def = [withOptions Command.Move.options $ command "copy" paramPaths seek
-	command "copy" paramPaths seek
 	"copy content of files to/from another repository"]
 
 seek :: [CommandSeek]
-seek = [withNumCopies $ \n -> whenAnnexed $ start n]
+seek = [withField "to" id $ \to -> withField "from" id $ \from ->
+		withNumCopies $ \n -> whenAnnexed $ start to from n]
 
 -- A copy is just a move that does not delete the source file.
 -- However, --auto mode avoids unnecessary copies.
-start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe String -> Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
-start numcopies file (key, backend) = autoCopies key (<) numcopies $
+start to from numcopies file (key, backend) = autoCopies key (<) numcopies $
-	Command.Move.start False file (key, backend)
+	Command.Move.start to from False file (key, backend)

Command/Drop.hs

@@ -18,15 +18,18 @@ import Annex.Content
 import Config
 
 def :: [Command]
-def = [dontCheck fromOpt $ command "drop" paramPaths seek
+def = [withOptions [fromOption] $ command "drop" paramPaths seek
 	"indicate content of files not currently wanted"]
 
-seek :: [CommandSeek]
+fromOption :: Option
-seek = [withNumCopies $ \n -> whenAnnexed $ start n]
+fromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
 
-start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
+seek :: [CommandSeek]
-start numcopies file (key, _) = autoCopies key (>) numcopies $ do
+seek = [withField "from" id $ \from -> withNumCopies $ \n ->
-	from <- Annex.getState Annex.fromremote
+	whenAnnexed $ start from n]
+
+start :: Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
+start from numcopies file (key, _) = autoCopies key (>) numcopies $ do
 	case from of
 		Nothing -> startLocal file numcopies key
 		Just name -> do

Command/DropUnused.hs

@@ -20,7 +20,8 @@ import Types.Key
 type UnusedMap = M.Map String Key
 
 def :: [Command]
-def = [dontCheck fromOpt $ command "dropunused" (paramRepeating paramNumber)
+def = [withOptions [Command.Drop.fromOption] $
+	command "dropunused" (paramRepeating paramNumber)
 		seek "drop unused file content"]
 
 seek :: [CommandSeek]
@@ -50,7 +51,7 @@ start (unused, unusedbad, unusedtmp) s = search
 					next $ a key
 
 perform :: Key -> CommandPerform
-perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
+perform key = maybe droplocal dropremote =<< Annex.getField "from"
 	where
 		dropremote name = do
 			r <- Remote.byName name

Command/Find.hs

@@ -23,20 +23,25 @@ def = [withOptions [formatOption, print0Option] $
 	command "find" paramPaths seek "lists available files"]
 
 print0Option :: Option
-print0Option = Option [] ["print0"] (NoArg $ setFormat "${file}\0")
+print0Option = Option [] ["print0"] (NoArg $ Annex.setField "format" "${file}\0")
 	"terminate output with null"
 
-seek :: [CommandSeek]
+formatOption :: Option
-seek = [withFilesInGit $ whenAnnexed start]
+formatOption = fieldOption [] "format" paramFormat "control format of output"
 
-start :: FilePath -> (Key, Backend) -> CommandStart
+seek :: [CommandSeek]
-start file (key, _) = do
+seek = [withField "format" formatconverter $ \f ->
+		withFilesInGit $ whenAnnexed $ start f]
+	where
+		formatconverter = maybe Nothing (Just . Utility.Format.gen)
+
+start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart
+start format file (key, _) = do
 	-- only files inAnnex are shown, unless the user has requested
 	-- others via a limit
 	whenM (liftM2 (||) limited (inAnnex key)) $
-		unlessM (showFullJSON vars) $ do
+		unlessM (showFullJSON vars) $
-			f <- Annex.getState Annex.format
+			case format of
-			case f of
 				Nothing -> liftIO $ putStrLn file
 				Just formatter -> liftIO $ putStr $
 					Utility.Format.format formatter $

Command/Get.hs

@@ -9,22 +9,21 @@ module Command.Get where
 
 import Common.Annex
 import Command
-import qualified Annex
 import qualified Remote
 import Annex.Content
 import qualified Command.Move
 
 def :: [Command]
-def = [dontCheck fromOpt $ command "get" paramPaths seek
+def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
 	"make content of annexed files available"]
 
 seek :: [CommandSeek]
-seek = [withNumCopies $ \n -> whenAnnexed $ start n]
+seek = [withField "from" id $ \from -> withNumCopies $ \n ->
+	whenAnnexed $ start from n]
 
-start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
-start numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
+start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
 	autoCopies key (<) numcopies $ do
-		from <- Annex.getState Annex.fromremote
 		case from of
 			Nothing -> go $ perform key
 			Just name -> do

Command/Move.hs

@@ -16,18 +16,25 @@ import qualified Remote
 import Annex.UUID
 
 def :: [Command]
-def = [dontCheck toOpt $ dontCheck fromOpt $
+def = [withOptions options $ command "move" paramPaths seek
-	command "move" paramPaths seek
 	"move content of files to/from another repository"]
 
-seek :: [CommandSeek]
+fromOption :: Option
-seek = [withFilesInGit $ whenAnnexed $ start True]
+fromOption = fieldOption ['f'] "from" paramRemote "source remote"
 
-start :: Bool -> FilePath -> (Key, Backend) -> CommandStart
+toOption :: Option
-start move file (key, _) = do
+toOption = fieldOption ['t'] "to" paramRemote "destination remote"
+
+options :: [Option]
+options = [fromOption, toOption]
+
+seek :: [CommandSeek]
+seek = [withField "to" id $ \to -> withField "from" id $ \from ->
+		withFilesInGit $ whenAnnexed $ start to from True]
+
+start :: Maybe String -> Maybe String -> Bool -> FilePath -> (Key, Backend) -> CommandStart
+start to from move file (key, _) = do
 	noAuto
-	to <- Annex.getState Annex.toremote
-	from <- Annex.getState Annex.fromremote
 	case (from, to) of
 		(Nothing, Nothing) -> error "specify either --from or --to"
 		(Nothing, Just name) -> do

Command/Unused.hs

@@ -30,16 +30,19 @@ import qualified Annex.Branch
 import Annex.CatFile
 
 def :: [Command]
-def = [dontCheck fromOpt $ command "unused" paramNothing seek
+def = [withOptions [fromOption] $ command "unused" paramNothing seek
 	"look for unused file content"]
 
+fromOption :: Option
+fromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content"
+
 seek :: [CommandSeek]
-seek = [withNothing start]
+seek = [withNothing $ start]
 
 {- Finds unused content in the annex. -} 
 start :: CommandStart
 start = do
-	from <- Annex.getState Annex.fromremote
+	from <- Annex.getField "from"
 	let (name, action) = case from of
 		Nothing -> (".", checkUnused)
 		Just "." -> (".", checkUnused)

GitAnnex.hs

@@ -94,11 +94,7 @@ cmds = concat
 
 options :: [Option]
 options = commonOptions ++
-	[ Option ['t'] ["to"] (ReqArg setto paramRemote)
+	[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
-		"specify to where to transfer content"
-	, Option ['f'] ["from"] (ReqArg setfrom paramRemote)
-		"specify from where to transfer content"
-	, Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
 		"override default number of copies"
 	, Option [] ["trust"] (ReqArg (Remote.forceTrust Trusted) paramRemote)
 		"override trust setting"
@@ -120,8 +116,6 @@ options = commonOptions ++
 		"skip files not using a key-value backend"
 	] ++ matcherOptions
 	where
-		setto v = Annex.changeState $ \s -> s { Annex.toremote = Just v }
-		setfrom v = Annex.changeState $ \s -> s { Annex.fromremote = Just v }
 		setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v }
 		setgitconfig :: String -> Annex ()
 		setgitconfig v = do

Options.hs

@@ -8,8 +8,8 @@
 module Options (
 	commonOptions,
 	matcherOptions,
-	formatOption,
+	flagOption,
-	setFormat,
+	fieldOption,
 	ArgDescr(..),
 	Option,
 	OptDescr(..),
@@ -23,7 +23,6 @@ import qualified Annex
 import Limit
 import Types.Option
 import Usage
-import qualified Utility.Format
 
 commonOptions :: [Option]
 commonOptions =
@@ -65,10 +64,12 @@ matcherOptions =
 		longopt o = Option [] [o] $ NoArg $ addToken o
 		shortopt o = Option o [] $ NoArg $ addToken o
 
-formatOption :: Option
+{- An option that sets a flag. -}
-formatOption = Option [] ["format"] (ReqArg setFormat paramFormat)
+flagOption :: String -> String -> String -> Option
-		"control format of output"
+flagOption short flag description = 
+	Option short [flag] (NoArg (Annex.setFlag flag)) description
 
-setFormat :: String -> Annex ()
+{- An option that sets a field. -}
-setFormat v = Annex.changeState $ \s ->
+fieldOption :: String -> String -> String -> String -> Option
-	s { Annex.format = Just $ Utility.Format.gen v }
+fieldOption short field paramdesc description = 
+	Option short [field] (ReqArg (Annex.setField field) paramdesc) description

Seek.hs

@@ -87,6 +87,15 @@ withKeys a params = return $ map (a . parse) params
 	where
 		parse p = fromMaybe (error "bad key") $ readKey p
 
+{- Modifies a seek action using the value of a field, which is fed into
+ - a conversion function, and then is passed into the seek action.
+ - This ensures that the conversion function only runs once.
+ -}
+withField :: String -> (Maybe String -> a) -> (a -> CommandSeek) -> CommandSeek
+withField field converter a ps = do
+        f <- converter <$> Annex.getField field
+        a f ps
+
 withNothing :: CommandStart -> CommandSeek
 withNothing a [] = return [a]
 withNothing _ _ = error "This command takes no parameters."

Usage.hs

@@ -66,6 +66,8 @@ paramGlob :: String
 paramGlob = "GLOB"
 paramName :: String
 paramName = "NAME"
+paramValue :: String
+paramValue = "VALUE"
 paramUUID :: String
 paramUUID = "UUID"
 paramType :: String