From df21cbfdd2b7342c206ebd4aea32d989328374dc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 6 Jan 2012 04:02:35 -0400 Subject: look up --to and --from remote names only once This will speed up commands like move and drop. --- Command/DropUnused.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'Command/DropUnused.hs') diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index fd3e84fe5..1c5bf8b8c 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -51,10 +51,9 @@ start (unused, unusedbad, unusedtmp) s = search next $ a key perform :: Key -> CommandPerform -perform key = maybe droplocal dropremote =<< Annex.getField "from" +perform key = maybe droplocal dropremote =<< Remote.byName =<< Annex.getField "from" where - dropremote name = do - r <- Remote.byName name + dropremote r = do showAction $ "from " ++ Remote.name r ok <- Remote.removeKey r key next $ Command.Drop.cleanupRemote key r ok -- cgit v1.2.3 From 1f8a1058c96bd4ee11fcb353f0ede1842d79ab6a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 6 Jan 2012 10:14:37 -0400 Subject: tweak --- Command.hs | 1 - Command/Copy.hs | 4 +-- Command/Drop.hs | 5 ++-- Command/DropUnused.hs | 4 ++- Command/Find.hs | 13 +++++---- Command/Get.hs | 4 +-- Command/Move.hs | 9 +++--- Command/Unused.hs | 5 ++-- GitAnnex.hs | 5 ++-- Option.hs | 79 +++++++++++++++++++++++++++++++++++++++++++++++++++ Options.hs | 75 ------------------------------------------------ Seek.hs | 9 +++--- Types.hs | 4 ++- Types/Command.hs | 1 - git-annex-shell.hs | 3 +- 15 files changed, 118 insertions(+), 103 deletions(-) create mode 100644 Option.hs delete mode 100644 Options.hs (limited to 'Command/DropUnused.hs') diff --git a/Command.hs b/Command.hs index b287629ae..82d6429bf 100644 --- a/Command.hs +++ b/Command.hs @@ -30,7 +30,6 @@ import Types.Command as ReExported import Types.Option as ReExported import Seek as ReExported import Checks as ReExported -import Options as ReExported import Usage as ReExported import Logs.Trust import Logs.Location diff --git a/Command/Copy.hs b/Command/Copy.hs index c83c72412..32b83a526 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -17,8 +17,8 @@ def = [withOptions Command.Move.options $ command "copy" paramPaths seek "copy content of files to/from another repository"] seek :: [CommandSeek] -seek = [withField "to" Remote.byName $ \to -> - withField "from" Remote.byName $ \from -> +seek = [withField Command.Move.toOption Remote.byName $ \to -> + withField Command.Move.fromOption Remote.byName $ \from -> withNumCopies $ \n -> whenAnnexed $ start to from n] -- A copy is just a move that does not delete the source file. diff --git a/Command/Drop.hs b/Command/Drop.hs index 07ea50df1..578ab62b9 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -16,16 +16,17 @@ import Logs.Location import Logs.Trust import Annex.Content import Config +import qualified Option def :: [Command] 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" +fromOption = Option.field ['f'] "from" paramRemote "drop content from a remote" seek :: [CommandSeek] -seek = [withField "from" Remote.byName $ \from -> withNumCopies $ \n -> +seek = [withField fromOption Remote.byName $ \from -> withNumCopies $ \n -> whenAnnexed $ start from n] start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 1c5bf8b8c..0b2a60216 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -15,6 +15,7 @@ import qualified Annex import qualified Command.Drop import qualified Remote import qualified Git +import qualified Option import Types.Key type UnusedMap = M.Map String Key @@ -51,13 +52,14 @@ start (unused, unusedbad, unusedtmp) s = search next $ a key perform :: Key -> CommandPerform -perform key = maybe droplocal dropremote =<< Remote.byName =<< Annex.getField "from" +perform key = maybe droplocal dropremote =<< Remote.byName =<< from where dropremote r = do showAction $ "from " ++ Remote.name r ok <- Remote.removeKey r key next $ Command.Drop.cleanupRemote key r ok 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 filespec key = do diff --git a/Command/Find.hs b/Command/Find.hs index 8760cc947..902f50d2e 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -17,20 +17,23 @@ import qualified Annex import qualified Utility.Format import Utility.DataUnits import Types.Key +import qualified Option def :: [Command] def = [withOptions [formatOption, print0Option] $ command "find" paramPaths seek "lists available files"] +formatOption :: Option +formatOption = Option.field [] "format" paramFormat "control format of output" + print0Option :: Option -print0Option = Option [] ["print0"] (NoArg $ Annex.setField "format" "${file}\0") +print0Option = Option.Option [] ["print0"] (Option.NoArg set) "terminate output with null" - -formatOption :: Option -formatOption = fieldOption [] "format" paramFormat "control format of output" + where + set = Annex.setField (Option.name formatOption) "${file}\0" seek :: [CommandSeek] -seek = [withField "format" formatconverter $ \f -> +seek = [withField formatOption formatconverter $ \f -> withFilesInGit $ whenAnnexed $ start f] where formatconverter = return . maybe Nothing (Just . Utility.Format.gen) diff --git a/Command/Get.hs b/Command/Get.hs index 1a0435c36..5d032e13c 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -18,8 +18,8 @@ def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek "make content of annexed files available"] seek :: [CommandSeek] -seek = [withField "from" Remote.byName $ \from -> withNumCopies $ \n -> - whenAnnexed $ start from n] +seek = [withField Command.Move.fromOption Remote.byName $ \from -> + withNumCopies $ \n -> whenAnnexed $ start from n] start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $ diff --git a/Command/Move.hs b/Command/Move.hs index 4978283bf..2efaebbcb 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -14,23 +14,24 @@ import qualified Annex import Annex.Content import qualified Remote import Annex.UUID +import qualified Option def :: [Command] def = [withOptions options $ command "move" paramPaths seek "move content of files to/from another repository"] fromOption :: Option -fromOption = fieldOption ['f'] "from" paramRemote "source remote" +fromOption = Option.field ['f'] "from" paramRemote "source remote" toOption :: Option -toOption = fieldOption ['t'] "to" paramRemote "destination remote" +toOption = Option.field ['t'] "to" paramRemote "destination remote" options :: [Option] options = [fromOption, toOption] seek :: [CommandSeek] -seek = [withField "to" Remote.byName $ \to -> - withField "from" Remote.byName $ \from -> +seek = [withField toOption Remote.byName $ \to -> + withField fromOption Remote.byName $ \from -> withFilesInGit $ whenAnnexed $ start to from True] start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart diff --git a/Command/Unused.hs b/Command/Unused.hs index a6883dce1..ffd4bef45 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -27,6 +27,7 @@ import qualified Git.LsTree as LsTree import qualified Backend import qualified Remote import qualified Annex.Branch +import qualified Option import Annex.CatFile def :: [Command] @@ -34,7 +35,7 @@ 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" +fromOption = Option.field ['f'] "from" paramRemote "remote to check for unused content" seek :: [CommandSeek] seek = [withNothing $ start] @@ -42,7 +43,7 @@ seek = [withNothing $ start] {- Finds unused content in the annex. -} start :: CommandStart start = do - from <- Annex.getField "from" + from <- Annex.getField $ Option.name fromOption let (name, action) = case from of Nothing -> (".", checkUnused) Just "." -> (".", checkUnused) diff --git a/GitAnnex.hs b/GitAnnex.hs index 8af1d5d59..64020754f 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -18,6 +18,7 @@ import Types.TrustLevel import qualified Annex import qualified Remote import qualified Limit +import qualified Option import qualified Command.Add import qualified Command.Unannex @@ -93,7 +94,7 @@ cmds = concat ] options :: [Option] -options = commonOptions ++ +options = Option.common ++ [ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber) "override default number of copies" , Option [] ["trust"] (ReqArg (Remote.forceTrust Trusted) paramRemote) @@ -114,7 +115,7 @@ options = commonOptions ++ "skip files with fewer copies" , Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName) "skip files not using a key-value backend" - ] ++ matcherOptions + ] ++ Option.matcher where setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v } setgitconfig :: String -> Annex () diff --git a/Option.hs b/Option.hs new file mode 100644 index 000000000..d6d8b44a3 --- /dev/null +++ b/Option.hs @@ -0,0 +1,79 @@ +{- git-annex command-line options + - + - Copyright 2010-2011 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Option ( + common, + matcher, + flag, + field, + name, + ArgDescr(..), + OptDescr(..), +) where + +import System.Console.GetOpt +import System.Log.Logger + +import Common.Annex +import qualified Annex +import Limit +import Usage + +common :: [Option] +common = + [ Option [] ["force"] (NoArg (setforce True)) + "allow actions that may lose annexed data" + , Option ['F'] ["fast"] (NoArg (setfast True)) + "avoid slow operations" + , Option ['a'] ["auto"] (NoArg (setauto True)) + "automatic mode" + , Option ['q'] ["quiet"] (NoArg (setoutput Annex.QuietOutput)) + "avoid verbose output" + , Option ['v'] ["verbose"] (NoArg (setoutput Annex.NormalOutput)) + "allow verbose output (default)" + , Option ['j'] ["json"] (NoArg (setoutput Annex.JSONOutput)) + "enable JSON output" + , Option ['d'] ["debug"] (NoArg (setdebug)) + "show debug messages" + , Option ['b'] ["backend"] (ReqArg setforcebackend paramName) + "specify key-value backend to use" + ] + where + setforce v = Annex.changeState $ \s -> s { Annex.force = v } + setfast v = Annex.changeState $ \s -> s { Annex.fast = v } + setauto v = Annex.changeState $ \s -> s { Annex.auto = v } + setoutput v = Annex.changeState $ \s -> s { Annex.output = v } + setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v } + setdebug = liftIO $ updateGlobalLogger rootLoggerName $ + setLevel DEBUG + +matcher :: [Option] +matcher = + [ longopt "not" "negate next option" + , longopt "and" "both previous and next option must match" + , longopt "or" "either previous or next option must match" + , shortopt "(" "open group of options" + , shortopt ")" "close group of options" + ] + where + longopt o = Option [] [o] $ NoArg $ addToken o + shortopt o = Option o [] $ NoArg $ addToken o + +{- An option that sets a flag. -} +flag :: String -> String -> String -> Option +flag short opt description = + Option short [opt] (NoArg (Annex.setFlag opt)) description + +{- An option that sets a field. -} +field :: String -> String -> String -> String -> Option +field short opt 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 + diff --git a/Options.hs b/Options.hs deleted file mode 100644 index 56f0bc0ee..000000000 --- a/Options.hs +++ /dev/null @@ -1,75 +0,0 @@ -{- git-annex command-line options - - - - Copyright 2010-2011 Joey Hess - - - - Licensed under the GNU GPL version 3 or higher. - -} - -module Options ( - commonOptions, - matcherOptions, - flagOption, - fieldOption, - ArgDescr(..), - Option, - OptDescr(..), -) where - -import System.Console.GetOpt -import System.Log.Logger - -import Common.Annex -import qualified Annex -import Limit -import Types.Option -import Usage - -commonOptions :: [Option] -commonOptions = - [ Option [] ["force"] (NoArg (setforce True)) - "allow actions that may lose annexed data" - , Option ['F'] ["fast"] (NoArg (setfast True)) - "avoid slow operations" - , Option ['a'] ["auto"] (NoArg (setauto True)) - "automatic mode" - , Option ['q'] ["quiet"] (NoArg (setoutput Annex.QuietOutput)) - "avoid verbose output" - , Option ['v'] ["verbose"] (NoArg (setoutput Annex.NormalOutput)) - "allow verbose output (default)" - , Option ['j'] ["json"] (NoArg (setoutput Annex.JSONOutput)) - "enable JSON output" - , Option ['d'] ["debug"] (NoArg (setdebug)) - "show debug messages" - , Option ['b'] ["backend"] (ReqArg setforcebackend paramName) - "specify key-value backend to use" - ] - where - setforce v = Annex.changeState $ \s -> s { Annex.force = v } - setfast v = Annex.changeState $ \s -> s { Annex.fast = v } - setauto v = Annex.changeState $ \s -> s { Annex.auto = v } - setoutput v = Annex.changeState $ \s -> s { Annex.output = v } - setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v } - setdebug = liftIO $ updateGlobalLogger rootLoggerName $ - setLevel DEBUG - -matcherOptions :: [Option] -matcherOptions = - [ longopt "not" "negate next option" - , longopt "and" "both previous and next option must match" - , longopt "or" "either previous or next option must match" - , shortopt "(" "open group of options" - , shortopt ")" "close group of options" - ] - where - longopt o = Option [] [o] $ NoArg $ addToken o - shortopt o = Option o [] $ NoArg $ addToken o - -{- An option that sets a flag. -} -flagOption :: String -> String -> String -> Option -flagOption short flag description = - Option short [flag] (NoArg (Annex.setFlag flag)) description - -{- 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 53101b23e..fdb117de0 100644 --- a/Seek.hs +++ b/Seek.hs @@ -20,6 +20,7 @@ import qualified Git import qualified Git.LsFiles as LsFiles import qualified Git.CheckAttr import qualified Limit +import qualified Option seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath] seekHelper a params = do @@ -87,13 +88,13 @@ 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 +{- 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. - This ensures that the conversion function only runs once. -} -withField :: String -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek -withField field converter a ps = do - f <- converter =<< Annex.getField field +withField :: Option -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek +withField option converter a ps = do + f <- converter =<< Annex.getField (Option.name option) a f ps withNothing :: CommandStart -> CommandSeek diff --git a/Types.hs b/Types.hs index c8839b7eb..4c16fb8f4 100644 --- a/Types.hs +++ b/Types.hs @@ -11,7 +11,8 @@ module Types ( Key, UUID(..), Remote, - RemoteType + RemoteType, + Option ) where import Annex @@ -19,6 +20,7 @@ import Types.Backend import Types.Key import Types.UUID import Types.Remote +import Types.Option type Backend = BackendA Annex type Remote = RemoteA Annex diff --git a/Types/Command.hs b/Types/Command.hs index b173b61c9..1233df2cd 100644 --- a/Types/Command.hs +++ b/Types/Command.hs @@ -8,7 +8,6 @@ module Types.Command where import Types -import Types.Option {- A command runs in these stages. - diff --git a/git-annex-shell.hs b/git-annex-shell.hs index 1ff0bba44..4fdeae1a8 100644 --- a/git-annex-shell.hs +++ b/git-annex-shell.hs @@ -13,6 +13,7 @@ import qualified Git.Construct import CmdLine import Command import Annex.UUID +import qualified Option import qualified Command.ConfigList import qualified Command.InAnnex @@ -41,7 +42,7 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly } options :: [OptDescr (Annex ())] -options = commonOptions ++ +options = Option.common ++ [ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "repository uuid" ] where -- cgit v1.2.3