diff options
69 files changed, 245 insertions, 178 deletions
diff --git a/Assistant.hs b/Assistant.hs index 630f3685b..8ea6692e3 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -159,6 +159,8 @@ import Utility.LogFile import Utility.ThreadScheduler import qualified Build.SysConfig as SysConfig +import System.Log.Logger + stopDaemon :: Annex () stopDaemon = liftIO . Utility.Daemon.stopDaemon =<< fromRepo gitAnnexPidFile @@ -170,9 +172,11 @@ stopDaemon = liftIO . Utility.Daemon.stopDaemon =<< fromRepo gitAnnexPidFile startDaemon :: Bool -> Bool -> Maybe (Maybe Handle -> Maybe Handle -> String -> FilePath -> IO ()) -> Annex () startDaemon assistant foreground startbrowser = do pidfile <- fromRepo gitAnnexPidFile - logfd <- liftIO . openLog =<< fromRepo gitAnnexLogFile + logfile <- fromRepo gitAnnexLogFile + logfd <- liftIO $ openLog logfile if foreground then do + liftIO $ debugM desc $ "logging to " ++ logfile liftIO $ Utility.Daemon.lockPidFile pidfile origout <- liftIO $ catchMaybeIO $ fdToHandle =<< dup stdOutput @@ -194,6 +198,8 @@ startDaemon assistant foreground startbrowser = do checkCanWatch when assistant $ checkEnvironment dstatus <- startDaemonStatus + logfile <- fromRepo gitAnnexLogFile + liftIO $ debugM desc $ "logging to " ++ logfile liftIO $ daemonize $ flip runAssistant (go webappwaiter) =<< newAssistantData st dstatus diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index 1242c1d74..8ccb241bb 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -20,6 +20,7 @@ import qualified Remote import Utility.ThreadScheduler import Assistant.WebApp (UrlRenderer, renderUrl) import Assistant.WebApp.Types hiding (liftAssistant) +import Assistant.WebApp.Configurators.XMPP (checkCloudRepos) import Assistant.Alert import Assistant.Pairing import Assistant.XMPP.Git @@ -106,8 +107,9 @@ xmppClient urlrenderer d creds = maybe noop (inAssistant . pairMsgReceived urlrenderer stage u selfjid) (parseJID c) handle _ (GotNetMessage m@(Pushing _ pushstage)) | isPushInitiation pushstage = inAssistant $ - unlessM (queueNetPushMessage m) $ - void $ forkIO <~> handlePushInitiation urlrenderer m + unlessM (queueNetPushMessage m) $ do + let checker = checkCloudRepos urlrenderer + void $ forkIO <~> handlePushInitiation checker m | otherwise = void $ inAssistant $ queueNetPushMessage m handle _ (Ignorable _) = noop handle _ (Unknown _) = noop diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 135c68fbc..f90af4080 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -31,10 +31,6 @@ import qualified Remote as Remote import Remote.List import Utility.FileMode import Utility.Shell -#ifdef WITH_WEBAPP -import Assistant.WebApp (UrlRenderer) -import Assistant.WebApp.Configurators.XMPP -#endif import Network.Protocol.XMPP import qualified Data.Text as T @@ -256,11 +252,11 @@ xmppRemotes cid = case baseJID <$> parseJID cid of where matching loc r = repoIsUrl r && repoLocation r == loc -handlePushInitiation :: UrlRenderer -> NetMessage -> Assistant () +handlePushInitiation :: (Remote -> Assistant ()) -> NetMessage -> Assistant () handlePushInitiation _ (Pushing cid CanPush) = unlessM (null <$> xmppRemotes cid) $ sendNetMessage $ Pushing cid PushRequest -handlePushInitiation urlrenderer (Pushing cid PushRequest) = +handlePushInitiation checkcloudrepos (Pushing cid PushRequest) = go =<< liftAnnex (inRepo Git.Branch.current) where go Nothing = noop @@ -276,29 +272,19 @@ handlePushInitiation urlrenderer (Pushing cid PushRequest) = void $ alertWhile (syncAlert [r]) $ xmppPush cid (taggedPush u selfjid branch r) - (handleDeferred urlrenderer) - checkCloudRepos urlrenderer r -handlePushInitiation urlrenderer (Pushing cid StartingPush) = do + (handleDeferred checkcloudrepos) + checkcloudrepos r +handlePushInitiation checkcloudrepos (Pushing cid StartingPush) = do rs <- xmppRemotes cid unless (null rs) $ do void $ alertWhile (syncAlert rs) $ - xmppReceivePack cid (handleDeferred urlrenderer) - mapM_ (checkCloudRepos urlrenderer) rs + xmppReceivePack cid (handleDeferred checkcloudrepos) + mapM_ checkcloudrepos rs handlePushInitiation _ _ = noop -handleDeferred :: UrlRenderer -> NetMessage -> Assistant () +handleDeferred :: (Remote -> Assistant ()) -> NetMessage -> Assistant () handleDeferred = handlePushInitiation -checkCloudRepos :: UrlRenderer -> Remote -> Assistant () --- TODO only display if needed -checkCloudRepos urlrenderer r = -#ifdef WITH_WEBAPP - unlessM (syncingToCloudRemote <$> getDaemonStatus) $ - cloudRepoNeeded urlrenderer (Remote.uuid r) -#else - noop -#endif - writeChunk :: Handle -> B.ByteString -> IO () writeChunk h b = do B.hPut h b diff --git a/CmdLine.hs b/CmdLine.hs index 0b155215d..db46cba82 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -45,10 +45,10 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do prepCommand cmd params tryRun state' cmd $ [startup] ++ actions ++ [shutdown $ cmdnocommit cmd] where - err msg = msg ++ "\n\n" ++ usage header allcmds commonoptions + err msg = msg ++ "\n\n" ++ usage header allcmds cmd = Prelude.head cmds (fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err - (flags, params) = getOptCmd args cmd commonoptions err + (flags, params) = getOptCmd args cmd commonoptions checkfuzzy = when fuzzy $ inRepo $ Git.AutoCorrect.prepare name cmdname cmds @@ -74,12 +74,15 @@ findCmd fuzzyok argv cmds err {- Parses command line options, and returns actions to run to configure flags - and the remaining parameters for the command. -} -getOptCmd :: Params -> Command -> [Option] -> (String -> String) -> (Flags, Params) -getOptCmd argv cmd commonoptions err = check $ +getOptCmd :: Params -> Command -> [Option] -> (Flags, Params) +getOptCmd argv cmd commonoptions = check $ getOpt Permute (commonoptions ++ cmdoptions cmd) argv where check (flags, rest, []) = (flags, rest) - check (_, _, errs) = error $ err $ concat errs + check (_, _, errs) = error $ unlines + [ concat errs + , commandUsage cmd + ] {- Runs a list of Annex actions. Catches IO errors and continues - (but explicitly thrown errors terminate the whole command). diff --git a/Command.hs b/Command.hs index 8225f7b1b..5c1395ed7 100644 --- a/Command.hs +++ b/Command.hs @@ -40,7 +40,7 @@ import Config import Annex.CheckAttr {- Generates a normal command -} -command :: String -> String -> [CommandSeek] -> String -> Command +command :: String -> String -> [CommandSeek] -> CommandSection -> String -> Command command = Command [] Nothing commonChecks False {- Indicates that a command doesn't need to commit any changes to diff --git a/Command/Add.hs b/Command/Add.hs index 343ffbe95..cf2a55c50 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -29,7 +29,8 @@ import Config import Utility.InodeCache def :: [Command] -def = [notBareRepo $ command "add" paramPaths seek "add files to annex"] +def = [notBareRepo $ command "add" paramPaths seek SectionCommon + "add files to annex"] {- Add acts on both files not checked into git yet, and unlocked files. - diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs index 23dbdfcca..c352d87d0 100644 --- a/Command/AddUnused.hs +++ b/Command/AddUnused.hs @@ -15,7 +15,7 @@ import Types.Key def :: [Command] def = [notDirect $ command "addunused" (paramRepeating paramNumRange) - seek "add back unused files"] + seek SectionMaintenance "add back unused files"] seek :: [CommandSeek] seek = [withUnusedMaps start] diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index ceb35224d..7c235922d 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -26,7 +26,8 @@ import Annex.Content.Direct def :: [Command] def = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption] $ - command "addurl" (paramRepeating paramUrl) seek "add urls to annex"] + command "addurl" (paramRepeating paramUrl) seek + SectionCommon "add urls to annex"] fileOption :: Option fileOption = Option.field [] "file" paramFile "specify what file the url is added to" diff --git a/Command/Assistant.hs b/Command/Assistant.hs index 69a127b50..0997088ad 100644 --- a/Command/Assistant.hs +++ b/Command/Assistant.hs @@ -20,7 +20,8 @@ import System.Posix.Directory def :: [Command] def = [noRepo checkAutoStart $ dontCheck repoExists $ withOptions [Command.Watch.foregroundOption, Command.Watch.stopOption, autoStartOption] $ - command "assistant" paramNothing seek "automatically handle changes"] + command "assistant" paramNothing seek SectionCommon + "automatically handle changes"] autoStartOption :: Option autoStartOption = Option.flag [] "autostart" "start in known repositories" diff --git a/Command/Commit.hs b/Command/Commit.hs index 165906139..6f3f9df28 100644 --- a/Command/Commit.hs +++ b/Command/Commit.hs @@ -14,7 +14,7 @@ import qualified Git def :: [Command] def = [command "commit" paramNothing seek - "commits any staged changes to the git-annex branch"] + SectionPlumbing "commits any staged changes to the git-annex branch"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index 505ad99e1..703d6882d 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -13,7 +13,7 @@ import Annex.UUID def :: [Command] def = [noCommit $ command "configlist" paramNothing seek - "outputs relevant git configuration"] + SectionPlumbing "outputs relevant git configuration"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Command/Copy.hs b/Command/Copy.hs index 4b04a2423..75b91c85c 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -15,7 +15,7 @@ import Annex.Wanted def :: [Command] def = [withOptions Command.Move.options $ command "copy" paramPaths seek - "copy content of files to/from another repository"] + SectionCommon "copy content of files to/from another repository"] seek :: [CommandSeek] seek = [withField Command.Move.toOption Remote.byNameWithUUID $ \to -> diff --git a/Command/Dead.hs b/Command/Dead.hs index 34595769f..f4b654ed9 100644 --- a/Command/Dead.hs +++ b/Command/Dead.hs @@ -17,7 +17,7 @@ import qualified Data.Set as S def :: [Command] def = [command "dead" (paramRepeating paramRemote) seek - "hide a lost repository"] + SectionSetup "hide a lost repository"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/Describe.hs b/Command/Describe.hs index 61297e77c..18851b172 100644 --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -14,7 +14,7 @@ import Logs.UUID def :: [Command] def = [command "describe" (paramPair paramRemote paramDesc) seek - "change description of a repository"] + SectionSetup "change description of a repository"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/Direct.hs b/Command/Direct.hs index 1617bd9c2..7ded712ae 100644 --- a/Command/Direct.hs +++ b/Command/Direct.hs @@ -18,7 +18,8 @@ import Annex.Version def :: [Command] def = [notBareRepo $ - command "direct" paramNothing seek "switch repository to direct mode"] + command "direct" paramNothing seek + SectionSetup "switch repository to direct mode"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Command/Drop.hs b/Command/Drop.hs index 1d09ca3fd..4e3a062af 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -21,7 +21,7 @@ import Annex.Wanted def :: [Command] def = [withOptions [fromOption] $ command "drop" paramPaths seek - "indicate content of files not currently wanted"] + SectionCommon "indicate content of files not currently wanted"] fromOption :: Option fromOption = Option.field ['f'] "from" paramRemote "drop content from a remote" diff --git a/Command/DropKey.hs b/Command/DropKey.hs index c0d4f85cf..624919584 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -16,7 +16,7 @@ import Types.Key def :: [Command] def = [noCommit $ command "dropkey" (paramRepeating paramKey) seek - "drops annexed content for specified keys"] + SectionPlumbing "drops annexed content for specified keys"] seek :: [CommandSeek] seek = [withKeys start] diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index ccf43c040..a23e0cb39 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -19,7 +19,7 @@ import qualified Option def :: [Command] def = [withOptions [Command.Drop.fromOption] $ command "dropunused" (paramRepeating paramNumRange) - seek "drop unused file content"] + seek SectionMaintenance "drop unused file content"] seek :: [CommandSeek] seek = [withUnusedMaps start] diff --git a/Command/Find.hs b/Command/Find.hs index 96f47ec87..a326b2634 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -21,7 +21,7 @@ import qualified Option def :: [Command] def = [noCommit $ withOptions [formatOption, print0Option] $ - command "find" paramPaths seek "lists available files"] + command "find" paramPaths seek SectionQuery "lists available files"] formatOption :: Option formatOption = Option.field [] "format" paramFormat "control format of output" diff --git a/Command/Fix.hs b/Command/Fix.hs index e15951c21..dbccfacdf 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -14,7 +14,7 @@ import Annex.Content def :: [Command] def = [notDirect $ noCommit $ command "fix" paramPaths seek - "fix up symlinks to point to annexed content"] + SectionMaintenance "fix up symlinks to point to annexed content"] seek :: [CommandSeek] seek = [withFilesInGit $ whenAnnexed start] diff --git a/Command/FromKey.hs b/Command/FromKey.hs index d023be686..ac5edd1d0 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -16,7 +16,7 @@ import Types.Key def :: [Command] def = [notDirect $ notBareRepo $ command "fromkey" (paramPair paramKey paramPath) seek - "adds a file using a specific key"] + SectionPlumbing "adds a file using a specific key"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/Fsck.hs b/Command/Fsck.hs index aeed58cd1..501483b14 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -36,7 +36,7 @@ import System.Locale def :: [Command] def = [withOptions options $ command "fsck" paramPaths seek - "check for problems"] + SectionMaintenance "check for problems"] fromOption :: Option fromOption = Option.field ['f'] "from" paramRemote "check remote" diff --git a/Command/Get.hs b/Command/Get.hs index 95f71a84b..432be31e3 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -17,7 +17,7 @@ import Annex.Wanted def :: [Command] def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek - "make content of annexed files available"] + SectionCommon "make content of annexed files available"] seek :: [CommandSeek] seek = [withField Command.Move.fromOption Remote.byNameWithUUID $ \from -> diff --git a/Command/Group.hs b/Command/Group.hs index 5513ca3f7..aee02b6c4 100644 --- a/Command/Group.hs +++ b/Command/Group.hs @@ -16,7 +16,8 @@ import Types.Group import qualified Data.Set as S def :: [Command] -def = [command "group" (paramPair paramRemote paramDesc) seek "add a repository to a group"] +def = [command "group" (paramPair paramRemote paramDesc) seek + SectionCommon "add a repository to a group"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/Help.hs b/Command/Help.hs index 95033eb7f..576298226 100644 --- a/Command/Help.hs +++ b/Command/Help.hs @@ -18,21 +18,30 @@ import qualified Command.Copy import qualified Command.Sync import qualified Command.Whereis import qualified Command.Fsck +import GitAnnex.Options + +import System.Console.GetOpt def :: [Command] -def = [noCommit $ noRepo showHelp $ dontCheck repoExists $ - command "help" paramNothing seek "display help"] +def = [noCommit $ noRepo showGeneralHelp $ dontCheck repoExists $ + command "help" paramNothing seek SectionUtility "display help"] seek :: [CommandSeek] seek = [withWords start] start :: [String] -> CommandStart +start ["options"] = do + liftIO showCommonOptions + stop start _ = do - liftIO showHelp + liftIO showGeneralHelp stop -showHelp :: IO () -showHelp = liftIO $ putStrLn $ unlines +showCommonOptions :: IO () +showCommonOptions = putStrLn $ usageInfo "Common options:" options + +showGeneralHelp :: IO () +showGeneralHelp = putStrLn $ unlines [ "The most commonly used git-annex commands are:" , unlines $ map cmdline $ concat [ Command.Init.def @@ -45,7 +54,7 @@ showHelp = liftIO $ putStrLn $ unlines , Command.Whereis.def , Command.Fsck.def ] - , "Run git-annex without any options for a complete command and option list." + , "Run git-annex without any options for a complete command list." ] where cmdline c = "\t" ++ cmdname c ++ "\t" ++ cmddesc c diff --git a/Command/Import.hs b/Command/Import.hs index e8e839e4f..d86b44b80 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -14,7 +14,7 @@ import qualified Command.Add def :: [Command] def = [notDirect $ notBareRepo $ command "import" paramPaths seek - "move and add files from outside git working copy"] + SectionCommon "move and add files from outside git working copy"] seek :: [CommandSeek] seek = [withPathContents start] diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs index cd4bff2c6..4410d722d 100644 --- a/Command/InAnnex.hs +++ b/Command/InAnnex.hs @@ -13,7 +13,7 @@ import Annex.Content def :: [Command] def = [noCommit $ command "inannex" (paramRepeating paramKey) seek - "checks if keys are present in the annex"] + SectionPlumbing "checks if keys are present in the annex"] seek :: [CommandSeek] seek = [withKeys start] diff --git a/Command/Indirect.hs b/Command/Indirect.hs index 6290e6756..e46a3348d 100644 --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -22,7 +22,7 @@ import Init def :: [Command] def = [notBareRepo $ command "indirect" paramNothing seek - "switch repository to indirect mode"] + SectionSetup "switch repository to indirect mode"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Command/Init.hs b/Command/Init.hs index 342ef84e1..3db9a6be3 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -13,7 +13,7 @@ import Init def :: [Command] def = [dontCheck repoExists $ - command "init" paramDesc seek "initialize git-annex"] + command "init" paramDesc seek SectionSetup "initialize git-annex"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 684f868ef..c82dc9ddf 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -20,7 +20,7 @@ import Logs.UUID def :: [Command] def = [command "initremote" (paramPair paramName $ paramOptional $ paramRepeating paramKeyValue) - seek "sets up a special (non-git) remote"] + seek SectionSetup "sets up a special (non-git) remote"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/Lock.hs b/Command/Lock.hs index c34e6a16b..6dc58df74 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -12,7 +12,8 @@ import Command import qualified Annex.Queue def :: [Command] -def = [notDirect $ command "lock" paramPaths seek "undo unlock command"] +def = [notDirect $ command "lock" paramPaths seek SectionCommon + "undo unlock command"] seek :: [CommandSeek] seek = [withFilesUnlocked start, withFilesUnlockedToBeCommitted start] diff --git a/Command/Log.hs b/Command/Log.hs index 6608a9906..2d4819f7f 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -37,7 +37,7 @@ type Outputter = Bool -> POSIXTime -> [UUID] -> Annex () def :: [Command] def = [withOptions options $ - command "log" paramPaths seek "shows location log"] + command "log" paramPaths seek SectionQuery "shows location log"] options :: [Option] options = passthruOptions ++ [gourceOption] diff --git a/Command/Map.hs b/Command/Map.hs index f2ac52047..c88520b07 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -28,7 +28,8 @@ data Link = Link Git.Repo Git.Repo def :: [Command] def = [dontCheck repoExists $ - command "map" paramNothing seek "generate map of repositories"] + command "map" paramNothing seek SectionQuery + "generate map of repositories"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Command/Merge.hs b/Command/Merge.hs index 0f4661497..382a251df 100644 --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -12,8 +12,8 @@ import Command import qualified Annex.Branch def :: [Command] -def = [command "merge" paramNothing seek - "auto-merge remote changes into git-annex branch"] +def = [command "merge" paramNothing seek SectionMaintenance + "auto-merge remote changes into git-annex branch"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 5374bc928..795f9ed7b 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -19,7 +19,8 @@ import qualified Command.Fsck def :: [Command] def = [notDirect $ - command "migrate" paramPaths seek "switch data to different backend"] + command "migrate" paramPaths seek + SectionUtility "switch data to different backend"] seek :: [CommandSeek] seek = [withFilesInGit $ whenAnnexed start] diff --git a/Command/Move.hs b/Command/Move.hs index cc8fb506f..31daf5529 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -20,7 +20,7 @@ import Logs.Transfer def :: [Command] def = [withOptions options $ command "move" paramPaths seek - "move content of files to/from another repository"] + SectionCommon "move content of files to/from another repository"] fromOption :: Option fromOption = Option.field ['f'] "from" paramRemote "source remote" diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 23b6ecc0a..565344d25 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -17,7 +17,8 @@ import Annex.Content.Direct import Git.Sha def :: [Command] -def = [command "pre-commit" paramPaths seek "run by git pre-commit hook"] +def = [command "pre-commit" paramPaths seek SectionPlumbing + "run by git pre-commit hook"] seek :: [CommandSeek] seek = diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 54a345dcb..5978a0296 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -20,7 +20,7 @@ import Utility.CopyFile def :: [Command] def = [notDirect $ command "rekey" (paramOptional $ paramRepeating $ paramPair paramPath paramKey) - seek "change keys used for files"] + seek SectionPlumbing "change keys used for files"] seek :: [CommandSeek] seek = [withPairs start] diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index 11a5fd5ca..c5ff4a9c8 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -21,7 +21,7 @@ import qualified Backend def :: [Command] def = [noCommit $ command "recvkey" paramKey seek - "runs rsync in server mode to receive content"] + SectionPlumbing "runs rsync in server mode to receive content"] seek :: [CommandSeek] seek = [withKeys start] diff --git a/Command/Reinject.hs b/Command/Reinject.hs index 12657f7f4..642f38947 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -15,7 +15,7 @@ import qualified Command.Fsck def :: [Command] def = [notDirect $ command "reinject" (paramPair "SRC" "DEST") seek - "sets content of annexed file"] + SectionUtility "sets content of annexed file"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs index f8c306213..e20563672 100644 --- a/Command/Semitrust.hs +++ b/Command/Semitrust.hs @@ -14,7 +14,7 @@ import Logs.Trust def :: [Command] def = [command "semitrust" (paramRepeating paramRemote) seek - "return repository to default trust level"] + SectionSetup "return repository to default trust level"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/SendKey.hs b/Command/SendKey.hs index dfdec7f92..3e46d9dd0 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -16,7 +16,7 @@ import qualified Fields def :: [Command] def = [noCommit $ command "sendkey" paramKey seek - "runs rsync in server mode to send content"] + SectionPlumbing "runs rsync in server mode to send content"] seek :: [CommandSeek] seek = [withKeys start] diff --git a/Command/Status.hs b/Command/Status.hs index ff71e0120..37d6500f9 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -58,7 +58,7 @@ type StatState = StateT StatInfo Annex def :: [Command] def = [command "status" (paramOptional paramPaths) seek - "shows status information about the annex"] + SectionQuery "shows status information about the annex"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/Sync.hs b/Command/Sync.hs index 39eda90f7..eb312c25b 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -34,7 +34,7 @@ import Data.Hash.MD5 def :: [Command] def = [command "sync" (paramOptional (paramRepeating paramRemote)) - [seek] "synchronize local repository with remotes"] + [seek] SectionCommon "synchronize local repository with remotes"] -- syncing involves several operations, any of which can independently fail seek :: CommandSeek diff --git a/Command/Test.hs b/Command/Test.hs index 7ff9f2963..bf15dcf50 100644 --- a/Command/Test.hs +++ b/Command/Test.hs @@ -11,7 +11,8 @@ import Command def :: [Command] def = [ dontCheck repoExists $ - command "test" paramNothing seek "run built-in test suite"] + command "test" paramNothing seek SectionPlumbing + "run built-in test suite"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs index 800b72169..aacc69bb1 100644 --- a/Command/TransferInfo.hs +++ b/Command/TransferInfo.hs @@ -15,7 +15,7 @@ import Types.Key import qualified Fields def :: [Command] -def = [noCommit $ command "transferinfo" paramKey seek +def = [noCommit $ command "transferinfo" paramKey seek SectionPlumbing "updates sender on number of bytes of content received"] seek :: [CommandSeek] diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index e2c926d40..eb657d738 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -20,7 +20,7 @@ import qualified Option def :: [Command] def = [withOptions options $ - noCommit $ command "transferkey" paramKey seek + noCommit $ command "transferkey" paramKey seek SectionPlumbing "transfers a key from or to a remote"] options :: [Option] diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index 2114e2278..5fc993dc1 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -23,7 +23,8 @@ data TransferRequest = TransferRequest Direction Remote Key AssociatedFile def :: [Command] def = [withOptions options $ - command "transferkeys" paramNothing seek "plumbing; transfers keys"] + command "transferkeys" paramNothing seek + SectionPlumbing "transfers keys"] options :: [Option] options = [readFdOption, writeFdOption] diff --git a/Command/Trust.hs b/Command/Trust.hs index d976b86a8..26993ef77 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -13,7 +13,8 @@ import qualified Remote import Logs.Trust def :: [Command] -def = [command "trust" (paramRepeating paramRemote) seek "trust a repository"] +def = [command "trust" (paramRepeating paramRemote) seek + SectionSetup "trust a repository"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/Unannex.hs b/Command/Unannex.hs index d1f27e86a..86cc7d00b 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -17,7 +17,8 @@ import qualified Git.LsFiles as LsFiles def :: [Command] def = [notDirect $ - command "unannex" paramPaths seek "undo accidential add command"] + command "unannex" paramPaths seek SectionUtility + "undo accidential add command"] seek :: [CommandSeek] seek = [withFilesInGit $ whenAnnexed start] diff --git a/Command/Ungroup.hs b/Command/Ungroup.hs index ea5b8edb6..a6557f21d 100644 --- a/Command/Ungroup.hs +++ b/Command/Ungroup.hs @@ -16,7 +16,8 @@ import Types.Group import qualified Data.Set as S def :: [Command] -def = [command "ungroup" (paramPair paramRemote paramDesc) seek "remove a repository from a group"] +def = [command "ungroup" (paramPair paramRemote paramDesc) seek + SectionSetup "remove a repository from a group"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 2ba32a2a6..c57fff017 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -19,7 +19,7 @@ import Annex.Content def :: [Command] def = [notDirect $ addCheck check $ command "uninit" paramPaths seek - "de-initialize git-annex and clean out repository"] + SectionUtility "de-initialize git-annex and clean out repository"] check :: Annex () check = do diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 422afcc55..371b423ee 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -18,7 +18,7 @@ def = , c "edit" "same as unlock" ] where - c n = notDirect . command n paramPaths seek + c n = notDirect . command n paramPaths seek SectionCommon seek :: [CommandSeek] seek = [withFilesInGit $ whenAnnexed start] diff --git a/Command/Untrust.hs b/Command/Untrust.hs index e16040e6b..f18637838 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -14,7 +14,7 @@ import Logs.Trust def :: [Command] def = [command "untrust" (paramRepeating paramRemote) seek - "do not trust a repository"] + SectionSetup "do not trust a repository"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/Unused.hs b/Command/Unused.hs index 25cd18c63..6c4a61cd4 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -37,7 +37,7 @@ import Types.Key def :: [Command] def = [withOptions [fromOption] $ command "unused" paramNothing seek - "look for unused file content"] + SectionMaintenance "look for unused file content"] fromOption :: Option fromOption = Option.field ['f'] "from" paramRemote "remote to check for unused content" diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index d1c1eb3b0..88ca8622d 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -14,7 +14,8 @@ import Annex.Version def :: [Command] def = [dontCheck repoExists $ -- because an old version may not seem to exist - command "upgrade" paramNothing seek "upgrade repository layout"] + command "upgrade" paramNothing seek + SectionMaintenance "upgrade repository layout"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Command/Version.hs b/Command/Version.hs index e066bba5d..9d2399b86 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -15,7 +15,7 @@ import BuildFlags def :: [Command] def = [noCommit $ noRepo showPackageVersion $ dontCheck repoExists $ - command "version" paramNothing seek "show version info"] + command "version" paramNothing seek SectionQuery "show version info"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 8aefd86bb..ad0fa0201 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -25,7 +25,7 @@ import Remote def :: [Command] def = [command "vicfg" paramNothing seek - "edit git-annex's configuration"] + SectionSetup "edit git-annex's configuration"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Command/Watch.hs b/Command/Watch.hs index 25b5c6bba..f965c30cd 100644 --- a/Command/Watch.hs +++ b/Command/Watch.hs @@ -14,7 +14,7 @@ import Option def :: [Command] def = [notBareRepo $ withOptions [foregroundOption, stopOption] $ - command "watch" paramNothing seek "watch for changes"] + command "watch" paramNothing seek SectionCommon "watch for changes"] seek :: [CommandSeek] seek = [withFlag stopOption $ \stopdaemon -> diff --git a/Command/WebApp.hs b/Command/WebApp.hs index 5e461ed21..0d232fcdf 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -31,7 +31,7 @@ import System.Process (env, std_out, std_err) def :: [Command] def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ notBareRepo $ - command "webapp" paramNothing seek "launch webapp"] + command "webapp" paramNothing seek SectionCommon "launch webapp"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 251c4ec7a..7086bf645 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -16,7 +16,7 @@ import Logs.Trust def :: [Command] def = [noCommit $ command "whereis" paramPaths seek - "lists repositories that have file content"] + SectionQuery "lists repositories that have file content"] seek :: [CommandSeek] seek = [withValue (remoteMap id) $ \m -> diff --git a/Command/XMPPGit.hs b/Command/XMPPGit.hs index c54d6a84a..c1ff0b108 100644 --- a/Command/XMPPGit.hs +++ b/Command/XMPPGit.hs @@ -13,7 +13,8 @@ import Assistant.XMPP.Git def :: [Command] def = [noCommit $ noRepo xmppGitRelay $ dontCheck repoExists $ - command "xmppgit" paramNothing seek "git to XMPP relay (internal use)"] + command "xmppgit" paramNothing seek + SectionPlumbing "git to XMPP relay"] seek :: [CommandSeek] seek = [withWords start] diff --git a/GitAnnex.hs b/GitAnnex.hs index 6a0139dce..b78493dfc 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -9,18 +9,10 @@ module GitAnnex where -import System.Console.GetOpt - -import Common.Annex -import qualified Git.Config import qualified Git.CurrentRepo import CmdLine import Command -import Types.TrustLevel -import qualified Annex -import qualified Remote -import qualified Limit -import qualified Option +import GitAnnex.Options import qualified Command.Add import qualified Command.Unannex @@ -145,49 +137,8 @@ cmds = concat #endif ] -options :: [Option] -options = Option.common ++ - [ 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 ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob) - "skip files matching the glob pattern" - , Option ['I'] ["include"] (ReqArg Limit.addInclude paramGlob) - "don't skip files matching the glob pattern" - , Option ['i'] ["in"] (ReqArg Limit.addIn paramRemote) - "skip files not present in a remote" - , Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber) - "skip files with fewer copies" - , Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName) - "skip files not using a key-value backend" - , Option [] ["inallgroup"] (ReqArg Limit.addInAllGroup paramGroup) - "skip files not present in all remotes in a group" - , Option [] ["largerthan"] (ReqArg Limit.addLargerThan paramSize) - "skip files larger than a size" - , Option [] ["smallerthan"] (ReqArg Limit.addSmallerThan paramSize) - "skip files smaller than a size" - , Option ['T'] ["time-limit"] (ReqArg Limit.addTimeLimit paramTime) - "stop after the specified amount of time" - , Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier")) - "Trust Amazon Glacier inventory" - ] ++ Option.matcher - where - setnumcopies v = maybe noop - (\n -> Annex.changeGitConfig $ \c -> c { annexNumCopies = n }) - (readish v) - setgitconfig v = Annex.changeGitRepo =<< inRepo (Git.Config.store v) - - trustArg t = ReqArg (Remote.forceTrust t) paramRemote - header :: String -header = "Usage: git-annex command [option ..]" +header = "git-annex command [option ...]" run :: [String] -> IO () run args = dispatch True args cmds options [] header Git.CurrentRepo.get diff --git a/GitAnnex/Options.hs b/GitAnnex/Options.hs new file mode 100644 index 000000000..7710c2ff2 --- /dev/null +++ b/GitAnnex/Options.hs @@ -0,0 +1,60 @@ +{- git-annex options + - + - Copyright 2010, 2013 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module GitAnnex.Options where + +import System.Console.GetOpt + +import Common.Annex +import qualified Git.Config +import Command +import Types.TrustLevel +import qualified Annex +import qualified Remote +import qualified Limit +import qualified Option + +options :: [Option] +options = Option.common ++ + [ 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 ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob) + "skip files matching the glob pattern" + , Option ['I'] ["include"] (ReqArg Limit.addInclude paramGlob) + "don't skip files matching the glob pattern" + , Option ['i'] ["in"] (ReqArg Limit.addIn paramRemote) + "skip files not present in a remote" + , Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber) + "skip files with fewer copies" + , Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName) + "skip files not using a key-value backend" + , Option [] ["inallgroup"] (ReqArg Limit.addInAllGroup paramGroup) + "skip files not present in all remotes in a group" + , Option [] ["largerthan"] (ReqArg Limit.addLargerThan paramSize) + "skip files larger than a size" + , Option [] ["smallerthan"] (ReqArg Limit.addSmallerThan paramSize) + "skip files smaller than a size" + , Option ['T'] ["time-limit"] (ReqArg Limit.addTimeLimit paramTime) + "stop after the specified amount of time" + , Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier")) + "Trust Amazon Glacier inventory" + ] ++ Option.matcher + where + setnumcopies v = maybe noop + (\n -> Annex.changeGitConfig $ \c -> c { annexNumCopies = n }) + (readish v) + setgitconfig v = Annex.changeGitRepo =<< inRepo (Git.Config.store v) + + trustArg t = ReqArg (Remote.forceTrust t) paramRemote diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs index fca36cfc5..2661d52e8 100644 --- a/GitAnnexShell.hs +++ b/GitAnnexShell.hs @@ -62,7 +62,7 @@ options = Option.common ++ expected ++ " but found " ++ s header :: String -header = "Usage: git-annex-shell [-c] command [parameters ...] [option ..]" +header = "git-annex-shell [-c] command [parameters ...] [option ...]" run :: [String] -> IO () run [] = failure @@ -126,7 +126,7 @@ checkField (field, value) | otherwise = False failure :: IO () -failure = error $ "bad parameters\n\n" ++ usage header cmds options +failure = error $ "bad parameters\n\n" ++ usage header cmds checkNotLimited :: IO () checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED" @@ -1,4 +1,4 @@ -{- git-annex command-line options +{- common command-line options - - Copyright 2010-2011 Joey Hess <joey@kitenet.net> - diff --git a/Types/Command.hs b/Types/Command.hs index b652bdad5..4b92ca173 100644 --- a/Types/Command.hs +++ b/Types/Command.hs @@ -42,6 +42,7 @@ data Command = Command , cmdname :: String , cmdparamdesc :: String -- description of params for usage , cmdseek :: [CommandSeek] -- seek stage + , cmdsection :: CommandSection , cmddesc :: String -- description of command for usage } @@ -52,6 +53,24 @@ instance Eq CommandCheck where instance Eq Command where a == b = cmdname a == cmdname b -{- Order commands by name -} +{- Order commands by name. -} instance Ord Command where compare = comparing cmdname + +{- The same sections are listed in doc/git-annex.mdwn -} +data CommandSection + = SectionCommon + | SectionSetup + | SectionMaintenance + | SectionQuery + | SectionUtility + | SectionPlumbing + deriving (Eq, Ord, Enum, Bounded) + +descSection :: CommandSection -> String +descSection SectionCommon = "Commonly used commands" +descSection SectionSetup = "Repository setup commands" +descSection SectionMaintenance = "Repository maintenance commands" +descSection SectionQuery = "Query commands" +descSection SectionUtility = "Utility commands" +descSection SectionPlumbing = "Plumbing commands" @@ -8,46 +8,54 @@ module Usage where import Common.Annex -import System.Console.GetOpt import Types.Command -{- Usage message with lists of commands and options. -} -usage :: String -> [Command] -> [Option] -> String -usage header cmds commonoptions = unlines $ - [ header - , "" - , "Options:" - ] ++ optlines ++ - [ "" - , "Commands:" - , "" - ] ++ cmdlines +import System.Console.GetOpt + +usageMessage :: String -> String +usageMessage s = "Usage: " ++ s + +{- Usage message with lists of commands by section. -} +usage :: String -> [Command] -> String +usage header cmds = unlines $ usageMessage header : concatMap go [minBound..] where - -- To get consistent indentation of options, generate the - -- usage for all options at once. A command's options will - -- be displayed after the command. - alloptlines = filter (not . null) $ - lines $ usageInfo "" $ - concatMap cmdoptions scmds ++ commonoptions - (cmdlines, optlines) = go scmds alloptlines [] - go [] os ls = (ls, os) - go (c:cs) os ls = go cs os' (ls++(l:o)) + go section + | null cs = [] + | otherwise = + [ "" + , descSection section ++ ":" + , "" + ] ++ map cmdline cs where - (o, os') = splitAt (length $ cmdoptions c) os - l = concat - [ cmdname c - , namepad (cmdname c) - , cmdparamdesc c - , descpad (cmdparamdesc c) - , cmddesc c - ] + cs = filter (\c -> cmdsection c == section) scmds + cmdline c = concat + [ cmdname c + , namepad (cmdname c) + , cmdparamdesc c + , descpad (cmdparamdesc c) + , cmddesc c + ] pad n s = replicate (n - length s) ' ' namepad = pad $ longest cmdname + 1 descpad = pad $ longest cmdparamdesc + 2 longest f = foldl max 0 $ map (length . f) cmds scmds = sort cmds +{- Usage message for a single command. -} +commandUsage :: Command -> String +commandUsage cmd = unlines + [ usageInfo header (cmdoptions cmd) + , "To see additional options common to all commands, run: git annex help options" + ] + where + header = usageMessage $ unwords + [ "git-annex" + , cmdname cmd + , cmdparamdesc cmd + , "[option ...]" + ] + {- Descriptions of params used in usage messages. -} paramPaths :: String paramPaths = paramOptional $ paramRepeating paramPath -- most often used diff --git a/debian/changelog b/debian/changelog index 51d17c53b..a37eec421 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +git-annex (4.20130324) UNRELEASED; urgency=low + + * Group subcommands into sections in usage. Closes: #703797 + * Per-command usage messages. + + -- Joey Hess <joeyh@debian.org> Mon, 25 Mar 2013 10:21:46 -0400 + git-annex (4.20130323) unstable; urgency=low * webapp: Repository list is now included in the dashboard, and other |