diff --git a/CmdLine.hs b/CmdLine.hs index 40ce4b1215..54c2289c61 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -1,11 +1,16 @@ -{- git-annex command line +{- git-annex command line parsing - - Copyright 2010 Joey Hess - - 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,116 +18,41 @@ 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" - ] +{- Each dashed command-line option results in generation of an action + - in the Annex monad that performs the necessary setting. + -} +type Option = OptDescr (Annex ()) + +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] -> String -> [Command] -> [Option] -> Annex [Annex Bool] +parseCmd argv header cmds options = do + (flags, params) <- liftIO $ getopt + when (null params) $ error usagemsg + case lookupCmd (head params) of + [] -> error usagemsg + [command] -> do + _ <- sequence flags + prepCmd command (drop 1 params) + _ -> error "internal error: multiple matching commands" where - path = "PATH ..." - maybepath = "[PATH ...]" - key = "KEY ..." - desc = "DESCRIPTION" - number = "NUMBER ..." - remote = "REMOTE ..." - nothing = "" + getopt = case getOpt Permute options argv of + (flags, params, []) -> return (flags, params) + (_, _, errs) -> ioError (userError (concat errs ++ usagemsg)) + lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds + usagemsg = usage header cmds options --- 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 - -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 +{- 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 = @@ -133,21 +63,3 @@ usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs cmddesc c indent l = " " ++ l pad n s = replicate (n - length s) ' ' - -{- 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 - (flags, params) <- liftIO $ getopt - when (null params) $ error usage - case lookupCmd (head params) of - [] -> error usage - [command] -> do - _ <- sequence flags - prepCmd command (drop 1 params) - _ -> error "internal error: multiple matching commands" - where - getopt = case getOpt Permute options argv of - (flags, params, []) -> return (flags, params) - (_, _, errs) -> ioError (userError (concat errs ++ usage)) - lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds diff --git a/Command.hs b/Command.hs index 2144da353b..690dd20ecf 100644 --- a/Command.hs +++ b/Command.hs @@ -205,18 +205,24 @@ notSymlink f = do s <- liftIO $ getSymbolicLinkStatus f return $ not $ isSymbolicLink s -{- descriptions of params used in usage message -} +{- Descriptions of params used in usage messages. -} +paramRepeating :: String -> String +paramRepeating s = s ++ " ..." +paramOptional :: String -> String +paramOptional s = "[" ++ s ++ "]" paramPath :: String -paramPath = "PATH ..." -paramMaybePath :: String -paramMaybePath = "[PATH ...]" +paramPath = "PATH" paramKey :: String -paramKey = "KEY ..." +paramKey = "KEY" paramDesc :: String paramDesc = "DESCRIPTION" paramNumber :: String -paramNumber = "NUMBER ..." +paramNumber = "NUMBER" paramRemote :: String -paramRemote = "REMOTE ..." +paramRemote = "REMOTE" +paramGlob :: String +paramGlob = "GLOB" +paramName :: String +paramName = "NAME" paramNothing :: String paramNothing = "" diff --git a/Command/Add.hs b/Command/Add.hs index 08a880206b..bc869a67de 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -18,8 +18,8 @@ import Types import Core import Messages -command :: Command -command = Command "add" paramPath seek "add files to annex" +command :: [Command] +command = [Command "add" paramPath seek "add files to annex"] {- Add acts on both files not checked into git yet, and unlocked files. -} seek :: [CommandSeek] diff --git a/Command/Copy.hs b/Command/Copy.hs index 873df7ef2e..93342e11bb 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -10,6 +10,10 @@ module Command.Copy where import Command import qualified Command.Move +command :: [Command] +command = [Command "copy" paramPath seek + "copy content of files to/from another repository"] + -- A copy is just a move that does not delete the source file. seek :: [CommandSeek] seek = [withFilesInGit $ Command.Move.start False] diff --git a/Command/Drop.hs b/Command/Drop.hs index 3f27405703..a425c6138d 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -17,6 +17,10 @@ import Core import Messages import Utility +command :: [Command] +command = [Command "drop" paramPath seek + "indicate content of files not currently wanted"] + seek :: [CommandSeek] seek = [withAttrFilesInGit "annex.numcopies" start] diff --git a/Command/DropKey.hs b/Command/DropKey.hs index 870e9a7ab1..29056139d3 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -15,6 +15,10 @@ import Types import Core import Messages +command :: [Command] +command = [Command "dropkey" (paramRepeating paramKey) seek + "drops annexed content for specified keys"] + seek :: [CommandSeek] seek = [withKeys start] diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 9984e49f3f..ea2ff46eba 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -18,6 +18,10 @@ import qualified Annex import qualified Command.Drop import Backend +command :: [Command] +command = [Command "dropunused" (paramRepeating paramNumber) seek + "drop unused file content"] + seek :: [CommandSeek] seek = [withStrings start] diff --git a/Command/Find.hs b/Command/Find.hs index 9927b692d8..7cb781ce8c 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -13,6 +13,10 @@ import Control.Monad.State (liftIO) import Command import Core +command :: [Command] +command = [Command "find" (paramOptional $ paramRepeating paramPath) seek + "lists available files"] + seek :: [CommandSeek] seek = [withDefault "." withFilesInGit start] diff --git a/Command/Fix.hs b/Command/Fix.hs index accdadd315..8b08a26f6d 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -17,6 +17,10 @@ import Utility import Core import Messages +command :: [Command] +command = [Command "fix" paramPath seek + "fix up symlinks to point to annexed content"] + seek :: [CommandSeek] seek = [withFilesInGit start] diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 991428136e..f1cb717fac 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -20,6 +20,10 @@ import Types import Core import Messages +command :: [Command] +command = [Command "fromkey" (paramRepeating paramKey) seek + "adds a file using a specific key"] + seek :: [CommandSeek] seek = [withFilesMissing start] diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 034bdc388b..d870bd4198 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -13,6 +13,10 @@ import Types import Messages import Utility +command :: [Command] +command = [Command "fsck" (paramOptional $ paramRepeating paramPath) seek + "check for problems"] + seek :: [CommandSeek] seek = [withAll (withAttrFilesInGit "annex.numcopies") start] diff --git a/Command/Get.hs b/Command/Get.hs index 214b689b8a..e3668649ef 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -13,6 +13,10 @@ import Types import Core import Messages +command :: [Command] +command = [Command "get" paramPath seek + "make content of annexed files available"] + seek :: [CommandSeek] seek = [withFilesInGit start] diff --git a/Command/Init.hs b/Command/Init.hs index 806c34c989..8ad9f79d70 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -19,6 +19,10 @@ import Version import Messages import Locations import Types + +command :: [Command] +command = [Command "init" paramDesc seek + "initialize git-annex with repository description"] seek :: [CommandSeek] seek = [withString start] diff --git a/Command/Lock.hs b/Command/Lock.hs index 381162536e..00a553e956 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -14,6 +14,9 @@ import Command import Messages import qualified Annex import qualified GitRepo as Git + +command :: [Command] +command = [Command "lock" paramPath seek "undo unlock command"] seek :: [CommandSeek] seek = [withFilesUnlocked start] diff --git a/Command/Move.hs b/Command/Move.hs index 8ba8dbfacc..addeeae8a9 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -20,6 +20,10 @@ import qualified GitRepo as Git import qualified Remotes import UUID import Messages + +command :: [Command] +command = [Command "move" paramPath seek + "move content of files to/from another repository"] seek :: [CommandSeek] seek = [withFilesInGit $ start True] diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 8d488514a8..12e5ed806d 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -15,6 +15,9 @@ import qualified GitRepo as Git import qualified Command.Add import qualified Command.Fix +command :: [Command] +command = [Command "pre-commit" paramPath seek "run by git pre-commit hook"] + {- The pre-commit hook needs to fix symlinks to all files being committed. - And, it needs to inject unlocked files into the annex. -} seek :: [CommandSeek] diff --git a/Command/SetKey.hs b/Command/SetKey.hs index 4c82de3a5b..5048d052f0 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -19,6 +19,10 @@ import Types import Core import Messages +command :: [Command] +command = [Command "setkey" (paramRepeating paramKey) seek + "sets annexed content for a key using a temp file"] + seek :: [CommandSeek] seek = [withTempFile start] diff --git a/Command/Trust.hs b/Command/Trust.hs index 3c3ec3b7e5..35ddefe842 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -17,6 +17,10 @@ import qualified Remotes import UUID import Messages +command :: [Command] +command = [Command "trust" (paramRepeating paramRemote) seek + "trust a repository"] + seek :: [CommandSeek] seek = [withString start] diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 42354b8c49..288f9da44a 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -20,6 +20,9 @@ import Core import qualified GitRepo as Git import Messages +command :: [Command] +command = [Command "unannex" paramPath seek "undo accidential add command"] + seek :: [CommandSeek] seek = [withFilesInGit start] diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 6001c55cd9..1a4e9b0d71 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -20,6 +20,10 @@ import qualified Annex import qualified Command.Unannex import qualified Command.Init +command :: [Command] +command = [Command "uninit" paramPath seek + "de-initialize git-annex and clean out repository"] + seek :: [CommandSeek] seek = [withAll withFilesInGit Command.Unannex.start, withNothing start] diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 21f34d1dba..0e55585ae3 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -18,6 +18,12 @@ import Locations import Core import CopyFile +command :: [Command] +command = + [ Command "unlock" paramPath seek "unlock files for modification" + , Command "edit" paramPath seek "same as unlock" + ] + seek :: [CommandSeek] seek = [withFilesInGit start] diff --git a/Command/Untrust.hs b/Command/Untrust.hs index 6458040b3f..f49a2e989a 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -17,6 +17,10 @@ import qualified Remotes import UUID import Messages +command :: [Command] +command = [Command "untrust" (paramRepeating paramRemote) seek + "do not trust a repository"] + seek :: [CommandSeek] seek = [withString start] diff --git a/Command/Unused.hs b/Command/Unused.hs index dba9aa517a..d2dfc9aa3e 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -17,6 +17,9 @@ import Messages import Locations import qualified Annex +command :: [Command] +command = [Command "unused" paramNothing seek "look for unused file content"] + seek :: [CommandSeek] seek = [withNothing start] diff --git a/git-annex.hs b/git-annex.hs index 1173ab9139..31d90e4fc3 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -6,6 +6,7 @@ -} import System.Environment +import System.Console.GetOpt import qualified Annex import Core @@ -14,10 +15,81 @@ import CmdLine import qualified GitRepo as Git import BackendList +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 = concat + [ Command.Add.command + , Command.Get.command + , Command.Drop.command + , Command.Move.command + , Command.Copy.command + , Command.Unlock.command + , Command.Lock.command + , Command.Init.command + , Command.Unannex.command + , Command.Uninit.command + , Command.PreCommit.command + , Command.Trust.command + , Command.Untrust.command + , Command.FromKey.command + , Command.DropKey.command + , Command.SetKey.command + , Command.Fix.command + , Command.Fsck.command + , Command.Unused.command + , Command.DropUnused.command + , Command.Find.command + ] + +options :: [Option] +options = [ + Option ['f'] ["force"] (NoArg (storeOptBool "force" True)) + "allow actions that may lose annexed data" + , Option ['q'] ["quiet"] (NoArg (storeOptBool "quiet" True)) + "avoid verbose output" + , Option ['v'] ["verbose"] (NoArg (storeOptBool "quiet" False)) + "allow verbose output" + , Option ['b'] ["backend"] (ReqArg (storeOptString "backend") paramName) + "specify default key-value backend to use" + , Option ['k'] ["key"] (ReqArg (storeOptString "key") paramKey) + "specify a key to use" + , Option ['t'] ["to"] (ReqArg (storeOptString "torepository") paramRemote) + "specify to where to transfer content" + , Option ['f'] ["from"] (ReqArg (storeOptString "fromrepository") paramRemote) + "specify from where to transfer content" + , Option ['x'] ["exclude"] (ReqArg (storeOptString "exclude") paramGlob) + "skip files matching the glob pattern" + ] + +header :: String +header = "Usage: git-annex subcommand [option ..]" + main :: IO () main = do args <- getArgs gitrepo <- Git.repoFromCwd state <- Annex.new gitrepo allBackends - (actions, state') <- Annex.run state $ parseCmd args + (actions, state') <- Annex.run state $ parseCmd args header cmds options tryRun state' $ [startup, upgrade] ++ actions