summaryrefslogtreecommitdiff
path: root/CmdLine.hs
diff options
context:
space:
mode:
Diffstat (limited to 'CmdLine.hs')
-rw-r--r--CmdLine.hs160
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) ' '