2013-03-27 17:51:24 +00:00
|
|
|
{- common command-line options
|
2010-12-30 20:52:24 +00:00
|
|
|
-
|
2015-01-21 16:50:09 +00:00
|
|
|
- Copyright 2010-2011 Joey Hess <id@joeyh.name>
|
2010-12-30 20:52:24 +00:00
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
2014-01-26 20:25:55 +00:00
|
|
|
module CmdLine.Option (
|
2015-07-10 04:55:53 +00:00
|
|
|
commonGlobalOptions,
|
2014-01-26 20:25:55 +00:00
|
|
|
flagOption,
|
|
|
|
fieldOption,
|
|
|
|
optionName,
|
2015-02-08 19:04:58 +00:00
|
|
|
optionParam,
|
2012-01-06 02:48:59 +00:00
|
|
|
ArgDescr(..),
|
|
|
|
OptDescr(..),
|
|
|
|
) where
|
2010-12-30 20:52:24 +00:00
|
|
|
|
2015-07-10 04:55:53 +00:00
|
|
|
import Options.Applicative
|
2010-12-30 20:52:24 +00:00
|
|
|
import System.Console.GetOpt
|
|
|
|
|
2011-10-05 20:02:51 +00:00
|
|
|
import Common.Annex
|
2015-07-10 04:55:53 +00:00
|
|
|
import CmdLine.Usage
|
2015-07-10 06:18:08 +00:00
|
|
|
import CmdLine.GlobalSetter
|
2010-12-30 20:52:24 +00:00
|
|
|
import qualified Annex
|
2012-04-27 17:23:52 +00:00
|
|
|
import Types.Messages
|
2015-07-10 04:55:53 +00:00
|
|
|
import Types.DeferredParse
|
2010-12-30 20:52:24 +00:00
|
|
|
|
2015-07-10 04:55:53 +00:00
|
|
|
-- Global options accepted by both git-annex and git-annex-shell sub-commands.
|
2015-07-10 17:18:46 +00:00
|
|
|
commonGlobalOptions :: [GlobalOption]
|
2015-07-10 06:03:03 +00:00
|
|
|
commonGlobalOptions =
|
2015-07-10 04:55:53 +00:00
|
|
|
[ globalFlag (setforce True)
|
|
|
|
( long "force"
|
|
|
|
<> help "allow actions that may lose annexed data"
|
2015-07-10 06:18:08 +00:00
|
|
|
<> hidden
|
2015-07-10 04:55:53 +00:00
|
|
|
)
|
|
|
|
, globalFlag (setfast True)
|
|
|
|
( long "fast" <> short 'F'
|
|
|
|
<> help "avoid slow operations"
|
2015-07-10 06:18:08 +00:00
|
|
|
<> hidden
|
2015-07-10 04:55:53 +00:00
|
|
|
)
|
|
|
|
, globalFlag (Annex.setOutput QuietOutput)
|
|
|
|
( long "quiet" <> short 'q'
|
|
|
|
<> help "avoid verbose output"
|
2015-07-10 06:18:08 +00:00
|
|
|
<> hidden
|
2015-07-10 04:55:53 +00:00
|
|
|
)
|
|
|
|
, globalFlag (Annex.setOutput NormalOutput)
|
|
|
|
( long "verbose" <> short 'v'
|
|
|
|
<> help "allow verbose output (default)"
|
2015-07-10 06:18:08 +00:00
|
|
|
<> hidden
|
2015-07-10 04:55:53 +00:00
|
|
|
)
|
|
|
|
, globalFlag setdebug
|
|
|
|
( long "debug" <> short 'd'
|
|
|
|
<> help "show debug messages"
|
2015-07-10 06:18:08 +00:00
|
|
|
<> hidden
|
2015-07-10 04:55:53 +00:00
|
|
|
)
|
|
|
|
, globalFlag unsetdebug
|
|
|
|
( long "no-debug"
|
|
|
|
<> help "don't show debug messages"
|
2015-07-10 06:18:08 +00:00
|
|
|
<> hidden
|
2015-07-10 04:55:53 +00:00
|
|
|
)
|
|
|
|
, globalSetter setforcebackend $ strOption
|
|
|
|
( long "backend" <> short 'b' <> metavar paramName
|
|
|
|
<> help "specify key-value backend to use"
|
2015-07-10 06:18:08 +00:00
|
|
|
<> hidden
|
2015-07-10 04:55:53 +00:00
|
|
|
)
|
2010-12-31 17:39:30 +00:00
|
|
|
]
|
2012-10-29 01:27:15 +00:00
|
|
|
where
|
|
|
|
setforce v = Annex.changeState $ \s -> s { Annex.force = v }
|
|
|
|
setfast v = Annex.changeState $ \s -> s { Annex.fast = v }
|
|
|
|
setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
|
2013-06-18 00:41:17 +00:00
|
|
|
setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True }
|
|
|
|
unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False }
|
2012-01-06 14:14:37 +00:00
|
|
|
|
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.
2012-01-06 07:06:25 +00:00
|
|
|
{- An option that sets a flag. -}
|
2014-01-26 20:25:55 +00:00
|
|
|
flagOption :: String -> String -> String -> Option
|
2015-07-10 04:55:53 +00:00
|
|
|
flagOption shortv opt description =
|
|
|
|
Option shortv [opt] (NoArg (Annex.setFlag opt)) description
|
2012-01-06 02:48:59 +00:00
|
|
|
|
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.
2012-01-06 07:06:25 +00:00
|
|
|
{- An option that sets a field. -}
|
2014-01-26 20:25:55 +00:00
|
|
|
fieldOption :: String -> String -> String -> String -> Option
|
2015-07-10 04:55:53 +00:00
|
|
|
fieldOption shortv opt paramdesc description =
|
|
|
|
Option shortv [opt] (ReqArg (Annex.setField opt) paramdesc) description
|
2012-01-06 14:14:37 +00:00
|
|
|
|
|
|
|
{- The flag or field name used for an option. -}
|
2014-01-26 20:25:55 +00:00
|
|
|
optionName :: Option -> String
|
|
|
|
optionName (Option _ o _ _) = Prelude.head o
|
2015-02-08 19:04:58 +00:00
|
|
|
|
|
|
|
optionParam :: Option -> String
|
|
|
|
optionParam o = "--" ++ optionName o
|