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.
This commit is contained in:
Joey Hess 2012-01-06 03:06:25 -04:00
parent 2051d80462
commit 0a36f92a31
13 changed files with 107 additions and 75 deletions

View file

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

View file

@ -13,24 +13,13 @@ module Checks where
import Common.Annex import Common.Annex
import Types.Command import Types.Command
import Init import Init
import qualified Annex
commonChecks :: [CommandCheck] commonChecks :: [CommandCheck]
commonChecks = [fromOpt, toOpt, repoExists] commonChecks = [repoExists]
repoExists :: CommandCheck repoExists :: CommandCheck
repoExists = CommandCheck 0 ensureInitialized 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 :: CommandCheck -> Command -> Command
dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c

View file

@ -12,15 +12,15 @@ import Command
import qualified Command.Move import qualified Command.Move
def :: [Command] 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"] "copy content of files to/from another repository"]
seek :: [CommandSeek] 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. -- A copy is just a move that does not delete the source file.
-- However, --auto mode avoids unnecessary copies. -- 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)

View file

@ -18,15 +18,18 @@ import Annex.Content
import Config import Config
def :: [Command] def :: [Command]
def = [dontCheck fromOpt $ command "drop" paramPaths seek def = [withOptions [fromOption] $ command "drop" paramPaths seek
"indicate content of files not currently wanted"] "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 case from of
Nothing -> startLocal file numcopies key Nothing -> startLocal file numcopies key
Just name -> do Just name -> do

View file

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

View file

@ -23,20 +23,25 @@ def = [withOptions [formatOption, print0Option] $
command "find" paramPaths seek "lists available files"] command "find" paramPaths seek "lists available files"]
print0Option :: Option print0Option :: Option
print0Option = Option [] ["print0"] (NoArg $ setFormat "${file}\0") print0Option = Option [] ["print0"] (NoArg $ Annex.setField "format" "${file}\0")
"terminate output with null" "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 -- only files inAnnex are shown, unless the user has requested
-- others via a limit -- others via a limit
whenM (liftM2 (||) limited (inAnnex key)) $ 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 Nothing -> liftIO $ putStrLn file
Just formatter -> liftIO $ putStr $ Just formatter -> liftIO $ putStr $
Utility.Format.format formatter $ Utility.Format.format formatter $

View file

@ -9,22 +9,21 @@ module Command.Get where
import Common.Annex import Common.Annex
import Command import Command
import qualified Annex
import qualified Remote import qualified Remote
import Annex.Content import Annex.Content
import qualified Command.Move import qualified Command.Move
def :: [Command] def :: [Command]
def = [dontCheck fromOpt $ command "get" paramPaths seek def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
"make content of annexed files available"] "make content of annexed files available"]
seek :: [CommandSeek] 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 autoCopies key (<) numcopies $ do
from <- Annex.getState Annex.fromremote
case from of case from of
Nothing -> go $ perform key Nothing -> go $ perform key
Just name -> do Just name -> do

View file

@ -16,18 +16,25 @@ import qualified Remote
import Annex.UUID import Annex.UUID
def :: [Command] 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"] "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 noAuto
to <- Annex.getState Annex.toremote
from <- Annex.getState Annex.fromremote
case (from, to) of case (from, to) of
(Nothing, Nothing) -> error "specify either --from or --to" (Nothing, Nothing) -> error "specify either --from or --to"
(Nothing, Just name) -> do (Nothing, Just name) -> do

View file

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

View file

@ -94,11 +94,7 @@ cmds = concat
options :: [Option] options :: [Option]
options = commonOptions ++ 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" "override default number of copies"
, Option [] ["trust"] (ReqArg (Remote.forceTrust Trusted) paramRemote) , Option [] ["trust"] (ReqArg (Remote.forceTrust Trusted) paramRemote)
"override trust setting" "override trust setting"
@ -120,8 +116,6 @@ options = commonOptions ++
"skip files not using a key-value backend" "skip files not using a key-value backend"
] ++ matcherOptions ] ++ matcherOptions
where 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 } setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v }
setgitconfig :: String -> Annex () setgitconfig :: String -> Annex ()
setgitconfig v = do setgitconfig v = do

View file

@ -8,8 +8,8 @@
module Options ( module Options (
commonOptions, commonOptions,
matcherOptions, matcherOptions,
formatOption, flagOption,
setFormat, fieldOption,
ArgDescr(..), ArgDescr(..),
Option, Option,
OptDescr(..), OptDescr(..),
@ -23,7 +23,6 @@ import qualified Annex
import Limit import Limit
import Types.Option import Types.Option
import Usage import Usage
import qualified Utility.Format
commonOptions :: [Option] commonOptions :: [Option]
commonOptions = commonOptions =
@ -65,10 +64,12 @@ matcherOptions =
longopt o = Option [] [o] $ NoArg $ addToken o longopt o = Option [] [o] $ NoArg $ addToken o
shortopt 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

View file

@ -87,6 +87,15 @@ withKeys a params = return $ map (a . parse) params
where where
parse p = fromMaybe (error "bad key") $ readKey p 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 :: CommandStart -> CommandSeek
withNothing a [] = return [a] withNothing a [] = return [a]
withNothing _ _ = error "This command takes no parameters." withNothing _ _ = error "This command takes no parameters."

View file

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