This commit is contained in:
Joey Hess 2012-01-06 10:14:37 -04:00
parent df21cbfdd2
commit 1f8a1058c9
14 changed files with 62 additions and 47 deletions

View file

@ -30,7 +30,6 @@ import Types.Command as ReExported
import Types.Option as ReExported import Types.Option as ReExported
import Seek as ReExported import Seek as ReExported
import Checks as ReExported import Checks as ReExported
import Options as ReExported
import Usage as ReExported import Usage as ReExported
import Logs.Trust import Logs.Trust
import Logs.Location import Logs.Location

View file

@ -17,8 +17,8 @@ def = [withOptions Command.Move.options $ 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 = [withField "to" Remote.byName $ \to -> seek = [withField Command.Move.toOption Remote.byName $ \to ->
withField "from" Remote.byName $ \from -> withField Command.Move.fromOption Remote.byName $ \from ->
withNumCopies $ \n -> whenAnnexed $ start to from n] 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.

View file

@ -16,16 +16,17 @@ import Logs.Location
import Logs.Trust import Logs.Trust
import Annex.Content import Annex.Content
import Config import Config
import qualified Option
def :: [Command] def :: [Command]
def = [withOptions [fromOption] $ 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"]
fromOption :: Option fromOption :: Option
fromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote" fromOption = Option.field ['f'] "from" paramRemote "drop content from a remote"
seek :: [CommandSeek] seek :: [CommandSeek]
seek = [withField "from" Remote.byName $ \from -> withNumCopies $ \n -> seek = [withField fromOption Remote.byName $ \from -> withNumCopies $ \n ->
whenAnnexed $ start from n] whenAnnexed $ start from n]
start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart

View file

@ -15,6 +15,7 @@ import qualified Annex
import qualified Command.Drop import qualified Command.Drop
import qualified Remote import qualified Remote
import qualified Git import qualified Git
import qualified Option
import Types.Key import Types.Key
type UnusedMap = M.Map String Key type UnusedMap = M.Map String Key
@ -51,13 +52,14 @@ start (unused, unusedbad, unusedtmp) s = search
next $ a key next $ a key
perform :: Key -> CommandPerform perform :: Key -> CommandPerform
perform key = maybe droplocal dropremote =<< Remote.byName =<< Annex.getField "from" perform key = maybe droplocal dropremote =<< Remote.byName =<< from
where where
dropremote r = do dropremote r = do
showAction $ "from " ++ Remote.name r showAction $ "from " ++ Remote.name r
ok <- Remote.removeKey r key ok <- Remote.removeKey r key
next $ Command.Drop.cleanupRemote key r ok next $ Command.Drop.cleanupRemote key r ok
droplocal = Command.Drop.performLocal key (Just 0) -- force drop droplocal = Command.Drop.performLocal key (Just 0) -- force drop
from = Annex.getField $ Option.name Command.Drop.fromOption
performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
performOther filespec key = do performOther filespec key = do

View file

@ -17,20 +17,23 @@ import qualified Annex
import qualified Utility.Format import qualified Utility.Format
import Utility.DataUnits import Utility.DataUnits
import Types.Key import Types.Key
import qualified Option
def :: [Command] def :: [Command]
def = [withOptions [formatOption, print0Option] $ def = [withOptions [formatOption, print0Option] $
command "find" paramPaths seek "lists available files"] command "find" paramPaths seek "lists available files"]
print0Option :: Option
print0Option = Option [] ["print0"] (NoArg $ Annex.setField "format" "${file}\0")
"terminate output with null"
formatOption :: Option formatOption :: Option
formatOption = fieldOption [] "format" paramFormat "control format of output" formatOption = Option.field [] "format" paramFormat "control format of output"
print0Option :: Option
print0Option = Option.Option [] ["print0"] (Option.NoArg set)
"terminate output with null"
where
set = Annex.setField (Option.name formatOption) "${file}\0"
seek :: [CommandSeek] seek :: [CommandSeek]
seek = [withField "format" formatconverter $ \f -> seek = [withField formatOption formatconverter $ \f ->
withFilesInGit $ whenAnnexed $ start f] withFilesInGit $ whenAnnexed $ start f]
where where
formatconverter = return . maybe Nothing (Just . Utility.Format.gen) formatconverter = return . maybe Nothing (Just . Utility.Format.gen)

View file

@ -18,8 +18,8 @@ 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 = [withField "from" Remote.byName $ \from -> withNumCopies $ \n -> seek = [withField Command.Move.fromOption Remote.byName $ \from ->
whenAnnexed $ start from n] withNumCopies $ \n -> whenAnnexed $ start from n]
start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $ start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $

View file

@ -14,23 +14,24 @@ import qualified Annex
import Annex.Content import Annex.Content
import qualified Remote import qualified Remote
import Annex.UUID import Annex.UUID
import qualified Option
def :: [Command] def :: [Command]
def = [withOptions options $ command "move" paramPaths seek def = [withOptions options $ command "move" paramPaths seek
"move content of files to/from another repository"] "move content of files to/from another repository"]
fromOption :: Option fromOption :: Option
fromOption = fieldOption ['f'] "from" paramRemote "source remote" fromOption = Option.field ['f'] "from" paramRemote "source remote"
toOption :: Option toOption :: Option
toOption = fieldOption ['t'] "to" paramRemote "destination remote" toOption = Option.field ['t'] "to" paramRemote "destination remote"
options :: [Option] options :: [Option]
options = [fromOption, toOption] options = [fromOption, toOption]
seek :: [CommandSeek] seek :: [CommandSeek]
seek = [withField "to" Remote.byName $ \to -> seek = [withField toOption Remote.byName $ \to ->
withField "from" Remote.byName $ \from -> withField fromOption Remote.byName $ \from ->
withFilesInGit $ whenAnnexed $ start to from True] withFilesInGit $ whenAnnexed $ start to from True]
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart

View file

@ -27,6 +27,7 @@ import qualified Git.LsTree as LsTree
import qualified Backend import qualified Backend
import qualified Remote import qualified Remote
import qualified Annex.Branch import qualified Annex.Branch
import qualified Option
import Annex.CatFile import Annex.CatFile
def :: [Command] def :: [Command]
@ -34,7 +35,7 @@ def = [withOptions [fromOption] $ command "unused" paramNothing seek
"look for unused file content"] "look for unused file content"]
fromOption :: Option fromOption :: Option
fromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content" fromOption = Option.field ['f'] "from" paramRemote "remote to check for unused content"
seek :: [CommandSeek] seek :: [CommandSeek]
seek = [withNothing $ start] seek = [withNothing $ start]
@ -42,7 +43,7 @@ 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.getField "from" from <- Annex.getField $ Option.name fromOption
let (name, action) = case from of let (name, action) = case from of
Nothing -> (".", checkUnused) Nothing -> (".", checkUnused)
Just "." -> (".", checkUnused) Just "." -> (".", checkUnused)

View file

@ -18,6 +18,7 @@ import Types.TrustLevel
import qualified Annex import qualified Annex
import qualified Remote import qualified Remote
import qualified Limit import qualified Limit
import qualified Option
import qualified Command.Add import qualified Command.Add
import qualified Command.Unannex import qualified Command.Unannex
@ -93,7 +94,7 @@ cmds = concat
] ]
options :: [Option] options :: [Option]
options = commonOptions ++ options = Option.common ++
[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber) [ 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)
@ -114,7 +115,7 @@ options = commonOptions ++
"skip files with fewer copies" "skip files with fewer copies"
, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName) , Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)
"skip files not using a key-value backend" "skip files not using a key-value backend"
] ++ matcherOptions ] ++ Option.matcher
where where
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 ()

View file

@ -5,13 +5,13 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
module Options ( module Option (
commonOptions, common,
matcherOptions, matcher,
flagOption, flag,
fieldOption, field,
name,
ArgDescr(..), ArgDescr(..),
Option,
OptDescr(..), OptDescr(..),
) where ) where
@ -21,11 +21,10 @@ import System.Log.Logger
import Common.Annex import Common.Annex
import qualified Annex import qualified Annex
import Limit import Limit
import Types.Option
import Usage import Usage
commonOptions :: [Option] common :: [Option]
commonOptions = common =
[ Option [] ["force"] (NoArg (setforce True)) [ Option [] ["force"] (NoArg (setforce True))
"allow actions that may lose annexed data" "allow actions that may lose annexed data"
, Option ['F'] ["fast"] (NoArg (setfast True)) , Option ['F'] ["fast"] (NoArg (setfast True))
@ -51,9 +50,9 @@ commonOptions =
setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v } setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
setdebug = liftIO $ updateGlobalLogger rootLoggerName $ setdebug = liftIO $ updateGlobalLogger rootLoggerName $
setLevel DEBUG setLevel DEBUG
matcherOptions :: [Option] matcher :: [Option]
matcherOptions = matcher =
[ longopt "not" "negate next option" [ longopt "not" "negate next option"
, longopt "and" "both previous and next option must match" , longopt "and" "both previous and next option must match"
, longopt "or" "either previous or next option must match" , longopt "or" "either previous or next option must match"
@ -65,11 +64,16 @@ matcherOptions =
shortopt o = Option o [] $ NoArg $ addToken o shortopt o = Option o [] $ NoArg $ addToken o
{- An option that sets a flag. -} {- An option that sets a flag. -}
flagOption :: String -> String -> String -> Option flag :: String -> String -> String -> Option
flagOption short flag description = flag short opt description =
Option short [flag] (NoArg (Annex.setFlag flag)) description Option short [opt] (NoArg (Annex.setFlag opt)) description
{- An option that sets a field. -} {- An option that sets a field. -}
fieldOption :: String -> String -> String -> String -> Option field :: String -> String -> String -> String -> Option
fieldOption short field paramdesc description = field short opt paramdesc description =
Option short [field] (ReqArg (Annex.setField field) paramdesc) description Option short [opt] (ReqArg (Annex.setField opt) paramdesc) description
{- The flag or field name used for an option. -}
name :: Option -> String
name (Option _ o _ _) = Prelude.head o

View file

@ -20,6 +20,7 @@ import qualified Git
import qualified Git.LsFiles as LsFiles import qualified Git.LsFiles as LsFiles
import qualified Git.CheckAttr import qualified Git.CheckAttr
import qualified Limit import qualified Limit
import qualified Option
seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath] seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
seekHelper a params = do seekHelper a params = do
@ -87,13 +88,13 @@ 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 {- Modifies a seek action using the value of a field option, which is fed into
- a conversion function, and then is passed into the seek action. - a conversion function, and then is passed into the seek action.
- This ensures that the conversion function only runs once. - This ensures that the conversion function only runs once.
-} -}
withField :: String -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek withField :: Option -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek
withField field converter a ps = do withField option converter a ps = do
f <- converter =<< Annex.getField field f <- converter =<< Annex.getField (Option.name option)
a f ps a f ps
withNothing :: CommandStart -> CommandSeek withNothing :: CommandStart -> CommandSeek

View file

@ -11,7 +11,8 @@ module Types (
Key, Key,
UUID(..), UUID(..),
Remote, Remote,
RemoteType RemoteType,
Option
) where ) where
import Annex import Annex
@ -19,6 +20,7 @@ import Types.Backend
import Types.Key import Types.Key
import Types.UUID import Types.UUID
import Types.Remote import Types.Remote
import Types.Option
type Backend = BackendA Annex type Backend = BackendA Annex
type Remote = RemoteA Annex type Remote = RemoteA Annex

View file

@ -8,7 +8,6 @@
module Types.Command where module Types.Command where
import Types import Types
import Types.Option
{- A command runs in these stages. {- A command runs in these stages.
- -

View file

@ -13,6 +13,7 @@ import qualified Git.Construct
import CmdLine import CmdLine
import Command import Command
import Annex.UUID import Annex.UUID
import qualified Option
import qualified Command.ConfigList import qualified Command.ConfigList
import qualified Command.InAnnex import qualified Command.InAnnex
@ -41,7 +42,7 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
} }
options :: [OptDescr (Annex ())] options :: [OptDescr (Annex ())]
options = commonOptions ++ options = Option.common ++
[ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "repository uuid" [ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "repository uuid"
] ]
where where