convert global options (still not used)
This commit is contained in:
Joey Hess
parent
820b92abab
commit
adb9fddfdd
6 changed files with 102 additions and 68 deletions
|
|
@ -33,8 +33,8 @@ import Command
|
|||
import Types.Messages
|
||||
|
||||
{- Runs the passed command line. -}
|
||||
dispatch :: Bool -> CmdParams -> [Command] -> [Option] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()
|
||||
dispatch fuzzyok allargs allcmds commonoptions fields getgitrepo progname progdesc = do
|
||||
dispatch :: Bool -> CmdParams -> [Command] -> Parser GlobalSetter -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()
|
||||
dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progdesc = do
|
||||
setupConsole
|
||||
go =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))
|
||||
where
|
||||
|
|
|
|||
|
|
@ -227,7 +227,7 @@ run args = do
|
|||
#endif
|
||||
go envmodes
|
||||
where
|
||||
go [] = dispatch True args cmds gitAnnexOptions [] Git.CurrentRepo.get
|
||||
go [] = dispatch True args cmds gitAnnexGlobalOptions [] Git.CurrentRepo.get
|
||||
"git-annex"
|
||||
"manage files with git, without checking their contents in"
|
||||
go ((v, a):rest) = maybe (go rest) a =<< getEnv v
|
||||
|
|
|
|||
|
|
@ -19,6 +19,7 @@ import Types.Messages
|
|||
import Types.Key
|
||||
import Types.Command
|
||||
import Types.DeferredParse
|
||||
import Types.DesktopNotify
|
||||
import qualified Annex
|
||||
import qualified Remote
|
||||
import qualified Limit
|
||||
|
|
@ -26,34 +27,55 @@ import qualified Limit.Wanted
|
|||
import CmdLine.Option
|
||||
import CmdLine.Usage
|
||||
|
||||
-- Options that are accepted by all git-annex sub-commands,
|
||||
-- Global options that are accepted by all git-annex sub-commands,
|
||||
-- although not always used.
|
||||
gitAnnexOptions :: [Option]
|
||||
gitAnnexOptions = commonOptions ++
|
||||
[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
|
||||
"override default number of copies"
|
||||
, Option [] ["trust"] (trustArg Trusted)
|
||||
"override trust setting"
|
||||
, Option [] ["semitrust"] (trustArg SemiTrusted)
|
||||
"override trust setting back to default"
|
||||
, Option [] ["untrust"] (trustArg UnTrusted)
|
||||
"override trust setting to untrusted"
|
||||
, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")
|
||||
"override git configuration setting"
|
||||
, Option [] ["user-agent"] (ReqArg setuseragent paramName)
|
||||
"override default User-Agent"
|
||||
, Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier"))
|
||||
"Trust Amazon Glacier inventory"
|
||||
gitAnnexGlobalOptions :: Parser GlobalSetter
|
||||
gitAnnexGlobalOptions = globalSetters
|
||||
[ commonGlobalOptions
|
||||
, globalSetter setnumcopies $ option auto
|
||||
( long "numcopies" <> short 'N' <> metavar paramNumber
|
||||
<> help "override default number of copies"
|
||||
)
|
||||
, globalSetter (Remote.forceTrust Trusted) $ strOption
|
||||
( long "trust" <> metavar paramRemote
|
||||
<> help "override trust setting"
|
||||
)
|
||||
, globalSetter (Remote.forceTrust SemiTrusted) $ strOption
|
||||
( long "semitrust" <> metavar paramRemote
|
||||
<> help "override trust setting back to default"
|
||||
)
|
||||
, globalSetter (Remote.forceTrust UnTrusted) $ strOption
|
||||
( long "untrust" <> metavar paramRemote
|
||||
<> help "override trust setting to untrusted"
|
||||
)
|
||||
, globalSetter setgitconfig $ strOption
|
||||
( long "config" <> short 'c' <> metavar "NAME=VALUE"
|
||||
<> help "override git configuration setting"
|
||||
)
|
||||
, globalSetter setuseragent $ strOption
|
||||
( long "user-agent" <> metavar paramName
|
||||
<> help "override default User-Agent"
|
||||
)
|
||||
, globalFlag (Annex.setFlag "trustglacier")
|
||||
( long "trust-glacier"
|
||||
<> help "Trust Amazon Glacier inventory"
|
||||
)
|
||||
, globalFlag (setdesktopnotify mkNotifyFinish)
|
||||
( long "notify-finish"
|
||||
<> help "show desktop notification after transfer finishes"
|
||||
)
|
||||
, globalFlag (setdesktopnotify mkNotifyStart)
|
||||
( long "notify-start"
|
||||
<> help "show desktop notification after transfer completes"
|
||||
)
|
||||
]
|
||||
where
|
||||
trustArg t = ReqArg (Remote.forceTrust t) paramRemote
|
||||
setnumcopies v = maybe noop
|
||||
(\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n })
|
||||
(readish v)
|
||||
setnumcopies n = Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n }
|
||||
setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }
|
||||
setgitconfig v = inRepo (Git.Config.store v)
|
||||
>>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] })
|
||||
>>= Annex.changeGitRepo
|
||||
setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }
|
||||
|
||||
parseRemoteOption :: Parser RemoteName -> Parser (DeferredParse Remote)
|
||||
parseRemoteOption p = DeferredParse . (fromJust <$$> Remote.byNameWithUUID) . Just <$> p
|
||||
|
|
@ -177,13 +199,11 @@ parseCombiningOptions =
|
|||
<|> shortopt '(' "open group of options"
|
||||
<|> shortopt ')' "close group of options"
|
||||
where
|
||||
longopt o h = globalOpt (Limit.addToken o) $ switch
|
||||
( long o <> help h )
|
||||
shortopt o h = globalOpt (Limit.addToken [o]) $ switch
|
||||
( short o <> help h)
|
||||
longopt o h = globalFlag (Limit.addToken o) ( long o <> help h )
|
||||
shortopt o h = globalFlag (Limit.addToken [o]) ( short o <> help h)
|
||||
|
||||
parseJsonOption :: Parser GlobalSetter
|
||||
parseJsonOption = globalOpt (Annex.setOutput JSONOutput) $ switch
|
||||
parseJsonOption = globalFlag (Annex.setOutput JSONOutput)
|
||||
( long "json" <> short 'j'
|
||||
<> help "enable JSON output"
|
||||
)
|
||||
|
|
|
|||
|
|
@ -8,7 +8,6 @@
|
|||
module CmdLine.GitAnnexShell where
|
||||
|
||||
import System.Environment
|
||||
import System.Console.GetOpt
|
||||
|
||||
import Common.Annex
|
||||
import qualified Git.Construct
|
||||
|
|
@ -54,9 +53,13 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
|
|||
where
|
||||
adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c }
|
||||
|
||||
options :: [OptDescr (Annex ())]
|
||||
options = commonOptions ++
|
||||
[ Option [] ["uuid"] (ReqArg checkUUID paramUUID) "local repository uuid"
|
||||
options :: Parser GlobalSetter
|
||||
options = globalSetters
|
||||
[ commonGlobalOptions
|
||||
, globalSetter checkUUID $ strOption
|
||||
( long "uuid" <> metavar paramUUID
|
||||
<> help "local repository uuid"
|
||||
)
|
||||
]
|
||||
where
|
||||
checkUUID expected = getUUID >>= check
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-}
|
||||
|
||||
module CmdLine.Option (
|
||||
commonOptions,
|
||||
commonGlobalOptions,
|
||||
flagOption,
|
||||
fieldOption,
|
||||
optionName,
|
||||
|
|
@ -15,35 +15,46 @@ module CmdLine.Option (
|
|||
OptDescr(..),
|
||||
) where
|
||||
|
||||
import Options.Applicative
|
||||
import System.Console.GetOpt
|
||||
|
||||
import Common.Annex
|
||||
import CmdLine.Usage
|
||||
import qualified Annex
|
||||
import Types.Messages
|
||||
import Types.DesktopNotify
|
||||
import CmdLine.Usage
|
||||
import Types.DeferredParse
|
||||
|
||||
-- Options accepted by both git-annex and git-annex-shell sub-commands.
|
||||
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 ['q'] ["quiet"] (NoArg (Annex.setOutput QuietOutput))
|
||||
"avoid verbose output"
|
||||
, Option ['v'] ["verbose"] (NoArg (Annex.setOutput NormalOutput))
|
||||
"allow verbose output (default)"
|
||||
, Option ['d'] ["debug"] (NoArg setdebug)
|
||||
"show debug messages"
|
||||
, Option [] ["no-debug"] (NoArg unsetdebug)
|
||||
"don't show debug messages"
|
||||
, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)
|
||||
"specify key-value backend to use"
|
||||
, Option [] ["notify-finish"] (NoArg (setdesktopnotify mkNotifyFinish))
|
||||
"show desktop notification after transfer finishes"
|
||||
, Option [] ["notify-start"] (NoArg (setdesktopnotify mkNotifyStart))
|
||||
"show desktop notification after transfer completes"
|
||||
-- Global options accepted by both git-annex and git-annex-shell sub-commands.
|
||||
commonGlobalOptions :: Parser GlobalSetter
|
||||
commonGlobalOptions = globalSetters
|
||||
[ globalFlag (setforce True)
|
||||
( long "force"
|
||||
<> help "allow actions that may lose annexed data"
|
||||
)
|
||||
, globalFlag (setfast True)
|
||||
( long "fast" <> short 'F'
|
||||
<> help "avoid slow operations"
|
||||
)
|
||||
, globalFlag (Annex.setOutput QuietOutput)
|
||||
( long "quiet" <> short 'q'
|
||||
<> help "avoid verbose output"
|
||||
)
|
||||
, globalFlag (Annex.setOutput NormalOutput)
|
||||
( long "verbose" <> short 'v'
|
||||
<> help "allow verbose output (default)"
|
||||
)
|
||||
, globalFlag setdebug
|
||||
( long "debug" <> short 'd'
|
||||
<> help "show debug messages"
|
||||
)
|
||||
, globalFlag unsetdebug
|
||||
( long "no-debug"
|
||||
<> help "don't show debug messages"
|
||||
)
|
||||
, globalSetter setforcebackend $ strOption
|
||||
( long "backend" <> short 'b' <> metavar paramName
|
||||
<> help "specify key-value backend to use"
|
||||
)
|
||||
]
|
||||
where
|
||||
setforce v = Annex.changeState $ \s -> s { Annex.force = v }
|
||||
|
|
@ -51,17 +62,16 @@ commonOptions =
|
|||
setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
|
||||
setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True }
|
||||
unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False }
|
||||
setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }
|
||||
|
||||
{- An option that sets a flag. -}
|
||||
flagOption :: String -> String -> String -> Option
|
||||
flagOption short opt description =
|
||||
Option short [opt] (NoArg (Annex.setFlag opt)) description
|
||||
flagOption shortv opt description =
|
||||
Option shortv [opt] (NoArg (Annex.setFlag opt)) description
|
||||
|
||||
{- An option that sets a field. -}
|
||||
fieldOption :: String -> String -> String -> String -> Option
|
||||
fieldOption short opt paramdesc description =
|
||||
Option short [opt] (ReqArg (Annex.setField opt) paramdesc) description
|
||||
fieldOption shortv opt paramdesc description =
|
||||
Option shortv [opt] (ReqArg (Annex.setField opt) paramdesc) description
|
||||
|
||||
{- The flag or field name used for an option. -}
|
||||
optionName :: Option -> String
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ module Types.DeferredParse where
|
|||
import Annex
|
||||
import Common
|
||||
|
||||
import Options.Applicative.Types
|
||||
import Options.Applicative
|
||||
|
||||
-- Some values cannot be fully parsed without performing an action.
|
||||
-- The action may be expensive, so it's best to call finishParse on such a
|
||||
|
|
@ -40,11 +40,12 @@ instance DeferredParseClass [DeferredParse a] where
|
|||
-- Use when the Annex action modifies Annex state.
|
||||
type GlobalSetter = DeferredParse ()
|
||||
|
||||
globalOpt :: Annex () -> Parser Bool -> Parser GlobalSetter
|
||||
globalOpt setter parser = go <$> parser
|
||||
where
|
||||
go False = ReadyParse ()
|
||||
go True = DeferredParse setter
|
||||
globalFlag :: Annex () -> Mod FlagFields GlobalSetter -> Parser GlobalSetter
|
||||
globalFlag setter = flag' (DeferredParse setter)
|
||||
|
||||
globalSetter :: (v -> Annex ()) -> Parser v -> Parser GlobalSetter
|
||||
globalSetter setter parser = DeferredParse . setter <$> parser
|
||||
|
||||
globalSetters :: [Parser GlobalSetter] -> Parser GlobalSetter
|
||||
globalSetters l = DeferredParse . sequence_ . map getParsed
|
||||
<$> many (foldl1 (<|>) l)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue