per-command options
Finally commands can define their own options. Moved --format and --print0 to be options only of find.
This commit is contained in:
parent
47be4383b7
commit
ad43f03626
9 changed files with 162 additions and 87 deletions
41
CmdLine.hs
41
CmdLine.hs
|
@ -29,7 +29,7 @@ type Flags = [Annex ()]
|
||||||
|
|
||||||
{- Runs the passed command line. -}
|
{- Runs the passed command line. -}
|
||||||
dispatch :: Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO ()
|
dispatch :: Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO ()
|
||||||
dispatch args cmds options header getgitrepo = do
|
dispatch args cmds commonoptions header getgitrepo = do
|
||||||
setupConsole
|
setupConsole
|
||||||
r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo)
|
r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo)
|
||||||
case r of
|
case r of
|
||||||
|
@ -41,37 +41,26 @@ dispatch args cmds options header getgitrepo = do
|
||||||
prepCommand cmd params
|
prepCommand cmd params
|
||||||
tryRun state' cmd $ [startup] ++ actions ++ [shutdown]
|
tryRun state' cmd $ [startup] ++ actions ++ [shutdown]
|
||||||
where
|
where
|
||||||
(flags, cmd, params) = parseCmd args cmds options header
|
(flags, cmd, params) = parseCmd args cmds commonoptions header
|
||||||
|
|
||||||
{- Parses command line, and returns actions to run to configure flags,
|
{- Parses command line, and returns actions to run to configure flags,
|
||||||
- the Command being run, and the remaining parameters for the command. -}
|
- the Command being run, and the remaining parameters for the command. -}
|
||||||
parseCmd :: Params -> [Command] -> [Option] -> String -> (Flags, Command, Params)
|
parseCmd :: Params -> [Command] -> [Option] -> String -> (Flags, Command, Params)
|
||||||
parseCmd argv cmds options header = check $ getOpt Permute options argv
|
parseCmd argv cmds commonoptions header
|
||||||
|
| name == Nothing = err "missing command"
|
||||||
|
| null matches = err $ "unknown command " ++ fromJust name
|
||||||
|
| otherwise = check $ getOpt Permute (commonoptions ++ cmdoptions cmd) args
|
||||||
where
|
where
|
||||||
check (_, [], []) = err "missing command"
|
(name, args) = findname argv []
|
||||||
check (flags, name:rest, [])
|
findname [] c = (Nothing, reverse c)
|
||||||
| null matches = err $ "unknown command " ++ name
|
findname (a:as) c
|
||||||
| otherwise = (flags, Prelude.head matches, rest)
|
| "-" `isPrefixOf` a = findname as (a:c)
|
||||||
where
|
| otherwise = (Just a, reverse c ++ as)
|
||||||
matches = filter (\c -> name == cmdname c) cmds
|
matches = filter (\c -> name == Just (cmdname c)) cmds
|
||||||
|
cmd = Prelude.head matches
|
||||||
|
check (flags, rest, []) = (flags, cmd, rest)
|
||||||
check (_, _, errs) = err $ concat errs
|
check (_, _, errs) = err $ concat errs
|
||||||
err msg = error $ msg ++ "\n\n" ++ usage header cmds options
|
err msg = error $ msg ++ "\n\n" ++ usage header cmds commonoptions
|
||||||
|
|
||||||
{- Usage message with lists of commands and options. -}
|
|
||||||
usage :: String -> [Command] -> [Option] -> String
|
|
||||||
usage header cmds options = usageInfo top options ++ commands
|
|
||||||
where
|
|
||||||
top = header ++ "\n\nOptions:"
|
|
||||||
commands = "\nCommands:\n" ++ cmddescs
|
|
||||||
cmddescs = unlines $ map (indent . showcmd) cmds
|
|
||||||
showcmd c =
|
|
||||||
cmdname c ++
|
|
||||||
pad (longest cmdname + 1) (cmdname c) ++
|
|
||||||
cmdparamdesc c ++
|
|
||||||
pad (longest cmdparamdesc + 2) (cmdparamdesc c) ++
|
|
||||||
cmddesc c
|
|
||||||
pad n s = replicate (n - length s) ' '
|
|
||||||
longest f = foldl max 0 $ map (length . f) cmds
|
|
||||||
|
|
||||||
{- Runs a list of Annex actions. Catches IO errors and continues
|
{- Runs a list of Annex actions. Catches IO errors and continues
|
||||||
- (but explicitly thrown errors terminate the whole command).
|
- (but explicitly thrown errors terminate the whole command).
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
module Command (
|
module Command (
|
||||||
command,
|
command,
|
||||||
noRepo,
|
noRepo,
|
||||||
|
withOptions,
|
||||||
next,
|
next,
|
||||||
stop,
|
stop,
|
||||||
stopUnless,
|
stopUnless,
|
||||||
|
@ -26,22 +27,28 @@ import qualified Backend
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Types.Command as ReExported
|
import Types.Command 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 Options as ReExported
|
||||||
|
import Usage as ReExported
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
import Logs.Location
|
import Logs.Location
|
||||||
import Config
|
import Config
|
||||||
|
|
||||||
{- Generates a normal command -}
|
{- Generates a normal command -}
|
||||||
command :: String -> String -> [CommandSeek] -> String -> Command
|
command :: String -> String -> [CommandSeek] -> String -> Command
|
||||||
command = Command Nothing commonChecks
|
command = Command [] Nothing commonChecks
|
||||||
|
|
||||||
{- Adds a fallback action to a command, that will be run if it's used
|
{- Adds a fallback action to a command, that will be run if it's used
|
||||||
- outside a git repository. -}
|
- outside a git repository. -}
|
||||||
noRepo :: IO () -> Command -> Command
|
noRepo :: IO () -> Command -> Command
|
||||||
noRepo a c = c { cmdnorepo = Just a }
|
noRepo a c = c { cmdnorepo = Just a }
|
||||||
|
|
||||||
|
{- Adds options to a command. -}
|
||||||
|
withOptions :: [Option] -> Command -> Command
|
||||||
|
withOptions o c = c { cmdoptions = o }
|
||||||
|
|
||||||
{- For start and perform stages to indicate what step to run next. -}
|
{- For start and perform stages to indicate what step to run next. -}
|
||||||
next :: a -> Annex (Maybe a)
|
next :: a -> Annex (Maybe a)
|
||||||
next a = return $ Just a
|
next a = return $ Just a
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- git-annex command
|
{- git-annex command
|
||||||
-
|
-
|
||||||
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
- Copyright 2010-2012 Joey Hess <joey@kitenet.net>
|
||||||
-
|
-
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
@ -19,7 +19,12 @@ import Utility.DataUnits
|
||||||
import Types.Key
|
import Types.Key
|
||||||
|
|
||||||
def :: [Command]
|
def :: [Command]
|
||||||
def = [command "find" paramPaths seek "lists available files"]
|
def = [withOptions [formatOption, print0Option] $
|
||||||
|
command "find" paramPaths seek "lists available files"]
|
||||||
|
|
||||||
|
print0Option :: Option
|
||||||
|
print0Option = Option [] ["print0"] (NoArg $ setFormat "${file}\0")
|
||||||
|
"terminate output with null"
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit $ whenAnnexed start]
|
seek = [withFilesInGit $ whenAnnexed start]
|
||||||
|
|
|
@ -144,9 +144,9 @@ bad_data_size = staleSize "bad keys size" gitAnnexBadDir
|
||||||
|
|
||||||
backend_usage :: Stat
|
backend_usage :: Stat
|
||||||
backend_usage = stat "backend usage" $ nojson $
|
backend_usage = stat "backend usage" $ nojson $
|
||||||
usage <$> cachedKeysReferenced <*> cachedKeysPresent
|
calc <$> cachedKeysReferenced <*> cachedKeysPresent
|
||||||
where
|
where
|
||||||
usage a b = pp "" $ reverse . sort $ map swap $ splits $ S.toList $ S.union a b
|
calc a b = pp "" $ reverse . sort $ map swap $ splits $ S.toList $ S.union a b
|
||||||
splits :: [Key] -> [(String, Integer)]
|
splits :: [Key] -> [(String, Integer)]
|
||||||
splits ks = M.toList $ M.fromListWith (+) $ map tcount ks
|
splits ks = M.toList $ M.fromListWith (+) $ map tcount ks
|
||||||
tcount k = (keyBackendName k, 1)
|
tcount k = (keyBackendName k, 1)
|
||||||
|
|
|
@ -18,7 +18,6 @@ import Types.TrustLevel
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Limit
|
import qualified Limit
|
||||||
import qualified Utility.Format
|
|
||||||
|
|
||||||
import qualified Command.Add
|
import qualified Command.Add
|
||||||
import qualified Command.Unannex
|
import qualified Command.Unannex
|
||||||
|
@ -109,10 +108,6 @@ options = commonOptions ++
|
||||||
"override trust setting to untrusted"
|
"override trust setting to untrusted"
|
||||||
, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")
|
, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")
|
||||||
"override git configuration setting"
|
"override git configuration setting"
|
||||||
, Option [] ["print0"] (NoArg setprint0)
|
|
||||||
"terminate output with null"
|
|
||||||
, Option [] ["format"] (ReqArg setformat paramFormat)
|
|
||||||
"control format of output"
|
|
||||||
, Option ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob)
|
, Option ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob)
|
||||||
"skip files matching the glob pattern"
|
"skip files matching the glob pattern"
|
||||||
, Option ['I'] ["include"] (ReqArg Limit.addInclude paramGlob)
|
, Option ['I'] ["include"] (ReqArg Limit.addInclude paramGlob)
|
||||||
|
@ -128,8 +123,6 @@ options = commonOptions ++
|
||||||
setto v = Annex.changeState $ \s -> s { Annex.toremote = Just v }
|
setto v = Annex.changeState $ \s -> s { Annex.toremote = Just v }
|
||||||
setfrom v = Annex.changeState $ \s -> s { Annex.fromremote = 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 }
|
||||||
setformat v = Annex.changeState $ \s -> s { Annex.format = Just $ Utility.Format.gen v }
|
|
||||||
setprint0 = setformat "${file}\0"
|
|
||||||
setgitconfig :: String -> Annex ()
|
setgitconfig :: String -> Annex ()
|
||||||
setgitconfig v = do
|
setgitconfig v = do
|
||||||
newg <- inRepo $ Git.Config.store v
|
newg <- inRepo $ Git.Config.store v
|
||||||
|
|
60
Options.hs
60
Options.hs
|
@ -5,7 +5,15 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Options where
|
module Options (
|
||||||
|
commonOptions,
|
||||||
|
matcherOptions,
|
||||||
|
formatOption,
|
||||||
|
setFormat,
|
||||||
|
ArgDescr(..),
|
||||||
|
Option,
|
||||||
|
OptDescr(..),
|
||||||
|
) where
|
||||||
|
|
||||||
import System.Console.GetOpt
|
import System.Console.GetOpt
|
||||||
import System.Log.Logger
|
import System.Log.Logger
|
||||||
|
@ -13,11 +21,9 @@ import System.Log.Logger
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Limit
|
import Limit
|
||||||
|
import Types.Option
|
||||||
{- Each dashed command-line option results in generation of an action
|
import Usage
|
||||||
- in the Annex monad that performs the necessary setting.
|
import qualified Utility.Format
|
||||||
-}
|
|
||||||
type Option = OptDescr (Annex ())
|
|
||||||
|
|
||||||
commonOptions :: [Option]
|
commonOptions :: [Option]
|
||||||
commonOptions =
|
commonOptions =
|
||||||
|
@ -59,38 +65,10 @@ 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
|
||||||
|
|
||||||
{- Descriptions of params used in usage messages. -}
|
formatOption :: Option
|
||||||
paramPaths :: String
|
formatOption = Option [] ["format"] (ReqArg setFormat paramFormat)
|
||||||
paramPaths = paramOptional $ paramRepeating paramPath -- most often used
|
"control format of output"
|
||||||
paramPath :: String
|
|
||||||
paramPath = "PATH"
|
setFormat :: String -> Annex ()
|
||||||
paramKey :: String
|
setFormat v = Annex.changeState $ \s ->
|
||||||
paramKey = "KEY"
|
s { Annex.format = Just $ Utility.Format.gen v }
|
||||||
paramDesc :: String
|
|
||||||
paramDesc = "DESC"
|
|
||||||
paramUrl :: String
|
|
||||||
paramUrl = "URL"
|
|
||||||
paramNumber :: String
|
|
||||||
paramNumber = "NUMBER"
|
|
||||||
paramRemote :: String
|
|
||||||
paramRemote = "REMOTE"
|
|
||||||
paramGlob :: String
|
|
||||||
paramGlob = "GLOB"
|
|
||||||
paramName :: String
|
|
||||||
paramName = "NAME"
|
|
||||||
paramUUID :: String
|
|
||||||
paramUUID = "UUID"
|
|
||||||
paramType :: String
|
|
||||||
paramType = "TYPE"
|
|
||||||
paramFormat :: String
|
|
||||||
paramFormat = "FORMAT"
|
|
||||||
paramKeyValue :: String
|
|
||||||
paramKeyValue = "K=V"
|
|
||||||
paramNothing :: String
|
|
||||||
paramNothing = ""
|
|
||||||
paramRepeating :: String -> String
|
|
||||||
paramRepeating s = s ++ " ..."
|
|
||||||
paramOptional :: String -> String
|
|
||||||
paramOptional s = "[" ++ s ++ "]"
|
|
||||||
paramPair :: String -> String -> String
|
|
||||||
paramPair a b = a ++ " " ++ b
|
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
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.
|
||||||
-
|
-
|
||||||
|
@ -32,14 +33,15 @@ type CommandPerform = Annex (Maybe CommandCleanup)
|
||||||
type CommandCleanup = Annex Bool
|
type CommandCleanup = Annex Bool
|
||||||
|
|
||||||
{- A command is defined by specifying these things. -}
|
{- A command is defined by specifying these things. -}
|
||||||
data Command = Command {
|
data Command = Command
|
||||||
cmdnorepo :: Maybe (IO ()), -- an action to run when not in a repo
|
{ cmdoptions :: [Option] -- command-specific options
|
||||||
cmdcheck :: [CommandCheck], -- check stage
|
, cmdnorepo :: Maybe (IO ()) -- an action to run when not in a repo
|
||||||
cmdname :: String,
|
, cmdcheck :: [CommandCheck] -- check stage
|
||||||
cmdparamdesc :: String, -- description of params for usage
|
, cmdname :: String
|
||||||
cmdseek :: [CommandSeek], -- seek stage
|
, cmdparamdesc :: String -- description of params for usage
|
||||||
cmddesc :: String -- description of command for usage
|
, cmdseek :: [CommandSeek] -- seek stage
|
||||||
}
|
, cmddesc :: String -- description of command for usage
|
||||||
|
}
|
||||||
|
|
||||||
{- CommandCheck functions can be compared using their unique id. -}
|
{- CommandCheck functions can be compared using their unique id. -}
|
||||||
instance Eq CommandCheck where
|
instance Eq CommandCheck where
|
||||||
|
|
17
Types/Option.hs
Normal file
17
Types/Option.hs
Normal file
|
@ -0,0 +1,17 @@
|
||||||
|
{- git-annex command options
|
||||||
|
-
|
||||||
|
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
||||||
|
-
|
||||||
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Types.Option where
|
||||||
|
|
||||||
|
import System.Console.GetOpt
|
||||||
|
|
||||||
|
import Annex
|
||||||
|
|
||||||
|
{- Each dashed command-line option results in generation of an action
|
||||||
|
- in the Annex monad that performs the necessary setting.
|
||||||
|
-}
|
||||||
|
type Option = OptDescr (Annex ())
|
84
Usage.hs
Normal file
84
Usage.hs
Normal file
|
@ -0,0 +1,84 @@
|
||||||
|
{- git-annex usage messages
|
||||||
|
-
|
||||||
|
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
|
||||||
|
-
|
||||||
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Usage where
|
||||||
|
|
||||||
|
import System.Console.GetOpt
|
||||||
|
|
||||||
|
import Types.Command
|
||||||
|
import Types.Option
|
||||||
|
|
||||||
|
{- Usage message with lists of commands and options. -}
|
||||||
|
usage :: String -> [Command] -> [Option] -> String
|
||||||
|
usage header cmds commonoptions = unlines $
|
||||||
|
[ header
|
||||||
|
, ""
|
||||||
|
, "Options:"
|
||||||
|
] ++ optlines ++
|
||||||
|
[ ""
|
||||||
|
, "Commands:"
|
||||||
|
, ""
|
||||||
|
] ++ cmdlines
|
||||||
|
where
|
||||||
|
-- To get consistent indentation of options, generate the
|
||||||
|
-- usage for all options at once. A command's options will
|
||||||
|
-- be displayed after the command.
|
||||||
|
alloptlines = filter (not . null) $
|
||||||
|
lines $ usageInfo "" $
|
||||||
|
concatMap cmdoptions cmds ++ commonoptions
|
||||||
|
(cmdlines, optlines) = go cmds alloptlines []
|
||||||
|
go [] os ls = (ls, os)
|
||||||
|
go (c:cs) os ls = go cs os' (ls++(l:o))
|
||||||
|
where
|
||||||
|
(o, os') = splitAt (length $ cmdoptions c) os
|
||||||
|
l = concat
|
||||||
|
[ cmdname c
|
||||||
|
, namepad (cmdname c)
|
||||||
|
, cmdparamdesc c
|
||||||
|
, descpad (cmdparamdesc c)
|
||||||
|
, cmddesc c
|
||||||
|
]
|
||||||
|
pad n s = replicate (n - length s) ' '
|
||||||
|
namepad = pad $ longest cmdname + 1
|
||||||
|
descpad = pad $ longest cmdparamdesc + 2
|
||||||
|
longest f = foldl max 0 $ map (length . f) cmds
|
||||||
|
|
||||||
|
{- Descriptions of params used in usage messages. -}
|
||||||
|
paramPaths :: String
|
||||||
|
paramPaths = paramOptional $ paramRepeating paramPath -- most often used
|
||||||
|
paramPath :: String
|
||||||
|
paramPath = "PATH"
|
||||||
|
paramKey :: String
|
||||||
|
paramKey = "KEY"
|
||||||
|
paramDesc :: String
|
||||||
|
paramDesc = "DESC"
|
||||||
|
paramUrl :: String
|
||||||
|
paramUrl = "URL"
|
||||||
|
paramNumber :: String
|
||||||
|
paramNumber = "NUMBER"
|
||||||
|
paramRemote :: String
|
||||||
|
paramRemote = "REMOTE"
|
||||||
|
paramGlob :: String
|
||||||
|
paramGlob = "GLOB"
|
||||||
|
paramName :: String
|
||||||
|
paramName = "NAME"
|
||||||
|
paramUUID :: String
|
||||||
|
paramUUID = "UUID"
|
||||||
|
paramType :: String
|
||||||
|
paramType = "TYPE"
|
||||||
|
paramFormat :: String
|
||||||
|
paramFormat = "FORMAT"
|
||||||
|
paramKeyValue :: String
|
||||||
|
paramKeyValue = "K=V"
|
||||||
|
paramNothing :: String
|
||||||
|
paramNothing = ""
|
||||||
|
paramRepeating :: String -> String
|
||||||
|
paramRepeating s = s ++ " ..."
|
||||||
|
paramOptional :: String -> String
|
||||||
|
paramOptional s = "[" ++ s ++ "]"
|
||||||
|
paramPair :: String -> String -> String
|
||||||
|
paramPair a b = a ++ " " ++ b
|
Loading…
Reference in a new issue