diff options
Diffstat (limited to 'CmdLine.hs')
| -rw-r--r-- | CmdLine.hs | 160 |
1 files changed, 36 insertions, 124 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index 40ce4b121..54c2289c6 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -1,11 +1,16 @@ -{- git-annex command line +{- git-annex command line parsing - - Copyright 2010 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} -module CmdLine (parseCmd) where +module CmdLine ( + parseCmd, + Option, + storeOptBool, + storeOptString, +) where import System.Console.GetOpt import Control.Monad (when) @@ -13,135 +18,26 @@ import Control.Monad.State (liftIO) import qualified Annex import Types - import Command -import qualified Command.Add -import qualified Command.Unannex -import qualified Command.Drop -import qualified Command.Move -import qualified Command.Copy -import qualified Command.Get -import qualified Command.FromKey -import qualified Command.DropKey -import qualified Command.SetKey -import qualified Command.Fix -import qualified Command.Init -import qualified Command.Fsck -import qualified Command.Unused -import qualified Command.DropUnused -import qualified Command.Unlock -import qualified Command.Lock -import qualified Command.PreCommit -import qualified Command.Find -import qualified Command.Uninit -import qualified Command.Trust -import qualified Command.Untrust - -cmds :: [Command] -cmds = - [ Command.Add.command - , Command "get" path Command.Get.seek - "make content of annexed files available" - , Command "drop" path Command.Drop.seek - "indicate content of files not currently wanted" - , Command "move" path Command.Move.seek - "move content of files to/from another repository" - , Command "copy" path Command.Copy.seek - "copy content of files to/from another repository" - , Command "unlock" path Command.Unlock.seek - "unlock files for modification" - , Command "edit" path Command.Unlock.seek - "same as unlock" - , Command "lock" path Command.Lock.seek - "undo unlock command" - , Command "init" desc Command.Init.seek - "initialize git-annex with repository description" - , Command "unannex" path Command.Unannex.seek - "undo accidential add command" - , Command "uninit" path Command.Uninit.seek - "de-initialize git-annex and clean out repository" - , Command "pre-commit" path Command.PreCommit.seek - "run by git pre-commit hook" - , Command "trust" remote Command.Trust.seek - "trust a repository" - , Command "untrust" remote Command.Untrust.seek - "do not trust a repository" - , Command "fromkey" key Command.FromKey.seek - "adds a file using a specific key" - , Command "dropkey" key Command.DropKey.seek - "drops annexed content for specified keys" - , Command "setkey" key Command.SetKey.seek - "sets annexed content for a key using a temp file" - , Command "fix" path Command.Fix.seek - "fix up symlinks to point to annexed content" - , Command "fsck" maybepath Command.Fsck.seek - "check for problems" - , Command "unused" nothing Command.Unused.seek - "look for unused file content" - , Command "dropunused" number Command.DropUnused.seek - "drop unused file content" - , Command "find" maybepath Command.Find.seek - "lists available files" - ] - where - path = "PATH ..." - maybepath = "[PATH ...]" - key = "KEY ..." - desc = "DESCRIPTION" - number = "NUMBER ..." - remote = "REMOTE ..." - nothing = "" --- Each dashed command-line option results in generation of an action --- in the Annex monad that performs the necessary setting. -options :: [OptDescr (Annex ())] -options = [ - Option ['f'] ["force"] (NoArg (storebool "force" True)) - "allow actions that may lose annexed data" - , Option ['q'] ["quiet"] (NoArg (storebool "quiet" True)) - "avoid verbose output" - , Option ['v'] ["verbose"] (NoArg (storebool "quiet" False)) - "allow verbose output" - , Option ['b'] ["backend"] (ReqArg (storestring "backend") "NAME") - "specify default key-value backend to use" - , Option ['k'] ["key"] (ReqArg (storestring "key") "KEY") - "specify a key to use" - , Option ['t'] ["to"] (ReqArg (storestring "torepository") "REPOSITORY") - "specify to where to transfer content" - , Option ['f'] ["from"] (ReqArg (storestring "fromrepository") "REPOSITORY") - "specify from where to transfer content" - , Option ['x'] ["exclude"] (ReqArg (storestring "exclude") "GLOB") - "skip files matching the glob pattern" - ] - where - storebool n b = Annex.flagChange n $ FlagBool b - storestring n s = Annex.flagChange n $ FlagString s +{- Each dashed command-line option results in generation of an action + - in the Annex monad that performs the necessary setting. + -} +type Option = OptDescr (Annex ()) -header :: String -header = "Usage: git-annex subcommand [option ..]" - -{- Usage message with lists of options and subcommands. -} -usage :: String -usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs - where - cmddescs = unlines $ map (indent . showcmd) cmds - showcmd c = - cmdname c ++ - pad 11 (cmdname c) ++ - cmdparams c ++ - pad 13 (cmdparams c) ++ - cmddesc c - indent l = " " ++ l - pad n s = replicate (n - length s) ' ' +storeOptBool :: FlagName -> Bool -> Annex () +storeOptBool name val = Annex.flagChange name $ FlagBool val +storeOptString :: FlagName -> String -> Annex () +storeOptString name val = Annex.flagChange name $ FlagString val {- Parses command line, stores configure flags, and returns a - list of actions to be run in the Annex monad. -} -parseCmd :: [String] -> Annex [Annex Bool] -parseCmd argv = do +parseCmd :: [String] -> String -> [Command] -> [Option] -> Annex [Annex Bool] +parseCmd argv header cmds options = do (flags, params) <- liftIO $ getopt - when (null params) $ error usage + when (null params) $ error usagemsg case lookupCmd (head params) of - [] -> error usage + [] -> error usagemsg [command] -> do _ <- sequence flags prepCmd command (drop 1 params) @@ -149,5 +45,21 @@ parseCmd argv = do where getopt = case getOpt Permute options argv of (flags, params, []) -> return (flags, params) - (_, _, errs) -> ioError (userError (concat errs ++ usage)) + (_, _, errs) -> ioError (userError (concat errs ++ usagemsg)) lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds + usagemsg = usage header cmds options + +{- Usage message with lists of commands and options. -} +usage :: String -> [Command] -> [Option] -> String +usage header cmds options = + usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs + where + cmddescs = unlines $ map (indent . showcmd) cmds + showcmd c = + cmdname c ++ + pad 11 (cmdname c) ++ + cmdparams c ++ + pad 13 (cmdparams c) ++ + cmddesc c + indent l = " " ++ l + pad n s = replicate (n - length s) ' ' |