summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-01-06 03:06:25 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-01-06 03:16:42 -0400
commit0a36f92a31196451c2d838fd0ae15527e8bbce18 (patch)
tree54e2a90339ad3d24dbc3d0599a580db63b25ed32
parent2051d804625be0c19e277764ab9820b428a5d2b3 (diff)
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.
-rw-r--r--Annex.hs33
-rw-r--r--Checks.hs13
-rw-r--r--Command/Copy.hs12
-rw-r--r--Command/Drop.hs13
-rw-r--r--Command/DropUnused.hs7
-rw-r--r--Command/Find.hs19
-rw-r--r--Command/Get.hs11
-rw-r--r--Command/Move.hs21
-rw-r--r--Command/Unused.hs9
-rw-r--r--GitAnnex.hs8
-rw-r--r--Options.hs19
-rw-r--r--Seek.hs9
-rw-r--r--Usage.hs2
13 files changed, 104 insertions, 72 deletions
diff --git a/Annex.hs b/Annex.hs
index 91d374aec..f1e46126a 100644
--- a/Annex.hs
+++ b/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
diff --git a/Checks.hs b/Checks.hs
index e443811cd..9d846842d 100644
--- a/Checks.hs
+++ b/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
diff --git a/Command/Copy.hs b/Command/Copy.hs
index 77beb4b4f..d789d41f6 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -12,15 +12,15 @@ import Command
import qualified Command.Move
def :: [Command]
-def = [dontCheck toOpt $ dontCheck fromOpt $
- command "copy" paramPaths seek
+def = [withOptions Command.Move.options $ 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 numcopies file (key, backend) = autoCopies key (<) numcopies $
- Command.Move.start False file (key, backend)
+start :: Maybe String -> Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
+start to from numcopies file (key, backend) = autoCopies key (<) numcopies $
+ Command.Move.start to from False file (key, backend)
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 89e7c8e42..f76951f08 100644
--- a/Command/Drop.hs
+++ b/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"]
+fromOption :: Option
+fromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
+
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 numcopies file (key, _) = autoCopies key (>) numcopies $ do
- from <- Annex.getState Annex.fromremote
+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
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index 244f378d9..fd3e84fe5 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -20,8 +20,9 @@ import Types.Key
type UnusedMap = M.Map String Key
def :: [Command]
-def = [dontCheck fromOpt $ command "dropunused" (paramRepeating paramNumber)
- seek "drop unused file content"]
+def = [withOptions [Command.Drop.fromOption] $
+ command "dropunused" (paramRepeating paramNumber)
+ seek "drop unused file content"]
seek :: [CommandSeek]
seek = [withUnusedMaps]
@@ -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
diff --git a/Command/Find.hs b/Command/Find.hs
index c86db5fa6..eb0267c14 100644
--- a/Command/Find.hs
+++ b/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"
+formatOption :: Option
+formatOption = fieldOption [] "format" paramFormat "control format of output"
+
seek :: [CommandSeek]
-seek = [withFilesInGit $ whenAnnexed start]
+seek = [withField "format" formatconverter $ \f ->
+ withFilesInGit $ whenAnnexed $ start f]
+ where
+ formatconverter = maybe Nothing (Just . Utility.Format.gen)
-start :: FilePath -> (Key, Backend) -> CommandStart
-start file (key, _) = do
+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
- f <- Annex.getState Annex.format
- case f of
+ unlessM (showFullJSON vars) $
+ case format of
Nothing -> liftIO $ putStrLn file
Just formatter -> liftIO $ putStr $
Utility.Format.format formatter $
diff --git a/Command/Get.hs b/Command/Get.hs
index f2b70baeb..4a50fe3fe 100644
--- a/Command/Get.hs
+++ b/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 numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
+start :: Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
+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
diff --git a/Command/Move.hs b/Command/Move.hs
index bd1490b0c..66a0c1660 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -16,18 +16,25 @@ import qualified Remote
import Annex.UUID
def :: [Command]
-def = [dontCheck toOpt $ dontCheck fromOpt $
- command "move" paramPaths seek
+def = [withOptions options $ command "move" paramPaths seek
"move content of files to/from another repository"]
+fromOption :: Option
+fromOption = fieldOption ['f'] "from" paramRemote "source remote"
+
+toOption :: Option
+toOption = fieldOption ['t'] "to" paramRemote "destination remote"
+
+options :: [Option]
+options = [fromOption, toOption]
+
seek :: [CommandSeek]
-seek = [withFilesInGit $ whenAnnexed $ start True]
+seek = [withField "to" id $ \to -> withField "from" id $ \from ->
+ withFilesInGit $ whenAnnexed $ start to from True]
-start :: Bool -> FilePath -> (Key, Backend) -> CommandStart
-start move file (key, _) = do
+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
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 8d45c51cb..59efe64c8 100644
--- a/Command/Unused.hs
+++ b/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)
diff --git a/GitAnnex.hs b/GitAnnex.hs
index 3ce451810..8af1d5d59 100644
--- a/GitAnnex.hs
+++ b/GitAnnex.hs
@@ -94,11 +94,7 @@ cmds = concat
options :: [Option]
options = commonOptions ++
- [ Option ['t'] ["to"] (ReqArg setto paramRemote)
- "specify to where to transfer content"
- , Option ['f'] ["from"] (ReqArg setfrom paramRemote)
- "specify from where to transfer content"
- , Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
+ [ 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
diff --git a/Options.hs b/Options.hs
index fa008d064..56f0bc0ee 100644
--- a/Options.hs
+++ b/Options.hs
@@ -8,8 +8,8 @@
module Options (
commonOptions,
matcherOptions,
- formatOption,
- setFormat,
+ flagOption,
+ 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
-formatOption = Option [] ["format"] (ReqArg setFormat paramFormat)
- "control format of output"
+{- An option that sets a flag. -}
+flagOption :: String -> String -> String -> Option
+flagOption short flag description =
+ Option short [flag] (NoArg (Annex.setFlag flag)) description
-setFormat :: String -> Annex ()
-setFormat v = Annex.changeState $ \s ->
- s { Annex.format = Just $ Utility.Format.gen v }
+{- An option that sets a field. -}
+fieldOption :: String -> String -> String -> String -> Option
+fieldOption short field paramdesc description =
+ Option short [field] (ReqArg (Annex.setField field) paramdesc) description
diff --git a/Seek.hs b/Seek.hs
index 80f31dd96..af074c7c5 100644
--- a/Seek.hs
+++ b/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."
diff --git a/Usage.hs b/Usage.hs
index 428a53fde..308ade798 100644
--- a/Usage.hs
+++ b/Usage.hs
@@ -66,6 +66,8 @@ paramGlob :: String
paramGlob = "GLOB"
paramName :: String
paramName = "NAME"
+paramValue :: String
+paramValue = "VALUE"
paramUUID :: String
paramUUID = "UUID"
paramType :: String