diff options
99 files changed, 391 insertions, 297 deletions
diff --git a/CmdLine/Batch.hs b/CmdLine/Batch.hs index 836472eb0..24f942978 100644 --- a/CmdLine/Batch.hs +++ b/CmdLine/Batch.hs @@ -20,7 +20,7 @@ type Batchable t = BatchMode -> t -> CommandStart -- In batch mode, one line at a time is read, parsed, and a reply output to -- stdout. In non batch mode, the command's parameters are parsed and -- a reply output for each. -batchable :: ((t -> CommandStart) -> CommandSeek) -> Batchable t -> CommandSeek +batchable :: ((t -> CommandStart) -> CmdParams -> CommandSeek) -> Batchable t -> CmdParams -> CommandSeek batchable seeker starter params = ifM (getOptionFlag batchOption) ( batchloop , seeker (starter NoBatch) params diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index 5619129f5..8967bc471 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -16,7 +16,6 @@ import Utility.Env import Annex.Ssh import qualified Command.Add -{- import qualified Command.Unannex import qualified Command.Drop import qualified Command.Move @@ -117,12 +116,10 @@ import qualified Command.TestRemote #ifdef WITH_EKG import System.Remote.Monitoring #endif --} cmds :: [Command] cmds = [ Command.Add.cmd -{- , Command.Get.cmd , Command.Drop.cmd , Command.Move.cmd @@ -221,7 +218,6 @@ cmds = , Command.FuzzTest.cmd , Command.TestRemote.cmd #endif --} ] header :: String diff --git a/CmdLine/Usage.hs b/CmdLine/Usage.hs index b386be9a6..58408762b 100644 --- a/CmdLine/Usage.hs +++ b/CmdLine/Usage.hs @@ -1,6 +1,6 @@ {- git-annex usage messages - - - Copyright 2010-2011 Joey Hess <id@joeyh.name> + - Copyright 2010-2015 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -8,10 +8,10 @@ module CmdLine.Usage where import Common.Annex - import Types.Command import System.Console.GetOpt +import qualified Options.Applicative as O usageMessage :: String -> String usageMessage s = "Usage: " ++ s @@ -56,6 +56,13 @@ commandUsage cmd = unlines , "[option ...]" ] +{- Simple CommandParser generator, for when the CommandSeek wants all + - non-option parameters. -} +withParams :: (CmdParams -> CommandSeek) -> String -> CommandParser +withParams mkseek paramdesc = mkseek <$> O.many cmdparams + where + cmdparams = O.argument O.str (O.metavar paramdesc) + {- Descriptions of params used in usage messages. -} paramPaths :: String paramPaths = paramRepeating paramPath -- most often used diff --git a/Command.hs b/Command.hs index 4fc665ba2..c1d788c79 100644 --- a/Command.hs +++ b/Command.hs @@ -7,7 +7,6 @@ module Command ( command, - commandParser, noRepo, noCommit, noMessages, @@ -33,20 +32,11 @@ import CmdLine.Action as ReExported import CmdLine.Option as ReExported import CmdLine.GitAnnex.Options as ReExported -import qualified Options.Applicative as O - {- Generates a normal Command -} -command :: String -> String -> CommandSection -> String -> (Command -> CommandParser) -> Command -command name paramdesc section desc parser = c - where - c = Command [] Nothing commonChecks False False name paramdesc section desc (parser c) - -{- Simple CommandParser generator, for when the CommandSeek wants all - - non-option parameters. -} -commandParser :: (CmdParams -> CommandSeek) -> Command -> CommandParser -commandParser mkseek c = mkseek <$> O.many cmdparams - where - cmdparams = O.argument O.str (O.metavar (cmdparamdesc c)) +command :: String -> CommandSection -> String -> String -> (String -> CommandParser) -> Command +command name section desc paramdesc mkparser = + Command [] Nothing commonChecks False False name paramdesc + section desc (mkparser paramdesc) {- Indicates that a command doesn't need to commit any changes to - the git-annex branch. -} diff --git a/Command/Add.hs b/Command/Add.hs index 689f2c6a5..270ac7f39 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -36,8 +36,8 @@ import Control.Exception (IOException) cmd :: Command cmd = notBareRepo $ withOptions addOptions $ - command "add" paramPaths SectionCommon "add files to annex" - (commandParser seek) + command "add" SectionCommon "add files to annex" + paramPaths (withParams seek) addOptions :: [Option] addOptions = includeDotFilesOption : fileMatchingOptions @@ -71,8 +71,8 @@ startSmall file = do performAdd :: FilePath -> CommandPerform performAdd file = do - params <- forceParams - Annex.Queue.addCommand "add" (params++[Param "--"]) [file] + ps <- forceParams + Annex.Queue.addCommand "add" (ps++[Param "--"]) [file] next $ return True {- The add subcommand annexes a file, generating a key for it using a @@ -279,8 +279,8 @@ addLink :: FilePath -> Key -> Maybe InodeCache -> Annex () addLink file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig) ( do _ <- link file key mcache - params <- forceParams - Annex.Queue.addCommand "add" (params++[Param "--"]) [file] + ps <- forceParams + Annex.Queue.addCommand "add" (ps++[Param "--"]) [file] , do l <- link file key mcache addAnnexLink l file diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs index a0e9ccba6..2b315eada 100644 --- a/Command/AddUnused.hs +++ b/Command/AddUnused.hs @@ -15,10 +15,12 @@ import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Types.Key cmd :: Command -cmd = notDirect $ command "addunused" (paramRepeating paramNumRange) - seek SectionMaintenance "add back unused files" +cmd = notDirect $ + command "addunused" SectionMaintenance + "add back unused files" + (paramRepeating paramNumRange) (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withUnusedMaps start start :: UnusedMaps -> Int -> CommandStart diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index f009ff388..45edca283 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -39,8 +39,8 @@ import qualified Utility.Quvi as Quvi cmd :: Command cmd = notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption, rawOption] $ - command "addurl" (paramRepeating paramUrl) seek - SectionCommon "add urls to annex" + command "addurl" SectionCommon "add urls to annex" + (paramRepeating paramUrl) (withParams seek) fileOption :: Option fileOption = fieldOption [] "file" paramFile "specify what file the url is added to" @@ -54,7 +54,7 @@ relaxedOption = flagOption [] "relaxed" "skip size check" rawOption :: Option rawOption = flagOption [] "raw" "disable special handling for torrents, quvi, etc" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek us = do optfile <- getOptionField fileOption return relaxed <- getOptionFlag relaxedOption diff --git a/Command/Assistant.hs b/Command/Assistant.hs index d405bc8b3..51d5a46b2 100644 --- a/Command/Assistant.hs +++ b/Command/Assistant.hs @@ -21,8 +21,9 @@ import System.Environment cmd :: Command cmd = noRepo checkNoRepoOpts $ dontCheck repoExists $ withOptions options $ - notBareRepo $ command "assistant" paramNothing seek SectionCommon + notBareRepo $ command "assistant" SectionCommon "automatically sync changes" + paramNothing (withParams seek) options :: [Option] options = @@ -42,7 +43,7 @@ autoStopOption = flagOption [] "autostop" "stop in known repositories" startDelayOption :: Option startDelayOption = fieldOption [] "startdelay" paramNumber "delay before running startup scan" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do stopdaemon <- getOptionFlag Command.Watch.stopOption foreground <- getOptionFlag Command.Watch.foregroundOption diff --git a/Command/CheckPresentKey.hs b/Command/CheckPresentKey.hs index e212a2da8..6a38f8501 100644 --- a/Command/CheckPresentKey.hs +++ b/Command/CheckPresentKey.hs @@ -15,10 +15,13 @@ import Annex import Types.Messages cmd :: Command -cmd = noCommit $ command "checkpresentkey" (paramPair paramKey paramRemote) seek - SectionPlumbing "check if key is present in remote" +cmd = noCommit $ + command "checkpresentkey" SectionPlumbing + "check if key is present in remote" + (paramPair paramKey paramRemote) + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/Commit.hs b/Command/Commit.hs index b94182a06..52b88d2b3 100644 --- a/Command/Commit.hs +++ b/Command/Commit.hs @@ -13,9 +13,9 @@ import qualified Annex.Branch import qualified Git cmd :: Command -cmd = command "commit" paramNothing - SectionPlumbing "commits any staged changes to the git-annex branch" - (commandParser seek) +cmd = command "commit" SectionPlumbing + "commits any staged changes to the git-annex branch" + paramNothing (withParams seek) seek :: CmdParams -> CommandSeek seek = withNothing start diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index 78c6d8d24..95498ba20 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -16,9 +16,10 @@ import qualified Git.Config import Remote.GCrypt (coreGCryptId) cmd :: Command -cmd = noCommit $ command "configlist" paramNothing - SectionPlumbing "outputs relevant git configuration" - (commandParser seek) +cmd = noCommit $ + command "configlist" SectionPlumbing + "outputs relevant git configuration" + paramNothing (withParams seek) seek :: CmdParams -> CommandSeek seek = withNothing start diff --git a/Command/ContentLocation.hs b/Command/ContentLocation.hs index be781b5e2..bca73f926 100644 --- a/Command/ContentLocation.hs +++ b/Command/ContentLocation.hs @@ -14,10 +14,11 @@ import Annex.Content cmd :: Command cmd = withOptions [batchOption] $ noCommit $ noMessages $ - command "contentlocation" (paramRepeating paramKey) seek - SectionPlumbing "looks up content for a key" + command "contentlocation" SectionPlumbing + "looks up content for a key" + (paramRepeating paramKey) (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = batchable withKeys start start :: Batchable Key diff --git a/Command/Copy.hs b/Command/Copy.hs index ab4d8e25e..26ff8e263 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -15,13 +15,15 @@ import Annex.Wanted import Annex.NumCopies cmd :: Command -cmd = withOptions copyOptions $ command "copy" paramPaths seek - SectionCommon "copy content of files to/from another repository" +cmd = withOptions copyOptions $ + command "copy" SectionCommon + "copy content of files to/from another repository" + paramPaths (withParams seek) copyOptions :: [Option] copyOptions = Command.Move.moveOptions ++ [autoOption] -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do to <- getOptionField toOption Remote.byNameWithUUID from <- getOptionField fromOption Remote.byNameWithUUID diff --git a/Command/Dead.hs b/Command/Dead.hs index 75efd0dd5..e487b3b5e 100644 --- a/Command/Dead.hs +++ b/Command/Dead.hs @@ -18,14 +18,14 @@ import Remote (keyLocations) cmd :: Command cmd = withOptions [keyOption] $ - command "dead" (paramRepeating paramRemote) seek - SectionSetup "hide a lost repository or key" + command "dead" SectionSetup "hide a lost repository or key" + (paramRepeating paramRemote) (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = maybe (trustCommand "dead" DeadTrusted ps) (flip seekKey ps) =<< Annex.getField "key" -seekKey :: String -> CommandSeek +seekKey :: String -> CmdParams -> CommandSeek seekKey ks = case file2key ks of Nothing -> error "Invalid key" Just key -> withNothing (startKey key) diff --git a/Command/Describe.hs b/Command/Describe.hs index 6ff67f112..ca0bac4e8 100644 --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -13,10 +13,12 @@ import qualified Remote import Logs.UUID cmd :: Command -cmd = command "describe" (paramPair paramRemote paramDesc) seek - SectionSetup "change description of a repository" +cmd = command "describe" SectionSetup + "change description of a repository" + (paramPair paramRemote paramDesc) + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/DiffDriver.hs b/Command/DiffDriver.hs index c93bec525..2313e5f0d 100644 --- a/Command/DiffDriver.hs +++ b/Command/DiffDriver.hs @@ -15,10 +15,11 @@ import Git.Types cmd :: Command cmd = dontCheck repoExists $ - command "diffdriver" ("[-- cmd --]") seek - SectionPlumbing "external git diff driver shim" + command "diffdriver" SectionPlumbing + "external git diff driver shim" + ("-- cmd --") (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/Direct.hs b/Command/Direct.hs index 3eda794a0..162780dd5 100644 --- a/Command/Direct.hs +++ b/Command/Direct.hs @@ -17,10 +17,10 @@ import Annex.Direct cmd :: Command cmd = notBareRepo $ noDaemonRunning $ - command "direct" paramNothing seek - SectionSetup "switch repository to direct mode" + command "direct" SectionSetup "switch repository to direct mode" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/Drop.hs b/Command/Drop.hs index 496d5c55c..a93dac595 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -23,8 +23,10 @@ import Annex.Notification import qualified Data.Set as S cmd :: Command -cmd = withOptions (dropOptions) $ command "drop" paramPaths seek - SectionCommon "indicate content of files not currently wanted" +cmd = withOptions (dropOptions) $ + command "drop" SectionCommon + "indicate content of files not currently wanted" + paramPaths (withParams seek) dropOptions :: [Option] dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption] ++ keyOptions @@ -32,7 +34,7 @@ dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption] ++ keyOpti dropFromOption :: Option dropFromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do from <- getOptionField dropFromOption Remote.byNameWithUUID auto <- getOptionFlag autoOption diff --git a/Command/DropKey.hs b/Command/DropKey.hs index 09366c262..5d44f0fcd 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -14,9 +14,11 @@ import Logs.Location import Annex.Content cmd :: Command -cmd = noCommit $ command "dropkey" (paramRepeating paramKey) - SectionPlumbing "drops annexed content for specified keys" - (commandParser seek) +cmd = noCommit $ + command "dropkey" SectionPlumbing + "drops annexed content for specified keys" + (paramRepeating paramKey) + (withParams seek) seek :: CmdParams -> CommandSeek seek = withKeys start diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 99e1e063d..703cc3890 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -18,10 +18,11 @@ import Annex.NumCopies cmd :: Command cmd = withOptions [Command.Drop.dropFromOption] $ - command "dropunused" (paramRepeating paramNumRange) - seek SectionMaintenance "drop unused file content" + command "dropunused" SectionMaintenance + "drop unused file content" + (paramRepeating paramNumRange) (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do numcopies <- getNumCopies withUnusedMaps (start numcopies) ps diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs index ccf6d9aab..1d4c4af5e 100644 --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -16,11 +16,12 @@ import qualified Command.InitRemote as InitRemote import qualified Data.Map as M cmd :: Command -cmd = command "enableremote" +cmd = command "enableremote" SectionSetup + "enables use of an existing special remote" (paramPair paramName $ paramOptional $ paramRepeating paramKeyValue) - seek SectionSetup "enables use of an existing special remote" + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/ExamineKey.hs b/Command/ExamineKey.hs index 5ece3a99a..65f4978a6 100644 --- a/Command/ExamineKey.hs +++ b/Command/ExamineKey.hs @@ -16,10 +16,11 @@ import Types.Key cmd :: Command cmd = noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $ - command "examinekey" (paramRepeating paramKey) seek - SectionPlumbing "prints information from a key" + command "examinekey" SectionPlumbing + "prints information from a key" + (paramRepeating paramKey) (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do format <- getFormat batchable withKeys (start format) ps diff --git a/Command/Expire.hs b/Command/Expire.hs index 44bdd113f..9552128f1 100644 --- a/Command/Expire.hs +++ b/Command/Expire.hs @@ -21,8 +21,10 @@ import Data.Time.Clock.POSIX import qualified Data.Map as M cmd :: Command -cmd = withOptions [activityOption, noActOption] $ command "expire" paramExpire seek - SectionMaintenance "expire inactive repositories" +cmd = withOptions [activityOption, noActOption] $ + command "expire" SectionMaintenance + "expire inactive repositories" + paramExpire (withParams seek) paramExpire :: String paramExpire = (paramRepeating $ paramOptional paramRemote ++ ":" ++ paramTime) @@ -33,7 +35,7 @@ activityOption = fieldOption [] "activity" "Name" "specify activity" noActOption :: Option noActOption = flagOption [] "no-act" "don't really do anything" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do expire <- parseExpire ps wantact <- getOptionField activityOption (pure . parseActivity) diff --git a/Command/Find.hs b/Command/Find.hs index d0bb165c3..5a0a08973 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -21,7 +21,8 @@ import Types.Key cmd :: Command cmd = withOptions annexedMatchingOptions $ mkCommand $ - command "find" paramPaths seek SectionQuery "lists available files" + command "find" SectionQuery "lists available files" + paramPaths (withParams seek) mkCommand :: Command -> Command mkCommand = noCommit . noMessages . withOptions [formatOption, print0Option, jsonOption] @@ -38,7 +39,7 @@ print0Option = Option [] ["print0"] (NoArg set) where set = Annex.setField (optionName formatOption) "${file}\0" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do format <- getFormat withFilesInGit (whenAnnexed $ start format) ps diff --git a/Command/FindRef.hs b/Command/FindRef.hs index 3f09cd6b3..cd7583b96 100644 --- a/Command/FindRef.hs +++ b/Command/FindRef.hs @@ -12,10 +12,11 @@ import qualified Command.Find as Find cmd :: Command cmd = withOptions nonWorkTreeMatchingOptions $ Find.mkCommand $ - command "findref" paramRef seek SectionPlumbing + command "findref" SectionPlumbing "lists files in a git ref" + paramRef (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek refs = do format <- Find.getFormat Find.start format `withFilesInRefs` refs diff --git a/Command/Fix.hs b/Command/Fix.hs index 6a27878e3..a5f385b4f 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -20,9 +20,9 @@ import Utility.Touch cmd :: Command cmd = notDirect $ noCommit $ withOptions annexedMatchingOptions $ - command "fix" paramPaths - SectionMaintenance "fix up symlinks to point to annexed content" - (commandParser seek) + command "fix" SectionMaintenance + "fix up symlinks to point to annexed content" + paramPaths (withParams seek) seek :: CmdParams -> CommandSeek seek = withFilesInGit $ whenAnnexed start diff --git a/Command/Forget.hs b/Command/Forget.hs index 370dc8b1e..24789fe44 100644 --- a/Command/Forget.hs +++ b/Command/Forget.hs @@ -16,8 +16,10 @@ import qualified Annex import Data.Time.Clock.POSIX cmd :: Command -cmd = withOptions forgetOptions $ command "forget" paramNothing seek - SectionMaintenance "prune git-annex branch history" +cmd = withOptions forgetOptions $ + command "forget" SectionMaintenance + "prune git-annex branch history" + paramNothing (withParams seek) forgetOptions :: [Option] forgetOptions = [dropDeadOption] @@ -25,7 +27,7 @@ forgetOptions = [dropDeadOption] dropDeadOption :: Option dropDeadOption = flagOption [] "drop-dead" "drop references to dead repositories" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do dropdead <- getOptionFlag dropDeadOption withNothing (start dropdead) ps diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 78ebb6268..6a3fe3a4a 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -21,10 +21,11 @@ import Network.URI cmd :: Command cmd = notDirect $ notBareRepo $ - command "fromkey" (paramPair paramKey paramPath) seek - SectionPlumbing "adds a file using a specific key" + command "fromkey" SectionPlumbing "adds a file using a specific key" + (paramPair paramKey paramPath) + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do force <- Annex.getState Annex.force withWords (start force) ps diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 177db6498..29ef01032 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -41,8 +41,9 @@ import Data.Time.Clock.POSIX import System.Posix.Types (EpochTime) cmd :: Command -cmd = withOptions fsckOptions $ command "fsck" paramPaths seek - SectionMaintenance "check for problems" +cmd = withOptions fsckOptions $ + command "fsck" SectionMaintenance "check for problems" + paramPaths (withParams seek) fsckFromOption :: Option fsckFromOption = fieldOption ['f'] "from" paramRemote "check remote" @@ -65,7 +66,7 @@ fsckOptions = , incrementalScheduleOption ] ++ keyOptions ++ annexedMatchingOptions -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do from <- getOptionField fsckFromOption Remote.byNameWithUUID u <- maybe getUUID (pure . Remote.uuid) from diff --git a/Command/FuzzTest.hs b/Command/FuzzTest.hs index bc8cc1161..e15632c81 100644 --- a/Command/FuzzTest.hs +++ b/Command/FuzzTest.hs @@ -21,10 +21,12 @@ import Test.QuickCheck import Control.Concurrent cmd :: Command -cmd = notBareRepo $ command "fuzztest" paramNothing seek SectionTesting - "generates fuzz test files" +cmd = notBareRepo $ + command "fuzztest" SectionTesting + "generates fuzz test files" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/GCryptSetup.hs b/Command/GCryptSetup.hs index e267aaf67..5c2686635 100644 --- a/Command/GCryptSetup.hs +++ b/Command/GCryptSetup.hs @@ -15,9 +15,9 @@ import qualified Git cmd :: Command cmd = dontCheck repoExists $ noCommit $ - command "gcryptsetup" paramValue - SectionPlumbing "sets up gcrypt repository" - (commandParser seek) + command "gcryptsetup" SectionPlumbing + "sets up gcrypt repository" + paramValue (withParams seek) seek :: CmdParams -> CommandSeek seek = withStrings start diff --git a/Command/Get.hs b/Command/Get.hs index f54e88b7a..297f5d27b 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -17,14 +17,16 @@ import Annex.Wanted import qualified Command.Move cmd :: Command -cmd = withOptions getOptions $ command "get" paramPaths seek - SectionCommon "make content of annexed files available" +cmd = withOptions getOptions $ + command "get" SectionCommon + "make content of annexed files available" + paramPaths (withParams seek) getOptions :: [Option] getOptions = fromOption : autoOption : jobsOption : annexedMatchingOptions ++ incompleteOption : keyOptions -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do from <- getOptionField fromOption Remote.byNameWithUUID auto <- getOptionFlag autoOption diff --git a/Command/Group.hs b/Command/Group.hs index 839d21a4c..6543fa2fb 100644 --- a/Command/Group.hs +++ b/Command/Group.hs @@ -16,10 +16,10 @@ import Types.Group import qualified Data.Set as S cmd :: Command -cmd = command "group" (paramPair paramRemote paramDesc) seek - SectionSetup "add a repository to a group" +cmd = command "group" SectionSetup "add a repository to a group" + (paramPair paramRemote paramDesc) (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/GroupWanted.hs b/Command/GroupWanted.hs index f58544f6f..0565344b1 100644 --- a/Command/GroupWanted.hs +++ b/Command/GroupWanted.hs @@ -13,10 +13,12 @@ import Logs.PreferredContent import Command.Wanted (performGet, performSet) cmd :: Command -cmd = command "groupwanted" (paramPair paramGroup (paramOptional paramExpression)) seek - SectionSetup "get or set groupwanted expression" +cmd = command "groupwanted" SectionSetup + "get or set groupwanted expression" + (paramPair paramGroup (paramOptional paramExpression)) + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/Help.hs b/Command/Help.hs index b6b1be379..08873e2bb 100644 --- a/Command/Help.hs +++ b/Command/Help.hs @@ -23,9 +23,10 @@ import System.Console.GetOpt cmd :: Command cmd = noCommit $ noRepo startNoRepo $ dontCheck repoExists $ - command "help" "COMMAND" seek SectionCommon "display help" + command "help" SectionCommon "display help" + "COMMAND" (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart @@ -47,7 +48,7 @@ showCommonOptions = putStrLn $ usageInfo "Common options:" gitAnnexOptions showGeneralHelp :: IO () showGeneralHelp = putStrLn $ unlines [ "The most frequently used git-annex commands are:" - , unlines $ map cmdline $ concat + , unlines $ map cmdline $ [ Command.Init.cmd , Command.Add.cmd , Command.Drop.cmd diff --git a/Command/Import.hs b/Command/Import.hs index 6bc330fca..8d09f8478 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -23,8 +23,10 @@ import Types.TrustLevel import Logs.Trust cmd :: Command -cmd = withOptions opts $ notBareRepo $ command "import" paramPaths seek - SectionCommon "move and add files from outside git working copy" +cmd = withOptions opts $ notBareRepo $ + command "import" SectionCommon + "move and add files from outside git working copy" + paramPaths (withParams seek) opts :: [Option] opts = duplicateModeOptions ++ fileMatchingOptions @@ -60,7 +62,7 @@ getDuplicateMode = go . catMaybes <$> mapM getflag [minBound..maxBound] go ms = error $ "cannot combine " ++ unwords (map (optionParam . fromJust . associatedOption) ms) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do mode <- getDuplicateMode repopath <- liftIO . absPath =<< fromRepo Git.repoPath diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 4be84375c..5e4869b30 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -45,13 +45,13 @@ import Annex.MetaData cmd :: Command cmd = notBareRepo $ withOptions [templateOption, relaxedOption, rawOption] $ - command "importfeed" (paramRepeating paramUrl) seek - SectionCommon "import files from podcast feeds" + command "importfeed" SectionCommon "import files from podcast feeds" + (paramRepeating paramUrl) (withParams seek) templateOption :: Option templateOption = fieldOption [] "template" paramFormat "template for filenames" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do tmpl <- getOptionField templateOption return relaxed <- getOptionFlag relaxedOption diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs index 29d0750a5..c00f18ead 100644 --- a/Command/InAnnex.hs +++ b/Command/InAnnex.hs @@ -12,9 +12,11 @@ import Command import Annex.Content cmd :: Command -cmd = noCommit $ command "inannex" (paramRepeating paramKey) - SectionPlumbing "checks if keys are present in the annex" - (commandParser seek) +cmd = noCommit $ + command "inannex" SectionPlumbing + "checks if keys are present in the annex" + (paramRepeating paramKey) + (withParams seek) seek :: CmdParams -> CommandSeek seek = withKeys start diff --git a/Command/Indirect.hs b/Command/Indirect.hs index 3e10988ed..c12c91a48 100644 --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -24,10 +24,10 @@ import qualified Command.Add cmd :: Command cmd = notBareRepo $ noDaemonRunning $ - command "indirect" paramNothing seek - SectionSetup "switch repository to indirect mode" + command "indirect" SectionSetup "switch repository to indirect mode" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/Info.hs b/Command/Info.hs index 0c8200ff3..3012d4649 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -80,10 +80,11 @@ type StatState = StateT StatInfo Annex cmd :: Command cmd = noCommit $ dontCheck repoExists $ withOptions (jsonOption : bytesOption : annexedMatchingOptions) $ - command "info" (paramRepeating paramItem) seek SectionQuery - "shows information about the specified item or the repository as a whole" + command "info" SectionQuery + "shows information about the specified item or the repository as a whole" + (paramRepeating paramItem) (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/Init.hs b/Command/Init.hs index 45ecb92f8..0f32f1ba1 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -13,9 +13,10 @@ import Annex.Init cmd :: Command cmd = dontCheck repoExists $ - command "init" paramDesc seek SectionSetup "initialize git-annex" + command "init" SectionSetup "initialize git-annex" + paramDesc (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 4bf5f5312..a3a946944 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -20,11 +20,12 @@ import Logs.Trust import Data.Ord cmd :: Command -cmd = command "initremote" +cmd = command "initremote" SectionSetup + "creates a special (non-git) remote" (paramPair paramName $ paramOptional $ paramRepeating paramKeyValue) - seek SectionSetup "creates a special (non-git) remote" + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/List.hs b/Command/List.hs index ba27da702..723f53b46 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -25,13 +25,14 @@ import Git.Types (RemoteName) cmd :: Command cmd = noCommit $ withOptions (allrepos : annexedMatchingOptions) $ - command "list" paramPaths seek - SectionQuery "show which remotes contain files" + command "list" SectionQuery + "show which remotes contain files" + paramPaths (withParams seek) allrepos :: Option allrepos = flagOption [] "allrepos" "show all repositories, not only remotes" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do list <- getList printHeader list diff --git a/Command/Lock.hs b/Command/Lock.hs index 2d796ad4f..04c8b9494 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -14,10 +14,11 @@ import qualified Annex cmd :: Command cmd = notDirect $ withOptions annexedMatchingOptions $ - command "lock" paramPaths seek SectionCommon - "undo unlock command" + command "lock" SectionCommon + "undo unlock command" + paramPaths (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do withFilesUnlocked start ps withFilesUnlockedToBeCommitted start ps diff --git a/Command/Log.hs b/Command/Log.hs index 3d618360d..6f3967c6a 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -40,7 +40,8 @@ type Outputter = Bool -> POSIXTime -> [UUID] -> Annex () cmd :: Command cmd = withOptions options $ - command "log" paramPaths seek SectionQuery "shows location log" + command "log" SectionQuery "shows location log" + paramPaths (withParams seek) options :: [Option] options = passthruOptions ++ [gourceOption] ++ annexedMatchingOptions @@ -56,7 +57,7 @@ passthruOptions = map odate ["since", "after", "until", "before"] ++ gourceOption :: Option gourceOption = flagOption [] "gource" "format output for gource" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do m <- Remote.uuidDescriptions zone <- liftIO getCurrentTimeZone diff --git a/Command/LookupKey.hs b/Command/LookupKey.hs index 9b7dd3a9b..021dc963b 100644 --- a/Command/LookupKey.hs +++ b/Command/LookupKey.hs @@ -15,10 +15,11 @@ import Types.Key cmd :: Command cmd = withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $ - command "lookupkey" (paramRepeating paramFile) seek - SectionPlumbing "looks up key used for file" + command "lookupkey" SectionPlumbing + "looks up key used for file" + (paramRepeating paramFile) (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = batchable withStrings start start :: Batchable String diff --git a/Command/Map.hs b/Command/Map.hs index 4328139f1..955010809 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -27,10 +27,11 @@ data Link = Link Git.Repo Git.Repo cmd :: Command cmd = dontCheck repoExists $ - command "map" paramNothing seek SectionQuery + command "map" SectionQuery "generate map of repositories" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/Merge.hs b/Command/Merge.hs index b451db2af..8ea4e79e4 100644 --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -14,10 +14,11 @@ import qualified Git.Branch import Command.Sync (prepMerge, mergeLocal) cmd :: Command -cmd = command "merge" paramNothing seek SectionMaintenance +cmd = command "merge" SectionMaintenance "automatically merge changes from remotes" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do withNothing mergeBranch ps withNothing mergeSynced ps diff --git a/Command/MetaData.hs b/Command/MetaData.hs index d6adb0ad4..3b38c8b95 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -18,8 +18,9 @@ import Data.Time.Clock.POSIX cmd :: Command cmd = withOptions metaDataOptions $ - command "metadata" paramPaths seek - SectionMetaData "sets or gets metadata of a file" + command "metadata" + SectionMetaData "sets or gets metadata of a file" + paramPaths (withParams seek) metaDataOptions :: [Option] metaDataOptions = @@ -52,7 +53,7 @@ untagOption = Option ['u'] ["untag"] (ReqArg mkmod "TAG") "remove a tag" where mkmod = storeModMeta . AddMeta tagMetaField . mkMetaValue (CurrentlySet False) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do modmeta <- Annex.getState Annex.modmeta getfield <- getOptionField getOption $ \ms -> diff --git a/Command/Migrate.hs b/Command/Migrate.hs index d406dbea4..80d42e87a 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -20,10 +20,11 @@ import qualified Annex cmd :: Command cmd = notDirect $ withOptions annexedMatchingOptions $ - command "migrate" paramPaths seek - SectionUtility "switch data to different backend" + command "migrate" SectionUtility + "switch data to different backend" + paramPaths (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withFilesInGit $ whenAnnexed start start :: FilePath -> Key -> CommandStart diff --git a/Command/Mirror.hs b/Command/Mirror.hs index 8ae57da2f..f0880e87e 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -17,13 +17,15 @@ import Annex.Content import Annex.NumCopies cmd :: Command -cmd = withOptions mirrorOptions $ command "mirror" paramPaths seek - SectionCommon "mirror content of files to/from another repository" +cmd = withOptions mirrorOptions $ + command "mirror" SectionCommon + "mirror content of files to/from another repository" + paramPaths (withParams seek) mirrorOptions :: [Option] mirrorOptions = fromToOptions ++ [jobsOption] ++ annexedMatchingOptions ++ keyOptions -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do to <- getOptionField toOption Remote.byNameWithUUID from <- getOptionField fromOption Remote.byNameWithUUID diff --git a/Command/Move.hs b/Command/Move.hs index 739be4417..fc13ca254 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -18,13 +18,15 @@ import Annex.Transfer import Logs.Presence cmd :: Command -cmd = withOptions moveOptions $ command "move" paramPaths seek - SectionCommon "move content of files to/from another repository" +cmd = withOptions moveOptions $ + command "move" SectionCommon + "move content of files to/from another repository" + paramPaths (withParams seek) moveOptions :: [Option] moveOptions = fromToOptions ++ [jobsOption] ++ keyOptions ++ annexedMatchingOptions -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do to <- getOptionField toOption Remote.byNameWithUUID from <- getOptionField fromOption Remote.byNameWithUUID diff --git a/Command/NotifyChanges.hs b/Command/NotifyChanges.hs index 55379440c..091208349 100644 --- a/Command/NotifyChanges.hs +++ b/Command/NotifyChanges.hs @@ -20,9 +20,10 @@ import Control.Concurrent.Async import Control.Concurrent.STM cmd :: Command -cmd = noCommit $ command "notifychanges" paramNothing SectionPlumbing - "sends notification when git refs are changed" - (commandParser seek) +cmd = noCommit $ + command "notifychanges" SectionPlumbing + "sends notification when git refs are changed" + paramNothing (withParams seek) seek :: CmdParams -> CommandSeek seek = withNothing start diff --git a/Command/NumCopies.hs b/Command/NumCopies.hs index 33db1bbc9..1a3dd3dad 100644 --- a/Command/NumCopies.hs +++ b/Command/NumCopies.hs @@ -14,10 +14,11 @@ import Annex.NumCopies import Types.Messages cmd :: Command -cmd = command "numcopies" paramNumber seek - SectionSetup "configure desired number of copies" +cmd = command "numcopies" SectionSetup + "configure desired number of copies" + paramNumber (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 4f1729394..2d62b51f3 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -29,9 +29,10 @@ import qualified Git.LsFiles as Git import qualified Data.Set as S cmd :: Command -cmd = command "pre-commit" paramPaths SectionPlumbing +cmd = command "pre-commit" SectionPlumbing "run by git pre-commit hook" - (commandParser seek) + paramPaths + (withParams seek) seek :: CmdParams -> CommandSeek seek ps = lockPreCommitHook $ ifM isDirect diff --git a/Command/Proxy.hs b/Command/Proxy.hs index cfb1f8ba3..3c487b9b5 100644 --- a/Command/Proxy.hs +++ b/Command/Proxy.hs @@ -19,10 +19,11 @@ import qualified Git.Branch cmd :: Command cmd = notBareRepo $ - command "proxy" ("-- git command") seek - SectionPlumbing "safely bypass direct mode guard" + command "proxy" SectionPlumbing + "safely bypass direct mode guard" + ("-- git command") (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 2a2787898..597be57a5 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -19,11 +19,13 @@ import Utility.CopyFile import qualified Remote cmd :: Command -cmd = notDirect $ command "rekey" - (paramRepeating $ paramPair paramPath paramKey) - seek SectionPlumbing "change keys used for files" +cmd = notDirect $ + command "rekey" SectionPlumbing + "change keys used for files" + (paramRepeating $ paramPair paramPath paramKey) + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withPairs start start :: (FilePath, String) -> CommandStart diff --git a/Command/ReadPresentKey.hs b/Command/ReadPresentKey.hs index 6eab893cf..2b0b51fe3 100644 --- a/Command/ReadPresentKey.hs +++ b/Command/ReadPresentKey.hs @@ -13,10 +13,13 @@ import Logs.Location import Types.Key cmd :: Command -cmd = noCommit $ command "readpresentkey" (paramPair paramKey paramUUID) seek - SectionPlumbing "read records of where key is present" +cmd = noCommit $ + command "readpresentkey" SectionPlumbing + "read records of where key is present" + (paramPair paramKey paramUUID) + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index 574963494..a49efce2f 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -21,9 +21,9 @@ import qualified Types.Backend import qualified Backend cmd :: Command -cmd = noCommit $ command "recvkey" paramKey - SectionPlumbing "runs rsync in server mode to receive content" - (commandParser seek) +cmd = noCommit $ command "recvkey" SectionPlumbing + "runs rsync in server mode to receive content" + paramKey (withParams seek) seek :: CmdParams -> CommandSeek seek = withKeys start diff --git a/Command/RegisterUrl.hs b/Command/RegisterUrl.hs index bac5b7740..16489c094 100644 --- a/Command/RegisterUrl.hs +++ b/Command/RegisterUrl.hs @@ -17,10 +17,12 @@ import Command.FromKey (mkKey) cmd :: Command cmd = notDirect $ notBareRepo $ - command "registerurl" (paramPair paramKey paramUrl) seek + command "registerurl" SectionPlumbing "registers an url for a key" + (paramPair paramKey paramUrl) + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/Reinit.hs b/Command/Reinit.hs index 948ed3131..0d144e945 100644 --- a/Command/Reinit.hs +++ b/Command/Reinit.hs @@ -14,12 +14,14 @@ import Annex.UUID import Types.UUID import qualified Remote -cmd :: [Command] +cmd :: Command cmd = dontCheck repoExists $ - command "reinit" (paramUUID ++ "|" ++ paramDesc) seek - SectionUtility "initialize repository, reusing old UUID" + command "reinit" SectionUtility + "initialize repository, reusing old UUID" + (paramUUID ++ "|" ++ paramDesc) + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/Reinject.hs b/Command/Reinject.hs index 09511562f..76e1420ff 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -14,11 +14,12 @@ import Annex.Content import qualified Command.Fsck import qualified Backend -cmd :: [Command] -cmd = command "reinject" (paramPair "SRC" "DEST") seek - SectionUtility "sets content of annexed file" +cmd :: Command +cmd = command "reinject" SectionUtility + "sets content of annexed file" + (paramPair "SRC" "DEST") (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [FilePath] -> CommandStart diff --git a/Command/RemoteDaemon.hs b/Command/RemoteDaemon.hs index fdd938613..962189da1 100644 --- a/Command/RemoteDaemon.hs +++ b/Command/RemoteDaemon.hs @@ -12,10 +12,12 @@ import Command import RemoteDaemon.Core cmd :: Command -cmd = noCommit $ command "remotedaemon" paramNothing seek SectionPlumbing - "detects when remotes have changed, and fetches from them" +cmd = noCommit $ + command "remotedaemon" SectionPlumbing + "detects when remotes have changed, and fetches from them" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/Repair.hs b/Command/Repair.hs index 56d696960..f4c92b02f 100644 --- a/Command/Repair.hs +++ b/Command/Repair.hs @@ -18,9 +18,11 @@ import Annex.Version cmd :: Command cmd = noCommit $ dontCheck repoExists $ - command "repair" paramNothing seek SectionMaintenance "recover broken git repository" + command "repair" SectionMaintenance + "recover broken git repository" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/ResolveMerge.hs b/Command/ResolveMerge.hs index 0ecf180b8..148ce9e5c 100644 --- a/Command/ResolveMerge.hs +++ b/Command/ResolveMerge.hs @@ -15,10 +15,11 @@ import qualified Git.Branch import Annex.AutoMerge cmd :: Command -cmd = command "resolvemerge" paramNothing seek SectionPlumbing +cmd = command "resolvemerge" SectionPlumbing "resolve merge conflicts" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/RmUrl.hs b/Command/RmUrl.hs index 2f95ef993..d7e99587f 100644 --- a/Command/RmUrl.hs +++ b/Command/RmUrl.hs @@ -15,10 +15,12 @@ import qualified Remote cmd :: Command cmd = notBareRepo $ - command "rmurl" (paramPair paramFile paramUrl) seek - SectionCommon "record file is not available at url" + command "rmurl" SectionCommon + "record file is not available at url" + (paramPair paramFile paramUrl) + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withPairs start start :: (FilePath, String) -> CommandStart diff --git a/Command/Schedule.hs b/Command/Schedule.hs index 723ade65b..266208f9a 100644 --- a/Command/Schedule.hs +++ b/Command/Schedule.hs @@ -18,10 +18,11 @@ import Types.Messages import qualified Data.Set as S cmd :: Command -cmd = command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek - SectionSetup "get or set scheduled jobs" +cmd = command "schedule" SectionSetup "get or set scheduled jobs" + (paramPair paramRemote (paramOptional paramExpression)) + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs index 3ef2621e0..d9ee89394 100644 --- a/Command/Semitrust.hs +++ b/Command/Semitrust.hs @@ -12,8 +12,9 @@ import Types.TrustLevel import Command.Trust (trustCommand) cmd :: Command -cmd = command "semitrust" (paramRepeating paramRemote) seek - SectionSetup "return repository to default trust level" +cmd = command "semitrust" SectionSetup + "return repository to default trust level" + (paramRepeating paramRemote) (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = trustCommand "semitrust" SemiTrusted diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 78d1f9c1c..da7f99889 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -17,9 +17,10 @@ import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered cmd :: Command -cmd = noCommit $ command "sendkey" paramKey - SectionPlumbing "runs rsync in server mode to send content" - (commandParser seek) +cmd = noCommit $ + command "sendkey" SectionPlumbing + "runs rsync in server mode to send content" + paramKey (withParams seek) seek :: CmdParams -> CommandSeek seek = withKeys start diff --git a/Command/SetKey.hs b/Command/SetKey.hs index 4f7b5aaf5..d8216a0b4 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -14,10 +14,11 @@ import Annex.Content import Types.Key cmd :: Command -cmd = command "setkey" (paramPair paramKey paramPath) seek - SectionPlumbing "sets annexed content for a key" +cmd = command "setkey" SectionPlumbing "sets annexed content for a key" + (paramPair paramKey paramPath) + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/SetPresentKey.hs b/Command/SetPresentKey.hs index cc2ebc142..831a62883 100644 --- a/Command/SetPresentKey.hs +++ b/Command/SetPresentKey.hs @@ -14,10 +14,13 @@ import Logs.Presence.Pure import Types.Key cmd :: Command -cmd = noCommit $ command "setpresentkey" (paramPair paramKey (paramPair paramUUID "[1|0]")) seek - SectionPlumbing "change records of where key is present" +cmd = noCommit $ + command "setpresentkey" SectionPlumbing + "change records of where key is present" + (paramPair paramKey (paramPair paramUUID "[1|0]")) + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/Status.hs b/Command/Status.hs index 248a0b84b..c8aeaef0a 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -18,10 +18,11 @@ import qualified Git cmd :: Command cmd = notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $ - command "status" paramPaths seek SectionCommon + command "status" SectionCommon "show the working tree status" + paramPaths (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [FilePath] -> CommandStart diff --git a/Command/Sync.hs b/Command/Sync.hs index 95bd7c8d7..2f7c4af7f 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -53,8 +53,9 @@ import qualified Data.Map as M cmd :: Command cmd = withOptions syncOptions $ - command "sync" (paramRepeating paramRemote) - seek SectionCommon "synchronize local repository with remotes" + command "sync" SectionCommon + "synchronize local repository with remotes" + (paramRepeating paramRemote) (withParams seek) syncOptions :: [Option] syncOptions = @@ -69,7 +70,7 @@ contentOption = flagOption [] "content" "also transfer file contents" messageOption :: Option messageOption = fieldOption ['m'] "message" "MSG" "specify commit message" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek rs = do prepMerge diff --git a/Command/Test.hs b/Command/Test.hs index af02985af..6f9c23d2d 100644 --- a/Command/Test.hs +++ b/Command/Test.hs @@ -13,10 +13,11 @@ import Messages cmd :: Command cmd = noRepo startIO $ dontCheck repoExists $ - command "test" paramNothing seek SectionTesting + command "test" SectionTesting "run built-in test suite" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start {- We don't actually run the test suite here because of a dependency loop. diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index cbd2edaf1..250c6f41a 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -38,13 +38,14 @@ import qualified Data.Map as M cmd :: Command cmd = withOptions [sizeOption] $ - command "testremote" paramRemote seek SectionTesting - "test transfers to/from a remote" + command "testremote" SectionTesting + "test transfers to/from a remote" + paramRemote (withParams seek) sizeOption :: Option sizeOption = fieldOption [] "size" paramSize "base key size (default 1MiB)" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do basesz <- fromInteger . fromMaybe (1024 * 1024) <$> getOptionField sizeOption (pure . getsize) diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs index 44ffe59ad..d102be55e 100644 --- a/Command/TransferInfo.hs +++ b/Command/TransferInfo.hs @@ -16,9 +16,10 @@ import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered cmd :: Command -cmd = noCommit $ command "transferinfo" paramKey SectionPlumbing - "updates sender on number of bytes of content received" - (commandParser seek) +cmd = noCommit $ + command "transferinfo" SectionPlumbing + "updates sender on number of bytes of content received" + paramKey (withParams seek) seek :: CmdParams -> CommandSeek seek = withWords start diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 6da2e742b..de4568f3a 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -16,9 +16,10 @@ import qualified Remote import Types.Remote cmd :: Command -cmd = withOptions transferKeyOptions $ - noCommit $ command "transferkey" paramKey seek SectionPlumbing +cmd = withOptions transferKeyOptions $ noCommit $ + command "transferkey" SectionPlumbing "transfers a key from or to a remote" + paramKey (withParams seek) transferKeyOptions :: [Option] transferKeyOptions = fileOption : fromToOptions @@ -26,7 +27,7 @@ transferKeyOptions = fileOption : fromToOptions fileOption :: Option fileOption = fieldOption [] "file" paramFile "the associated file" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do to <- getOptionField toOption Remote.byNameWithUUID from <- getOptionField fromOption Remote.byNameWithUUID diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index a151754df..755a7ef3e 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -22,10 +22,10 @@ import Git.Types (RemoteName) data TransferRequest = TransferRequest Direction Remote Key AssociatedFile cmd :: Command -cmd = command "transferkeys" paramNothing seek - SectionPlumbing "transfers keys" +cmd = command "transferkeys" SectionPlumbing "transfers keys" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/Trust.hs b/Command/Trust.hs index 6f3382c30..33ecc2e64 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -17,13 +17,13 @@ import Logs.Group import qualified Data.Set as S cmd :: Command -cmd = command "trust" (paramRepeating paramRemote) seek - SectionSetup "trust a repository" +cmd = command "trust" SectionSetup "trust a repository" + (paramRepeating paramRemote) (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = trustCommand "trust" Trusted -trustCommand :: String -> TrustLevel -> CommandSeek +trustCommand :: String -> TrustLevel -> CmdParams -> CommandSeek trustCommand c level = withWords start where start ws = do diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 83e990921..ea814560f 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -24,9 +24,9 @@ import Command.PreCommit (lockPreCommitHook) cmd :: Command cmd = withOptions annexedMatchingOptions $ - command "unannex" paramPaths SectionUtility + command "unannex" SectionUtility "undo accidential add command" - (commandParser seek) + paramPaths (withParams seek) seek :: CmdParams -> CommandSeek seek = wrapUnannex . (withFilesInGit $ whenAnnexed start) diff --git a/Command/Undo.hs b/Command/Undo.hs index 4740aab48..c647dfba4 100644 --- a/Command/Undo.hs +++ b/Command/Undo.hs @@ -23,10 +23,11 @@ import qualified Command.Sync cmd :: Command cmd = notBareRepo $ - command "undo" paramPaths seek - SectionCommon "undo last change to a file or directory" + command "undo" SectionCommon + "undo last change to a file or directory" + paramPaths (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do -- Safety first; avoid any undo that would touch files that are not -- in the index. diff --git a/Command/Ungroup.hs b/Command/Ungroup.hs index b711a0132..cd2ebdf9b 100644 --- a/Command/Ungroup.hs +++ b/Command/Ungroup.hs @@ -16,10 +16,10 @@ import Types.Group import qualified Data.Set as S cmd :: Command -cmd = command "ungroup" (paramPair paramRemote paramDesc) seek - SectionSetup "remove a repository from a group" +cmd = command "ungroup" SectionSetup "remove a repository from a group" + (paramPair paramRemote paramDesc) (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 64c515464..c49cc4ba0 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -22,9 +22,10 @@ import System.IO.HVFS import System.IO.HVFS.Utils cmd :: Command -cmd = addCheck check $ command "uninit" paramPaths - SectionUtility "de-initialize git-annex and clean out repository" - (commandParser seek) +cmd = addCheck check $ + command "uninit" SectionUtility + "de-initialize git-annex and clean out repository" + paramPaths (withParams seek) check :: Annex () check = do diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 98117f5b5..36b0023d8 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -20,10 +20,10 @@ editcmd :: Command editcmd = mkcmd "edit" "same as unlock" mkcmd :: String -> String -> Command -mkcmd n = notDirect . withOptions annexedMatchingOptions - . command n paramPaths seek SectionCommon +mkcmd n d = notDirect $ withOptions annexedMatchingOptions $ + command n SectionCommon d paramPaths (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withFilesInGit $ whenAnnexed start {- The unlock subcommand replaces the symlink with a copy of the file's diff --git a/Command/Untrust.hs b/Command/Untrust.hs index 220faf85e..7f22a8086 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -12,8 +12,8 @@ import Types.TrustLevel import Command.Trust (trustCommand) cmd :: Command -cmd = command "untrust" (paramRepeating paramRemote) seek - SectionSetup "do not trust a repository" +cmd = command "untrust" SectionSetup "do not trust a repository" + (paramRepeating paramRemote) (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = trustCommand "untrust" UnTrusted diff --git a/Command/Unused.hs b/Command/Unused.hs index 1f84f012f..e6d5f7c71 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -36,9 +36,9 @@ import Annex.BloomFilter cmd :: Command cmd = withOptions [unusedFromOption, refSpecOption] $ - command "unused" paramNothing - SectionMaintenance "look for unused file content" - (commandParser seek) + command "unused" SectionMaintenance + "look for unused file content" + paramNothing (withParams seek) unusedFromOption :: Option unusedFromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content" @@ -268,7 +268,7 @@ data UnusedMaps = UnusedMaps , unusedTmpMap :: UnusedMap } -withUnusedMaps :: (UnusedMaps -> Int -> CommandStart) -> CommandSeek +withUnusedMaps :: (UnusedMaps -> Int -> CommandStart) -> CmdParams -> CommandSeek withUnusedMaps a params = do unused <- readUnusedMap "" unusedbad <- readUnusedMap "bad" diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index 0fa9022ff..c02a6709f 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -13,10 +13,10 @@ import Upgrade cmd :: Command cmd = dontCheck repoExists $ -- because an old version may not seem to exist - command "upgrade" paramNothing seek - SectionMaintenance "upgrade repository layout" + command "upgrade" SectionMaintenance "upgrade repository layout" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/VAdd.hs b/Command/VAdd.hs index 478eab098..ac70da264 100644 --- a/Command/VAdd.hs +++ b/Command/VAdd.hs @@ -13,10 +13,13 @@ import Annex.View import Command.View (checkoutViewBranch) cmd :: Command -cmd = notBareRepo $ notDirect $ command "vadd" (paramRepeating "FIELD=GLOB") - seek SectionMetaData "add subdirs to current view" +cmd = notBareRepo $ notDirect $ + command "vadd" SectionMetaData + "add subdirs to current view" + (paramRepeating "FIELD=GLOB") + (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/VCycle.hs b/Command/VCycle.hs index 31a5f80c2..a3c61d859 100644 --- a/Command/VCycle.hs +++ b/Command/VCycle.hs @@ -16,10 +16,11 @@ import Command.View (checkoutViewBranch) cmd :: Command cmd = notBareRepo $ notDirect $ - command "vcycle" paramNothing seek SectionMetaData - "switch view to next layout" + command "vcycle" SectionMetaData + "switch view to next layout" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start ::CommandStart diff --git a/Command/VFilter.hs b/Command/VFilter.hs index 78f2d9d5c..259d36068 100644 --- a/Command/VFilter.hs +++ b/Command/VFilter.hs @@ -14,9 +14,10 @@ import Command.View (paramView, checkoutViewBranch) cmd :: Command cmd = notBareRepo $ notDirect $ - command "vfilter" paramView seek SectionMetaData "filter current view" + command "vfilter" SectionMetaData "filter current view" + paramView (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/VPop.hs b/Command/VPop.hs index 0dadd52fb..ba6f4ee5c 100644 --- a/Command/VPop.hs +++ b/Command/VPop.hs @@ -18,10 +18,10 @@ import Command.View (checkoutViewBranch) cmd :: Command cmd = notBareRepo $ notDirect $ - command "vpop" paramNumber seek SectionMetaData - "switch back to previous view" + command "vpop" SectionMetaData "switch back to previous view" + paramNumber (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart diff --git a/Command/Version.hs b/Command/Version.hs index 3ceef3a60..70aea8f2c 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -20,12 +20,13 @@ import qualified Backend cmd :: Command cmd = withOptions [rawOption] $ noCommit $ noRepo startNoRepo $ dontCheck repoExists $ - command "version" paramNothing seek SectionQuery "show version info" + command "version" SectionQuery "show version info" + paramNothing (withParams seek) rawOption :: Option rawOption = flagOption [] "raw" "output only program version" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing $ ifM (getOptionFlag rawOption) (startRaw, start) startRaw :: CommandStart diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 9b8177e77..677ba5b13 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -30,10 +30,10 @@ import Types.ScheduledActivity import Remote cmd :: Command -cmd = command "vicfg" paramNothing seek - SectionSetup "edit git-annex's configuration" +cmd = command "vicfg" SectionSetup "edit git-annex's configuration" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/View.hs b/Command/View.hs index 584cf091f..b39aef7d9 100644 --- a/Command/View.hs +++ b/Command/View.hs @@ -19,16 +19,17 @@ import Logs.View cmd :: Command cmd = notBareRepo $ notDirect $ - command "view" paramView seek SectionMetaData "enter a view branch" + command "view" SectionMetaData "enter a view branch" + paramView (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart start [] = error "Specify metadata to include in view" -start params = do +start ps = do showStart "view" "" - view <- mkView params + view <- mkView ps go view =<< currentView where go view Nothing = next $ perform view @@ -45,11 +46,11 @@ paramView :: String paramView = paramRepeating "FIELD=VALUE" mkView :: [String] -> Annex View -mkView params = go =<< inRepo Git.Branch.current +mkView ps = go =<< inRepo Git.Branch.current where go Nothing = error "not on any branch!" go (Just b) = return $ fst $ refineView (View b []) $ - map parseViewParam $ reverse params + map parseViewParam $ reverse ps checkoutViewBranch :: View -> (View -> Annex Git.Branch) -> CommandCleanup checkoutViewBranch view mkbranch = do diff --git a/Command/Wanted.hs b/Command/Wanted.hs index 215595a52..649f19c2b 100644 --- a/Command/Wanted.hs +++ b/Command/Wanted.hs @@ -28,7 +28,7 @@ cmd' -> Annex (M.Map UUID PreferredContentExpression) -> (UUID -> PreferredContentExpression -> Annex ()) -> Command -cmd' name desc getter setter = command name pdesc seek SectionSetup desc +cmd' name desc getter setter = command name SectionSetup desc pdesc (withParams seek) where pdesc = paramPair paramRemote (paramOptional paramExpression) diff --git a/Command/Watch.hs b/Command/Watch.hs index 0782a4e6e..cc7356ddf 100644 --- a/Command/Watch.hs +++ b/Command/Watch.hs @@ -14,9 +14,11 @@ import Utility.HumanTime cmd :: Command cmd = notBareRepo $ withOptions [foregroundOption, stopOption] $ - command "watch" paramNothing seek SectionCommon "watch for changes and autocommit" + command "watch" SectionCommon + "watch for changes and autocommit" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do stopdaemon <- getOptionFlag stopOption foreground <- getOptionFlag foregroundOption diff --git a/Command/WebApp.hs b/Command/WebApp.hs index dab8e1e5b..2a639e489 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -40,13 +40,14 @@ import System.Environment (getArgs) cmd :: Command cmd = withOptions [listenOption] $ noCommit $ noRepo startNoRepo $ dontCheck repoExists $ notBareRepo $ - command "webapp" paramNothing seek SectionCommon "launch webapp" + command "webapp" SectionCommon "launch webapp" + paramNothing (withParams seek) listenOption :: Option listenOption = fieldOption [] "listen" paramAddress "accept connections to this address" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do listenhost <- getOptionField listenOption return withNothing (start listenhost) ps diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 54be0dd18..05bc70654 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -17,10 +17,11 @@ import Logs.Web cmd :: Command cmd = noCommit $ withOptions (jsonOption : annexedMatchingOptions ++ keyOptions) $ - command "whereis" paramPaths seek SectionQuery + command "whereis" SectionQuery "lists repositories that have file content" + paramPaths (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do m <- remoteMap id withKeyOptions False diff --git a/Command/XMPPGit.hs b/Command/XMPPGit.hs index 86cae9ab7..7d7d99476 100644 --- a/Command/XMPPGit.hs +++ b/Command/XMPPGit.hs @@ -13,10 +13,10 @@ import Assistant.XMPP.Git cmd :: Command cmd = noCommit $ noRepo startNoRepo $ dontCheck repoExists $ - command "xmppgit" paramNothing seek - SectionPlumbing "git to XMPP relay" + command "xmppgit" SectionPlumbing "git to XMPP relay" + paramNothing (withParams seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start start :: [String] -> CommandStart |