diff options
104 files changed, 435 insertions, 370 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index cd7a1a986..2b9418d83 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -1,6 +1,6 @@ {- git-annex command line parsing and dispatch - - - Copyright 2010-2012 Joey Hess <id@joeyh.name> + - Copyright 2010-2015 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -16,7 +16,7 @@ module CmdLine ( import qualified Control.Exception as E import qualified Data.Map as M import Control.Exception (throw) -import System.Console.GetOpt +import qualified Options.Applicative as O #ifndef mingw32_HOST_OS import System.Posix.Signals #endif @@ -35,6 +35,41 @@ import Types.Messages dispatch :: Bool -> CmdParams -> [Command] -> [Option] -> [(String, String)] -> String -> IO Git.Repo -> IO () dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do setupConsole + go =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo)) + where + go (Right g) = do + state <- Annex.new g + Annex.eval state $ do + checkEnvironment + when fuzzy $ + inRepo $ autocorrect . Just + forM_ fields $ uncurry Annex.setField + (cmd, seek) <- liftIO $ + O.handleParseResult (parseCmd (name:args) allcmds) + when (cmdnomessages cmd) $ + Annex.setOutput QuietOutput + -- TODO: propigate global options to annex state (how?) + whenM (annexDebug <$> Annex.getGitConfig) $ + liftIO enableDebugOutput + startup + performCommandAction cmd seek $ + shutdown $ cmdnocommit cmd + go (Left e) = do + when fuzzy $ + autocorrect =<< Git.Config.global + -- a <- O.handleParseResult (parseCmd (name:args) allcmds) + error "TODO" + + autocorrect = Git.AutoCorrect.prepare inputcmdname cmdname cmds + err msg = msg ++ "\n\n" ++ usage header allcmds + (fuzzy, cmds, inputcmdname, args) = findCmd fuzzyok allargs allcmds err + name + | fuzzy = case cmds of + [c] -> cmdname c + _ -> inputcmdname + | otherwise = inputcmdname + +#if 0 case getOptCmd args cmd commonoptions of Right (flags, params) -> go flags params =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo)) @@ -59,10 +94,19 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do when fuzzy $ autocorrect =<< Git.Config.global maybe (throw e) (\a -> a params) (cmdnorepo cmd) - err msg = msg ++ "\n\n" ++ usage header allcmds cmd = Prelude.head cmds - (fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err - autocorrect = Git.AutoCorrect.prepare name cmdname cmds +#endif + +{- Parses command line and selects a command to run and gets the + - seek action for the command. -} +parseCmd :: CmdParams -> [Command] -> O.ParserResult (Command, CommandSeek) +parseCmd allargs allcmds = O.execParserPure (O.prefs O.idm) pinfo allargs + where + pinfo = O.info (O.subparser $ mconcat $ map mkcommand allcmds) O.idm + mkcommand c = O.command (cmdname c) (O.info (mkparser c) O.idm) + mkparser c = (,) + <$> pure c + <*> cmdparser c {- Parses command line params far enough to find the Command to run, and - returns the remaining params. @@ -84,18 +128,6 @@ findCmd fuzzyok argv cmds err Nothing -> [] Just n -> Git.AutoCorrect.fuzzymatches n cmdname cmds -{- Parses command line options, and returns actions to run to configure flags - - and the remaining parameters for the command. -} -getOptCmd :: CmdParams -> Command -> [Option] -> Either String ([Annex ()], CmdParams) -getOptCmd argv cmd commonoptions = check $ - getOpt Permute (commonoptions ++ cmdoptions cmd) argv - where - check (flags, rest, []) = Right (flags, rest) - check (_, _, errs) = Left $ unlines - [ concat errs - , commandUsage cmd - ] - {- Actions to perform each time ran. -} startup :: Annex () startup = diff --git a/CmdLine/Action.hs b/CmdLine/Action.hs index 2838e4ff8..15064fe42 100644 --- a/CmdLine/Action.hs +++ b/CmdLine/Action.hs @@ -22,11 +22,11 @@ import Data.Either {- Runs a command, starting with the check stage, and then - the seek stage. Finishes by running the continutation, and - then showing a count of any failures. -} -performCommandAction :: Command -> CmdParams -> Annex () -> Annex () -performCommandAction Command { cmdseek = seek, cmdcheck = c, cmdname = name } params cont = do +performCommandAction :: Command -> CommandSeek -> Annex () -> Annex () +performCommandAction Command { cmdcheck = c, cmdname = name } seek cont = do mapM_ runCheck c Annex.changeState $ \s -> s { Annex.errcounter = 0 } - seek params + seek finishCommandActions cont showerrcount =<< Annex.getState Annex.errcounter diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index 354f451e7..5619129f5 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -16,6 +16,7 @@ import Utility.Env import Annex.Ssh import qualified Command.Add +{- import qualified Command.Unannex import qualified Command.Drop import qualified Command.Move @@ -116,15 +117,18 @@ import qualified Command.TestRemote #ifdef WITH_EKG import System.Remote.Monitoring #endif +-} cmds :: [Command] -cmds = concat +cmds = [ Command.Add.cmd +{- , Command.Get.cmd , Command.Drop.cmd , Command.Move.cmd , Command.Copy.cmd , Command.Unlock.cmd + , Command.Unlock.editcmd , Command.Lock.cmd , Command.Sync.cmd , Command.Mirror.cmd @@ -217,6 +221,7 @@ cmds = concat , Command.FuzzTest.cmd , Command.TestRemote.cmd #endif +-} ] header :: String diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs index adf6da04e..fca37790b 100644 --- a/CmdLine/GitAnnexShell.hs +++ b/CmdLine/GitAnnexShell.hs @@ -16,7 +16,6 @@ import qualified Git.Config import CmdLine import Command import Annex.UUID -import Annex (setField) import CmdLine.GitAnnexShell.Fields import Utility.UserInfo import Remote.GCrypt (getGCryptUUID) @@ -34,7 +33,7 @@ import qualified Command.NotifyChanges import qualified Command.GCryptSetup cmds_readonly :: [Command] -cmds_readonly = concat +cmds_readonly = [ gitAnnexShellCheck Command.ConfigList.cmd , gitAnnexShellCheck Command.InAnnex.cmd , gitAnnexShellCheck Command.SendKey.cmd @@ -43,7 +42,7 @@ cmds_readonly = concat ] cmds_notreadonly :: [Command] -cmds_notreadonly = concat +cmds_notreadonly = [ gitAnnexShellCheck Command.RecvKey.cmd , gitAnnexShellCheck Command.DropKey.cmd , gitAnnexShellCheck Command.Commit.cmd @@ -100,12 +99,10 @@ builtin cmd dir params = do checkNotReadOnly cmd checkDirectory $ Just dir let (params', fieldparams, opts) = partitionParams params - fields = filter checkField $ parseFields fieldparams - cmds' = map (newcmd $ unwords opts) cmds - dispatch False (cmd : params') cmds' options fields header mkrepo + rsyncopts = ("RsyncOptions", unwords opts) + fields = rsyncopts : filter checkField (parseFields fieldparams) + dispatch False (cmd : params') cmds options fields header mkrepo where - addrsyncopts opts seek k = setField "RsyncOptions" opts >> seek k - newcmd opts c = c { cmdseek = addrsyncopts opts (cmdseek c) } mkrepo = do r <- Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath Git.Config.read r @@ -200,8 +197,8 @@ checkEnv var = do {- Modifies a Command to check that it is run in either a git-annex - repository, or a repository with a gcrypt-id set. -} -gitAnnexShellCheck :: [Command] -> [Command] -gitAnnexShellCheck = map $ addCheck okforshell . dontCheck repoExists +gitAnnexShellCheck :: Command -> Command +gitAnnexShellCheck = addCheck okforshell . dontCheck repoExists where okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $ error "Not a git-annex or gcrypt repository." diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index 47e2c79bc..66f57e1b0 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -29,11 +29,11 @@ import Logs.Unused import Annex.CatFile import Annex.Content -withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek +withFilesInGit :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesInGit a params = seekActions $ prepFiltered a $ seekHelper LsFiles.inRepo params -withFilesInGitNonRecursive :: (FilePath -> CommandStart) -> CommandSeek +withFilesInGitNonRecursive :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesInGitNonRecursive a params = ifM (Annex.getState Annex.force) ( withFilesInGit a params , if null params @@ -54,7 +54,7 @@ withFilesInGitNonRecursive a params = ifM (Annex.getState Annex.force) _ -> needforce needforce = error "Not recursively setting metadata. Use --force to do that." -withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> CommandSeek +withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesNotInGit skipdotfiles a params | skipdotfiles = do {- dotfiles are not acted on unless explicitly listed -} @@ -73,7 +73,7 @@ withFilesNotInGit skipdotfiles a params go l = seekActions $ prepFiltered a $ return $ concat $ segmentPaths params l -withFilesInRefs :: (FilePath -> Key -> CommandStart) -> CommandSeek +withFilesInRefs :: (FilePath -> Key -> CommandStart) -> CmdParams -> CommandSeek withFilesInRefs a = mapM_ go where go r = do @@ -87,7 +87,7 @@ withFilesInRefs a = mapM_ go Just k -> whenM (matcher $ MatchingKey k) $ commandAction $ a f k -withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek +withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CmdParams -> CommandSeek withPathContents a params = do matcher <- Limit.getMatcher seekActions $ map a <$> (filterM (checkmatch matcher) =<< ps) @@ -103,27 +103,27 @@ withPathContents a params = do , matchFile = relf } -withWords :: ([String] -> CommandStart) -> CommandSeek +withWords :: ([String] -> CommandStart) -> CmdParams -> CommandSeek withWords a params = seekActions $ return [a params] -withStrings :: (String -> CommandStart) -> CommandSeek +withStrings :: (String -> CommandStart) -> CmdParams -> CommandSeek withStrings a params = seekActions $ return $ map a params -withPairs :: ((String, String) -> CommandStart) -> CommandSeek +withPairs :: ((String, String) -> CommandStart) -> CmdParams -> CommandSeek withPairs a params = seekActions $ return $ map a $ pairs [] params where pairs c [] = reverse c pairs c (x:y:xs) = pairs ((x,y):c) xs pairs _ _ = error "expected pairs" -withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek +withFilesToBeCommitted :: (String -> CommandStart) -> CmdParams -> CommandSeek withFilesToBeCommitted a params = seekActions $ prepFiltered a $ seekHelper LsFiles.stagedNotDeleted params -withFilesUnlocked :: (FilePath -> CommandStart) -> CommandSeek +withFilesUnlocked :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged -withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CommandSeek +withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged {- Unlocked files have changed type from a symlink to a regular file. @@ -131,7 +131,7 @@ withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged - Furthermore, unlocked files used to be a git-annex symlink, - not some other sort of symlink. -} -withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CommandSeek +withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesUnlocked' typechanged a params = seekActions $ prepFiltered a unlockedfiles where @@ -142,11 +142,11 @@ isUnlocked f = liftIO (notSymlink f) <&&> (isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f) {- Finds files that may be modified. -} -withFilesMaybeModified :: (FilePath -> CommandStart) -> CommandSeek +withFilesMaybeModified :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesMaybeModified a params = seekActions $ prepFiltered a $ seekHelper LsFiles.modified params -withKeys :: (Key -> CommandStart) -> CommandSeek +withKeys :: (Key -> CommandStart) -> CmdParams -> CommandSeek withKeys a params = seekActions $ return $ map (a . parse) params where parse p = fromMaybe (error "bad key") $ file2key p @@ -160,7 +160,7 @@ getOptionField option converter = converter <=< Annex.getField $ optionName opti getOptionFlag :: Option -> Annex Bool getOptionFlag option = Annex.getFlag (optionName option) -withNothing :: CommandStart -> CommandSeek +withNothing :: CommandStart -> CmdParams -> CommandSeek withNothing a [] = seekActions $ return [a] withNothing _ _ = error "This command takes no parameters." @@ -171,7 +171,7 @@ withNothing _ _ = error "This command takes no parameters." - - Otherwise falls back to a regular CommandSeek action on - whatever params were passed. -} -withKeyOptions :: Bool -> (Key -> CommandStart) -> CommandSeek -> CommandSeek +withKeyOptions :: Bool -> (Key -> CommandStart) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek withKeyOptions auto keyop = withKeyOptions' auto $ \getkeys -> do matcher <- Limit.getMatcher seekActions $ map (process matcher) <$> getkeys @@ -181,7 +181,7 @@ withKeyOptions auto keyop = withKeyOptions' auto $ \getkeys -> do , return Nothing ) -withKeyOptions' :: Bool -> (Annex [Key] -> Annex ()) -> CommandSeek -> CommandSeek +withKeyOptions' :: Bool -> (Annex [Key] -> Annex ()) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek withKeyOptions' auto keyop fallbackop params = do bare <- fromRepo Git.repoIsLocalBare allkeys <- Annex.getFlag "all" diff --git a/Command.hs b/Command.hs index 35034a494..6522924c3 100644 --- a/Command.hs +++ b/Command.hs @@ -7,6 +7,7 @@ module Command ( command, + commandParser, noRepo, noCommit, noMessages, @@ -32,10 +33,17 @@ import CmdLine.Action as ReExported import CmdLine.Option as ReExported import CmdLine.GitAnnex.Options as ReExported -{- Generates a normal command -} -command :: String -> String -> CommandSeek -> CommandSection -> String -> Command +import qualified Options.Applicative as O + +{- Generates a normal Command -} +command :: String -> String -> CommandSection -> String -> CommandParser -> Command command = Command [] Nothing commonChecks False False +{- Simple CommandParser generator, for when the CommandSeek wants all + - non-option parameters. -} +commandParser :: (CmdParams -> CommandSeek) -> CommandParser +commandParser mkseek = mkseek <$> O.many (O.argument O.str O.idm) + {- Indicates that a command doesn't need to commit any changes to - the git-annex branch. -} noCommit :: Command -> Command diff --git a/Command/Add.hs b/Command/Add.hs index 5f6f06cdb..689f2c6a5 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -34,9 +34,10 @@ import Utility.Tmp import Control.Exception (IOException) -cmd :: [Command] -cmd = [notBareRepo $ withOptions addOptions $ - command "add" paramPaths seek SectionCommon "add files to annex"] +cmd :: Command +cmd = notBareRepo $ withOptions addOptions $ + command "add" paramPaths SectionCommon "add files to annex" + (commandParser seek) addOptions :: [Option] addOptions = includeDotFilesOption : fileMatchingOptions @@ -47,7 +48,7 @@ includeDotFilesOption = flagOption [] "include-dotfiles" "don't skip dotfiles" {- Add acts on both files not checked into git yet, and unlocked files. - - In direct mode, it acts on any files that have changed. -} -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do matcher <- largeFilesMatcher let go a = flip a ps $ \file -> ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force) diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs index 4aab8d017..a0e9ccba6 100644 --- a/Command/AddUnused.hs +++ b/Command/AddUnused.hs @@ -14,9 +14,9 @@ import qualified Command.Add import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Types.Key -cmd :: [Command] -cmd = [notDirect $ command "addunused" (paramRepeating paramNumRange) - seek SectionMaintenance "add back unused files"] +cmd :: Command +cmd = notDirect $ command "addunused" (paramRepeating paramNumRange) + seek SectionMaintenance "add back unused files" seek :: CommandSeek seek = withUnusedMaps start diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index fda2a99e0..f009ff388 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -37,10 +37,10 @@ import Annex.Quvi import qualified Utility.Quvi as Quvi #endif -cmd :: [Command] -cmd = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption, rawOption] $ +cmd :: Command +cmd = notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption, rawOption] $ command "addurl" (paramRepeating paramUrl) seek - SectionCommon "add urls to annex"] + SectionCommon "add urls to annex" fileOption :: Option fileOption = fieldOption [] "file" paramFile "specify what file the url is added to" diff --git a/Command/Assistant.hs b/Command/Assistant.hs index 8a916aa55..d405bc8b3 100644 --- a/Command/Assistant.hs +++ b/Command/Assistant.hs @@ -19,10 +19,10 @@ import Assistant.Install import System.Environment -cmd :: [Command] -cmd = [noRepo checkNoRepoOpts $ dontCheck repoExists $ withOptions options $ +cmd :: Command +cmd = noRepo checkNoRepoOpts $ dontCheck repoExists $ withOptions options $ notBareRepo $ command "assistant" paramNothing seek SectionCommon - "automatically sync changes"] + "automatically sync changes" options :: [Option] options = diff --git a/Command/CheckPresentKey.hs b/Command/CheckPresentKey.hs index ad61ba3c0..e212a2da8 100644 --- a/Command/CheckPresentKey.hs +++ b/Command/CheckPresentKey.hs @@ -14,9 +14,9 @@ import qualified Remote import Annex import Types.Messages -cmd :: [Command] -cmd = [noCommit $ command "checkpresentkey" (paramPair paramKey paramRemote) seek - SectionPlumbing "check if key is present in remote"] +cmd :: Command +cmd = noCommit $ command "checkpresentkey" (paramPair paramKey paramRemote) seek + SectionPlumbing "check if key is present in remote" seek :: CommandSeek seek = withWords start diff --git a/Command/Commit.hs b/Command/Commit.hs index 73f9e2d5e..b94182a06 100644 --- a/Command/Commit.hs +++ b/Command/Commit.hs @@ -12,11 +12,12 @@ import Command import qualified Annex.Branch import qualified Git -cmd :: [Command] -cmd = [command "commit" paramNothing seek - SectionPlumbing "commits any staged changes to the git-annex branch"] +cmd :: Command +cmd = command "commit" paramNothing + SectionPlumbing "commits any staged changes to the git-annex branch" + (commandParser seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index 33b348b07..78c6d8d24 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -15,11 +15,12 @@ import qualified Annex.Branch import qualified Git.Config import Remote.GCrypt (coreGCryptId) -cmd :: [Command] -cmd = [noCommit $ command "configlist" paramNothing seek - SectionPlumbing "outputs relevant git configuration"] +cmd :: Command +cmd = noCommit $ command "configlist" paramNothing + SectionPlumbing "outputs relevant git configuration" + (commandParser seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/ContentLocation.hs b/Command/ContentLocation.hs index 10879f5b1..be781b5e2 100644 --- a/Command/ContentLocation.hs +++ b/Command/ContentLocation.hs @@ -12,10 +12,10 @@ import Command import CmdLine.Batch import Annex.Content -cmd :: [Command] -cmd = [withOptions [batchOption] $ noCommit $ noMessages $ +cmd :: Command +cmd = withOptions [batchOption] $ noCommit $ noMessages $ command "contentlocation" (paramRepeating paramKey) seek - SectionPlumbing "looks up content for a key"] + SectionPlumbing "looks up content for a key" seek :: CommandSeek seek = batchable withKeys start diff --git a/Command/Copy.hs b/Command/Copy.hs index 5cfdabb4e..ab4d8e25e 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -14,9 +14,9 @@ import qualified Remote 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 :: Command +cmd = withOptions copyOptions $ command "copy" paramPaths seek + SectionCommon "copy content of files to/from another repository" copyOptions :: [Option] copyOptions = Command.Move.moveOptions ++ [autoOption] diff --git a/Command/Dead.hs b/Command/Dead.hs index 7e62b6db0..75efd0dd5 100644 --- a/Command/Dead.hs +++ b/Command/Dead.hs @@ -16,10 +16,10 @@ import Command.Trust (trustCommand) import Logs.Location import Remote (keyLocations) -cmd :: [Command] -cmd = [withOptions [keyOption] $ +cmd :: Command +cmd = withOptions [keyOption] $ command "dead" (paramRepeating paramRemote) seek - SectionSetup "hide a lost repository or key"] + SectionSetup "hide a lost repository or key" seek :: CommandSeek seek ps = maybe (trustCommand "dead" DeadTrusted ps) (flip seekKey ps) diff --git a/Command/Describe.hs b/Command/Describe.hs index 56a73334d..6ff67f112 100644 --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -12,9 +12,9 @@ import Command import qualified Remote import Logs.UUID -cmd :: [Command] -cmd = [command "describe" (paramPair paramRemote paramDesc) seek - SectionSetup "change description of a repository"] +cmd :: Command +cmd = command "describe" (paramPair paramRemote paramDesc) seek + SectionSetup "change description of a repository" seek :: CommandSeek seek = withWords start diff --git a/Command/DiffDriver.hs b/Command/DiffDriver.hs index f6ef77ecd..c93bec525 100644 --- a/Command/DiffDriver.hs +++ b/Command/DiffDriver.hs @@ -13,10 +13,10 @@ import Annex.Content import Annex.Link import Git.Types -cmd :: [Command] -cmd = [dontCheck repoExists $ +cmd :: Command +cmd = dontCheck repoExists $ command "diffdriver" ("[-- cmd --]") seek - SectionPlumbing "external git diff driver shim"] + SectionPlumbing "external git diff driver shim" seek :: CommandSeek seek = withWords start diff --git a/Command/Direct.hs b/Command/Direct.hs index 1a6b2cb05..3eda794a0 100644 --- a/Command/Direct.hs +++ b/Command/Direct.hs @@ -15,10 +15,10 @@ import qualified Git.Branch import Config import Annex.Direct -cmd :: [Command] -cmd = [notBareRepo $ noDaemonRunning $ +cmd :: Command +cmd = notBareRepo $ noDaemonRunning $ command "direct" paramNothing seek - SectionSetup "switch repository to direct mode"] + SectionSetup "switch repository to direct mode" seek :: CommandSeek seek = withNothing start diff --git a/Command/Drop.hs b/Command/Drop.hs index 698dd7bad..496d5c55c 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -22,9 +22,9 @@ 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 :: Command +cmd = withOptions (dropOptions) $ command "drop" paramPaths seek + SectionCommon "indicate content of files not currently wanted" dropOptions :: [Option] dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption] ++ keyOptions diff --git a/Command/DropKey.hs b/Command/DropKey.hs index 890a79466..09366c262 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -13,11 +13,12 @@ import qualified Annex import Logs.Location import Annex.Content -cmd :: [Command] -cmd = [noCommit $ command "dropkey" (paramRepeating paramKey) seek - SectionPlumbing "drops annexed content for specified keys"] +cmd :: Command +cmd = noCommit $ command "dropkey" (paramRepeating paramKey) + SectionPlumbing "drops annexed content for specified keys" + (commandParser seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withKeys start start :: Key -> CommandStart diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index d441a4bd2..99e1e063d 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -16,10 +16,10 @@ import qualified Git import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Annex.NumCopies -cmd :: [Command] -cmd = [withOptions [Command.Drop.dropFromOption] $ +cmd :: Command +cmd = withOptions [Command.Drop.dropFromOption] $ command "dropunused" (paramRepeating paramNumRange) - seek SectionMaintenance "drop unused file content"] + seek SectionMaintenance "drop unused file content" seek :: CommandSeek seek ps = do diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs index db3ec2b37..ccf6d9aab 100644 --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -15,10 +15,10 @@ import qualified Command.InitRemote as InitRemote import qualified Data.Map as M -cmd :: [Command] -cmd = [command "enableremote" +cmd :: Command +cmd = command "enableremote" (paramPair paramName $ paramOptional $ paramRepeating paramKeyValue) - seek SectionSetup "enables use of an existing special remote"] + seek SectionSetup "enables use of an existing special remote" seek :: CommandSeek seek = withWords start diff --git a/Command/ExamineKey.hs b/Command/ExamineKey.hs index 05db9817a..5ece3a99a 100644 --- a/Command/ExamineKey.hs +++ b/Command/ExamineKey.hs @@ -14,10 +14,10 @@ import qualified Utility.Format import Command.Find (formatOption, getFormat, showFormatted, keyVars) import Types.Key -cmd :: [Command] -cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $ +cmd :: Command +cmd = noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $ command "examinekey" (paramRepeating paramKey) seek - SectionPlumbing "prints information from a key"] + SectionPlumbing "prints information from a key" seek :: CommandSeek seek ps = do diff --git a/Command/Expire.hs b/Command/Expire.hs index f4d1a06e3..44bdd113f 100644 --- a/Command/Expire.hs +++ b/Command/Expire.hs @@ -20,9 +20,9 @@ import Utility.HumanTime 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 :: Command +cmd = withOptions [activityOption, noActOption] $ command "expire" paramExpire seek + SectionMaintenance "expire inactive repositories" paramExpire :: String paramExpire = (paramRepeating $ paramOptional paramRemote ++ ":" ++ paramTime) diff --git a/Command/Find.hs b/Command/Find.hs index 236824643..d0bb165c3 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -19,9 +19,9 @@ import qualified Utility.Format import Utility.DataUnits import Types.Key -cmd :: [Command] -cmd = [withOptions annexedMatchingOptions $ mkCommand $ - command "find" paramPaths seek SectionQuery "lists available files"] +cmd :: Command +cmd = withOptions annexedMatchingOptions $ mkCommand $ + command "find" paramPaths seek SectionQuery "lists available files" mkCommand :: Command -> Command mkCommand = noCommit . noMessages . withOptions [formatOption, print0Option, jsonOption] diff --git a/Command/FindRef.hs b/Command/FindRef.hs index e7f7eae6d..3f09cd6b3 100644 --- a/Command/FindRef.hs +++ b/Command/FindRef.hs @@ -10,10 +10,10 @@ module Command.FindRef where import Command import qualified Command.Find as Find -cmd :: [Command] -cmd = [withOptions nonWorkTreeMatchingOptions $ Find.mkCommand $ +cmd :: Command +cmd = withOptions nonWorkTreeMatchingOptions $ Find.mkCommand $ command "findref" paramRef seek SectionPlumbing - "lists files in a git ref"] + "lists files in a git ref" seek :: CommandSeek seek refs = do diff --git a/Command/Fix.hs b/Command/Fix.hs index c4e5e52ee..6a27878e3 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -18,12 +18,13 @@ import Utility.Touch #endif #endif -cmd :: [Command] -cmd = [notDirect $ noCommit $ withOptions annexedMatchingOptions $ - command "fix" paramPaths seek - SectionMaintenance "fix up symlinks to point to annexed content"] +cmd :: Command +cmd = notDirect $ noCommit $ withOptions annexedMatchingOptions $ + command "fix" paramPaths + SectionMaintenance "fix up symlinks to point to annexed content" + (commandParser seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withFilesInGit $ whenAnnexed start {- Fixes the symlink to an annexed file. -} diff --git a/Command/Forget.hs b/Command/Forget.hs index 94a1fb421..370dc8b1e 100644 --- a/Command/Forget.hs +++ b/Command/Forget.hs @@ -15,9 +15,9 @@ import qualified Annex import Data.Time.Clock.POSIX -cmd :: [Command] -cmd = [withOptions forgetOptions $ command "forget" paramNothing seek - SectionMaintenance "prune git-annex branch history"] +cmd :: Command +cmd = withOptions forgetOptions $ command "forget" paramNothing seek + SectionMaintenance "prune git-annex branch history" forgetOptions :: [Option] forgetOptions = [dropDeadOption] diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 51389b770..78ebb6268 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -19,10 +19,10 @@ import qualified Backend.URL import Network.URI -cmd :: [Command] -cmd = [notDirect $ notBareRepo $ +cmd :: Command +cmd = notDirect $ notBareRepo $ command "fromkey" (paramPair paramKey paramPath) seek - SectionPlumbing "adds a file using a specific key"] + SectionPlumbing "adds a file using a specific key" seek :: CommandSeek seek ps = do diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 8988100b8..177db6498 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -40,9 +40,9 @@ import qualified Database.Fsck as FsckDb import Data.Time.Clock.POSIX import System.Posix.Types (EpochTime) -cmd :: [Command] -cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek - SectionMaintenance "check for problems"] +cmd :: Command +cmd = withOptions fsckOptions $ command "fsck" paramPaths seek + SectionMaintenance "check for problems" fsckFromOption :: Option fsckFromOption = fieldOption ['f'] "from" paramRemote "check remote" diff --git a/Command/FuzzTest.hs b/Command/FuzzTest.hs index d6c9e1ac1..bc8cc1161 100644 --- a/Command/FuzzTest.hs +++ b/Command/FuzzTest.hs @@ -20,9 +20,9 @@ import System.Random (getStdRandom, random, randomR) import Test.QuickCheck import Control.Concurrent -cmd :: [Command] -cmd = [ notBareRepo $ command "fuzztest" paramNothing seek SectionTesting - "generates fuzz test files"] +cmd :: Command +cmd = notBareRepo $ command "fuzztest" paramNothing seek SectionTesting + "generates fuzz test files" seek :: CommandSeek seek = withNothing start diff --git a/Command/GCryptSetup.hs b/Command/GCryptSetup.hs index 7a7f8ae50..e267aaf67 100644 --- a/Command/GCryptSetup.hs +++ b/Command/GCryptSetup.hs @@ -13,12 +13,13 @@ import Annex.UUID import qualified Remote.GCrypt import qualified Git -cmd :: [Command] -cmd = [dontCheck repoExists $ noCommit $ - command "gcryptsetup" paramValue seek - SectionPlumbing "sets up gcrypt repository"] +cmd :: Command +cmd = dontCheck repoExists $ noCommit $ + command "gcryptsetup" paramValue + SectionPlumbing "sets up gcrypt repository" + (commandParser seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withStrings start start :: String -> CommandStart diff --git a/Command/Get.hs b/Command/Get.hs index d39b3890f..f54e88b7a 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -16,9 +16,9 @@ import Annex.NumCopies import Annex.Wanted import qualified Command.Move -cmd :: [Command] -cmd = [withOptions getOptions $ command "get" paramPaths seek - SectionCommon "make content of annexed files available"] +cmd :: Command +cmd = withOptions getOptions $ command "get" paramPaths seek + SectionCommon "make content of annexed files available" getOptions :: [Option] getOptions = fromOption : autoOption : jobsOption : annexedMatchingOptions diff --git a/Command/Group.hs b/Command/Group.hs index 820f6ab17..839d21a4c 100644 --- a/Command/Group.hs +++ b/Command/Group.hs @@ -15,9 +15,9 @@ 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 +cmd = command "group" (paramPair paramRemote paramDesc) seek + SectionSetup "add a repository to a group" seek :: CommandSeek seek = withWords start diff --git a/Command/GroupWanted.hs b/Command/GroupWanted.hs index 5cdf785d7..f58544f6f 100644 --- a/Command/GroupWanted.hs +++ b/Command/GroupWanted.hs @@ -12,9 +12,9 @@ import Command 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 +cmd = command "groupwanted" (paramPair paramGroup (paramOptional paramExpression)) seek + SectionSetup "get or set groupwanted expression" seek :: CommandSeek seek = withWords start diff --git a/Command/Help.hs b/Command/Help.hs index 2af39ac9a..073ab2b36 100644 --- a/Command/Help.hs +++ b/Command/Help.hs @@ -21,9 +21,9 @@ import qualified Command.Fsck import System.Console.GetOpt -cmd :: [Command] -cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ - command "help" (paramOptional "COMMAND") seek SectionCommon "display help"] +cmd :: Command +cmd = noCommit $ noRepo startNoRepo $ dontCheck repoExists $ + command "help" (paramOptional "COMMAND") seek SectionCommon "display help" seek :: CommandSeek seek = withWords start diff --git a/Command/Import.hs b/Command/Import.hs index acf3bc01f..6bc330fca 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -22,9 +22,9 @@ import Annex.NumCopies 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 :: Command +cmd = withOptions opts $ notBareRepo $ command "import" paramPaths seek + SectionCommon "move and add files from outside git working copy" opts :: [Option] opts = duplicateModeOptions ++ fileMatchingOptions diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 4bc3f52f4..4be84375c 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -43,10 +43,10 @@ import Types.MetaData import Logs.MetaData import Annex.MetaData -cmd :: [Command] -cmd = [notBareRepo $ withOptions [templateOption, relaxedOption, rawOption] $ +cmd :: Command +cmd = notBareRepo $ withOptions [templateOption, relaxedOption, rawOption] $ command "importfeed" (paramRepeating paramUrl) seek - SectionCommon "import files from podcast feeds"] + SectionCommon "import files from podcast feeds" templateOption :: Option templateOption = fieldOption [] "template" paramFormat "template for filenames" diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs index 8e792c4bb..29d0750a5 100644 --- a/Command/InAnnex.hs +++ b/Command/InAnnex.hs @@ -11,11 +11,12 @@ import Common.Annex import Command import Annex.Content -cmd :: [Command] -cmd = [noCommit $ command "inannex" (paramRepeating paramKey) seek - SectionPlumbing "checks if keys are present in the annex"] +cmd :: Command +cmd = noCommit $ command "inannex" (paramRepeating paramKey) + SectionPlumbing "checks if keys are present in the annex" + (commandParser seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withKeys start start :: Key -> CommandStart diff --git a/Command/Indirect.hs b/Command/Indirect.hs index 1d703d2f3..3e10988ed 100644 --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -22,10 +22,10 @@ import Annex.CatFile import Annex.Init import qualified Command.Add -cmd :: [Command] -cmd = [notBareRepo $ noDaemonRunning $ +cmd :: Command +cmd = notBareRepo $ noDaemonRunning $ command "indirect" paramNothing seek - SectionSetup "switch repository to indirect mode"] + SectionSetup "switch repository to indirect mode" seek :: CommandSeek seek = withNothing start diff --git a/Command/Info.hs b/Command/Info.hs index e6e0194ce..802aabb56 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -78,10 +78,10 @@ emptyStatInfo = StatInfo Nothing Nothing M.empty Nothing -- a state monad for running Stats in type StatState = StateT StatInfo Annex -cmd :: [Command] -cmd = [noCommit $ dontCheck repoExists $ withOptions (jsonOption : bytesOption : annexedMatchingOptions) $ +cmd :: Command +cmd = noCommit $ dontCheck repoExists $ withOptions (jsonOption : bytesOption : annexedMatchingOptions) $ command "info" (paramOptional $ paramRepeating paramItem) seek SectionQuery - "shows information about the specified item or the repository as a whole"] + "shows information about the specified item or the repository as a whole" seek :: CommandSeek seek = withWords start diff --git a/Command/Init.hs b/Command/Init.hs index 23203b035..45ecb92f8 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -11,9 +11,9 @@ import Common.Annex import Command import Annex.Init -cmd :: [Command] -cmd = [dontCheck repoExists $ - command "init" paramDesc seek SectionSetup "initialize git-annex"] +cmd :: Command +cmd = dontCheck repoExists $ + command "init" paramDesc seek SectionSetup "initialize git-annex" seek :: CommandSeek seek = withWords start diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 7831fe22a..4bf5f5312 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -19,10 +19,10 @@ import Logs.Trust import Data.Ord -cmd :: [Command] -cmd = [command "initremote" +cmd :: Command +cmd = command "initremote" (paramPair paramName $ paramOptional $ paramRepeating paramKeyValue) - seek SectionSetup "creates a special (non-git) remote"] + seek SectionSetup "creates a special (non-git) remote" seek :: CommandSeek seek = withWords start diff --git a/Command/List.hs b/Command/List.hs index b9b3a376c..ba27da702 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -23,10 +23,10 @@ import Annex.UUID import qualified Annex import Git.Types (RemoteName) -cmd :: [Command] -cmd = [noCommit $ withOptions (allrepos : annexedMatchingOptions) $ +cmd :: Command +cmd = noCommit $ withOptions (allrepos : annexedMatchingOptions) $ command "list" paramPaths seek - SectionQuery "show which remotes contain files"] + SectionQuery "show which remotes contain files" allrepos :: Option allrepos = flagOption [] "allrepos" "show all repositories, not only remotes" diff --git a/Command/Lock.hs b/Command/Lock.hs index 720169506..2d796ad4f 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -12,10 +12,10 @@ import Command import qualified Annex.Queue import qualified Annex -cmd :: [Command] -cmd = [notDirect $ withOptions annexedMatchingOptions $ +cmd :: Command +cmd = notDirect $ withOptions annexedMatchingOptions $ command "lock" paramPaths seek SectionCommon - "undo unlock command"] + "undo unlock command" seek :: CommandSeek seek ps = do diff --git a/Command/Log.hs b/Command/Log.hs index 495c43c5a..3d618360d 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -38,9 +38,9 @@ data RefChange = RefChange type Outputter = Bool -> POSIXTime -> [UUID] -> Annex () -cmd :: [Command] -cmd = [withOptions options $ - command "log" paramPaths seek SectionQuery "shows location log"] +cmd :: Command +cmd = withOptions options $ + command "log" paramPaths seek SectionQuery "shows location log" options :: [Option] options = passthruOptions ++ [gourceOption] ++ annexedMatchingOptions diff --git a/Command/LookupKey.hs b/Command/LookupKey.hs index 6e7f07049..9b7dd3a9b 100644 --- a/Command/LookupKey.hs +++ b/Command/LookupKey.hs @@ -13,10 +13,10 @@ import CmdLine.Batch import Annex.CatFile import Types.Key -cmd :: [Command] -cmd = [withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $ +cmd :: Command +cmd = withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $ command "lookupkey" (paramRepeating paramFile) seek - SectionPlumbing "looks up key used for file"] + SectionPlumbing "looks up key used for file" seek :: CommandSeek seek = batchable withStrings start diff --git a/Command/Map.hs b/Command/Map.hs index 75af591d5..4328139f1 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -25,10 +25,10 @@ import qualified Utility.Dot as Dot -- a link from the first repository to the second (its remote) data Link = Link Git.Repo Git.Repo -cmd :: [Command] -cmd = [dontCheck repoExists $ +cmd :: Command +cmd = dontCheck repoExists $ command "map" paramNothing seek SectionQuery - "generate map of repositories"] + "generate map of repositories" seek :: CommandSeek seek = withNothing start diff --git a/Command/Merge.hs b/Command/Merge.hs index 28e3bbb4d..b451db2af 100644 --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -13,9 +13,9 @@ import qualified Annex.Branch import qualified Git.Branch import Command.Sync (prepMerge, mergeLocal) -cmd :: [Command] -cmd = [command "merge" paramNothing seek SectionMaintenance - "automatically merge changes from remotes"] +cmd :: Command +cmd = command "merge" paramNothing seek SectionMaintenance + "automatically merge changes from remotes" seek :: CommandSeek seek ps = do diff --git a/Command/MetaData.hs b/Command/MetaData.hs index 10093ab08..d6adb0ad4 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -16,10 +16,10 @@ import Logs.MetaData import qualified Data.Set as S import Data.Time.Clock.POSIX -cmd :: [Command] -cmd = [withOptions metaDataOptions $ +cmd :: Command +cmd = withOptions metaDataOptions $ command "metadata" paramPaths seek - SectionMetaData "sets or gets metadata of a file"] + SectionMetaData "sets or gets metadata of a file" metaDataOptions :: [Option] metaDataOptions = diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 6ffe354d5..d406dbea4 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -18,10 +18,10 @@ import qualified Command.ReKey import qualified Command.Fsck import qualified Annex -cmd :: [Command] -cmd = [notDirect $ withOptions annexedMatchingOptions $ +cmd :: Command +cmd = notDirect $ withOptions annexedMatchingOptions $ command "migrate" paramPaths seek - SectionUtility "switch data to different backend"] + SectionUtility "switch data to different backend" seek :: CommandSeek seek = withFilesInGit $ whenAnnexed start diff --git a/Command/Mirror.hs b/Command/Mirror.hs index 535dc64b6..8ae57da2f 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -16,9 +16,9 @@ import qualified Remote 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 :: Command +cmd = withOptions mirrorOptions $ command "mirror" paramPaths seek + SectionCommon "mirror content of files to/from another repository" mirrorOptions :: [Option] mirrorOptions = fromToOptions ++ [jobsOption] ++ annexedMatchingOptions ++ keyOptions diff --git a/Command/Move.hs b/Command/Move.hs index 6867052de..739be4417 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -17,9 +17,9 @@ import Annex.UUID 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 :: Command +cmd = withOptions moveOptions $ command "move" paramPaths seek + SectionCommon "move content of files to/from another repository" moveOptions :: [Option] moveOptions = fromToOptions ++ [jobsOption] ++ keyOptions ++ annexedMatchingOptions diff --git a/Command/NotifyChanges.hs b/Command/NotifyChanges.hs index 7ec6072dd..55379440c 100644 --- a/Command/NotifyChanges.hs +++ b/Command/NotifyChanges.hs @@ -19,11 +19,12 @@ import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM -cmd :: [Command] -cmd = [noCommit $ command "notifychanges" paramNothing seek SectionPlumbing - "sends notification when git refs are changed"] +cmd :: Command +cmd = noCommit $ command "notifychanges" paramNothing SectionPlumbing + "sends notification when git refs are changed" + (commandParser seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start start :: CommandStart diff --git a/Command/NumCopies.hs b/Command/NumCopies.hs index 1e710f561..33db1bbc9 100644 --- a/Command/NumCopies.hs +++ b/Command/NumCopies.hs @@ -13,9 +13,9 @@ import Command import Annex.NumCopies import Types.Messages -cmd :: [Command] -cmd = [command "numcopies" paramNumber seek - SectionSetup "configure desired number of copies"] +cmd :: Command +cmd = command "numcopies" paramNumber seek + SectionSetup "configure desired number of copies" seek :: CommandSeek seek = withWords start diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index f4dcff269..4f1729394 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -28,11 +28,12 @@ import qualified Git.LsFiles as Git import qualified Data.Set as S -cmd :: [Command] -cmd = [command "pre-commit" paramPaths seek SectionPlumbing - "run by git pre-commit hook"] +cmd :: Command +cmd = command "pre-commit" paramPaths SectionPlumbing + "run by git pre-commit hook" + (commandParser seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = lockPreCommitHook $ ifM isDirect ( do -- update direct mode mappings for committed files diff --git a/Command/Proxy.hs b/Command/Proxy.hs index 8c11bf770..cfb1f8ba3 100644 --- a/Command/Proxy.hs +++ b/Command/Proxy.hs @@ -17,10 +17,10 @@ import qualified Git.Sha import qualified Git.Ref import qualified Git.Branch -cmd :: [Command] -cmd = [notBareRepo $ +cmd :: Command +cmd = notBareRepo $ command "proxy" ("-- git command") seek - SectionPlumbing "safely bypass direct mode guard"] + SectionPlumbing "safely bypass direct mode guard" seek :: CommandSeek seek = withWords start diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 980b27f5a..319f3eda8 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -18,10 +18,10 @@ import Logs.Location import Utility.CopyFile import qualified Remote -cmd :: [Command] -cmd = [notDirect $ command "rekey" +cmd :: Command +cmd = notDirect $ command "rekey" (paramOptional $ paramRepeating $ paramPair paramPath paramKey) - seek SectionPlumbing "change keys used for files"] + seek SectionPlumbing "change keys used for files" seek :: CommandSeek seek = withPairs start diff --git a/Command/ReadPresentKey.hs b/Command/ReadPresentKey.hs index 8125ddf7e..6eab893cf 100644 --- a/Command/ReadPresentKey.hs +++ b/Command/ReadPresentKey.hs @@ -12,9 +12,9 @@ import Command 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 :: Command +cmd = noCommit $ command "readpresentkey" (paramPair paramKey paramUUID) seek + SectionPlumbing "read records of where key is present" seek :: CommandSeek seek = withWords start diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index 8572596d2..574963494 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -20,11 +20,12 @@ import qualified Types.Key import qualified Types.Backend import qualified Backend -cmd :: [Command] -cmd = [noCommit $ command "recvkey" paramKey seek - SectionPlumbing "runs rsync in server mode to receive content"] +cmd :: Command +cmd = noCommit $ command "recvkey" paramKey + SectionPlumbing "runs rsync in server mode to receive content" + (commandParser seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withKeys start start :: Key -> CommandStart diff --git a/Command/RegisterUrl.hs b/Command/RegisterUrl.hs index 4282db58a..bac5b7740 100644 --- a/Command/RegisterUrl.hs +++ b/Command/RegisterUrl.hs @@ -15,10 +15,10 @@ import Logs.Web import Annex.UUID import Command.FromKey (mkKey) -cmd :: [Command] -cmd = [notDirect $ notBareRepo $ +cmd :: Command +cmd = notDirect $ notBareRepo $ command "registerurl" (paramPair paramKey paramUrl) seek - SectionPlumbing "registers an url for a key"] + SectionPlumbing "registers an url for a key" seek :: CommandSeek seek = withWords start diff --git a/Command/Reinit.hs b/Command/Reinit.hs index f201c66bb..948ed3131 100644 --- a/Command/Reinit.hs +++ b/Command/Reinit.hs @@ -15,8 +15,9 @@ import Types.UUID import qualified Remote cmd :: [Command] -cmd = [dontCheck repoExists $ - command "reinit" (paramUUID ++ "|" ++ paramDesc) seek SectionUtility "initialize repository, reusing old UUID"] +cmd = dontCheck repoExists $ + command "reinit" (paramUUID ++ "|" ++ paramDesc) seek + SectionUtility "initialize repository, reusing old UUID" seek :: CommandSeek seek = withWords start diff --git a/Command/Reinject.hs b/Command/Reinject.hs index de7f6eb3d..09511562f 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -15,8 +15,8 @@ import qualified Command.Fsck import qualified Backend cmd :: [Command] -cmd = [command "reinject" (paramPair "SRC" "DEST") seek - SectionUtility "sets content of annexed file"] +cmd = command "reinject" (paramPair "SRC" "DEST") seek + SectionUtility "sets content of annexed file" seek :: CommandSeek seek = withWords start diff --git a/Command/RemoteDaemon.hs b/Command/RemoteDaemon.hs index 2e3d62555..fdd938613 100644 --- a/Command/RemoteDaemon.hs +++ b/Command/RemoteDaemon.hs @@ -11,9 +11,9 @@ import Common.Annex import Command import RemoteDaemon.Core -cmd :: [Command] -cmd = [noCommit $ command "remotedaemon" paramNothing seek SectionPlumbing - "detects when remotes have changed, and fetches from them"] +cmd :: Command +cmd = noCommit $ command "remotedaemon" paramNothing seek SectionPlumbing + "detects when remotes have changed, and fetches from them" seek :: CommandSeek seek = withNothing start diff --git a/Command/Repair.hs b/Command/Repair.hs index d41a074c0..56d696960 100644 --- a/Command/Repair.hs +++ b/Command/Repair.hs @@ -16,9 +16,9 @@ import qualified Git.Ref import Git.Types import Annex.Version -cmd :: [Command] -cmd = [noCommit $ dontCheck repoExists $ - command "repair" paramNothing seek SectionMaintenance "recover broken git repository"] +cmd :: Command +cmd = noCommit $ dontCheck repoExists $ + command "repair" paramNothing seek SectionMaintenance "recover broken git repository" seek :: CommandSeek seek = withNothing start diff --git a/Command/Required.hs b/Command/Required.hs index 3d9c59279..3cc053b55 100644 --- a/Command/Required.hs +++ b/Command/Required.hs @@ -11,7 +11,7 @@ import Command import Logs.PreferredContent import qualified Command.Wanted -cmd :: [Command] +cmd :: Command cmd = Command.Wanted.cmd' "required" "get or set required content expression" requiredContentMapRaw requiredContentSet diff --git a/Command/ResolveMerge.hs b/Command/ResolveMerge.hs index ce199e504..0ecf180b8 100644 --- a/Command/ResolveMerge.hs +++ b/Command/ResolveMerge.hs @@ -14,9 +14,9 @@ import Git.Sha import qualified Git.Branch import Annex.AutoMerge -cmd :: [Command] -cmd = [command "resolvemerge" paramNothing seek SectionPlumbing - "resolve merge conflicts"] +cmd :: Command +cmd = command "resolvemerge" paramNothing seek SectionPlumbing + "resolve merge conflicts" seek :: CommandSeek seek = withNothing start diff --git a/Command/RmUrl.hs b/Command/RmUrl.hs index 5287718c5..2f95ef993 100644 --- a/Command/RmUrl.hs +++ b/Command/RmUrl.hs @@ -13,10 +13,10 @@ import Logs.Web import Annex.UUID import qualified Remote -cmd :: [Command] -cmd = [notBareRepo $ +cmd :: Command +cmd = notBareRepo $ command "rmurl" (paramPair paramFile paramUrl) seek - SectionCommon "record file is not available at url"] + SectionCommon "record file is not available at url" seek :: CommandSeek seek = withPairs start diff --git a/Command/Schedule.hs b/Command/Schedule.hs index 91ef2c138..723ade65b 100644 --- a/Command/Schedule.hs +++ b/Command/Schedule.hs @@ -17,9 +17,9 @@ 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 +cmd = command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek + SectionSetup "get or set scheduled jobs" seek :: CommandSeek seek = withWords start diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs index 49004d7f9..3ef2621e0 100644 --- a/Command/Semitrust.hs +++ b/Command/Semitrust.hs @@ -11,9 +11,9 @@ import Command import Types.TrustLevel import Command.Trust (trustCommand) -cmd :: [Command] -cmd = [command "semitrust" (paramRepeating paramRemote) seek - SectionSetup "return repository to default trust level"] +cmd :: Command +cmd = command "semitrust" (paramRepeating paramRemote) seek + SectionSetup "return repository to default trust level" seek :: CommandSeek seek = trustCommand "semitrust" SemiTrusted diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 011785582..78d1f9c1c 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -16,11 +16,12 @@ import Annex.Transfer import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered -cmd :: [Command] -cmd = [noCommit $ command "sendkey" paramKey seek - SectionPlumbing "runs rsync in server mode to send content"] +cmd :: Command +cmd = noCommit $ command "sendkey" paramKey + SectionPlumbing "runs rsync in server mode to send content" + (commandParser seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withKeys start start :: Key -> CommandStart diff --git a/Command/SetKey.hs b/Command/SetKey.hs index d5762dd8c..4f7b5aaf5 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -13,9 +13,9 @@ import Logs.Location import Annex.Content import Types.Key -cmd :: [Command] -cmd = [command "setkey" (paramPair paramKey paramPath) seek - SectionPlumbing "sets annexed content for a key"] +cmd :: Command +cmd = command "setkey" (paramPair paramKey paramPath) seek + SectionPlumbing "sets annexed content for a key" seek :: CommandSeek seek = withWords start diff --git a/Command/SetPresentKey.hs b/Command/SetPresentKey.hs index 1c41dc2ae..cc2ebc142 100644 --- a/Command/SetPresentKey.hs +++ b/Command/SetPresentKey.hs @@ -13,9 +13,9 @@ import Logs.Location 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 :: Command +cmd = noCommit $ command "setpresentkey" (paramPair paramKey (paramPair paramUUID "[1|0]")) seek + SectionPlumbing "change records of where key is present" seek :: CommandSeek seek = withWords start diff --git a/Command/Status.hs b/Command/Status.hs index 26e96a925..248a0b84b 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -16,10 +16,10 @@ import qualified Git.LsFiles as LsFiles import qualified Git.Ref import qualified Git -cmd :: [Command] -cmd = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $ +cmd :: Command +cmd = notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $ command "status" paramPaths seek SectionCommon - "show the working tree status"] + "show the working tree status" seek :: CommandSeek seek = withWords start diff --git a/Command/Sync.hs b/Command/Sync.hs index d2c2f95e8..10b9fc2cd 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -51,10 +51,10 @@ import Utility.Bloom import Control.Concurrent.MVar import qualified Data.Map as M -cmd :: [Command] -cmd = [withOptions syncOptions $ +cmd :: Command +cmd = withOptions syncOptions $ command "sync" (paramOptional (paramRepeating paramRemote)) - seek SectionCommon "synchronize local repository with remotes"] + seek SectionCommon "synchronize local repository with remotes" syncOptions :: [Option] syncOptions = diff --git a/Command/Test.hs b/Command/Test.hs index 3c4251460..af02985af 100644 --- a/Command/Test.hs +++ b/Command/Test.hs @@ -11,10 +11,10 @@ import Common import Command import Messages -cmd :: [Command] -cmd = [ noRepo startIO $ dontCheck repoExists $ +cmd :: Command +cmd = noRepo startIO $ dontCheck repoExists $ command "test" paramNothing seek SectionTesting - "run built-in test suite"] + "run built-in test suite" seek :: CommandSeek seek = withWords start diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index b0f2c28bb..cbd2edaf1 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -36,10 +36,10 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.Map as M -cmd :: [Command] -cmd = [ withOptions [sizeOption] $ +cmd :: Command +cmd = withOptions [sizeOption] $ command "testremote" paramRemote seek SectionTesting - "test transfers to/from a remote"] + "test transfers to/from a remote" sizeOption :: Option sizeOption = fieldOption [] "size" paramSize "base key size (default 1MiB)" diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs index f90e2ad73..44ffe59ad 100644 --- a/Command/TransferInfo.hs +++ b/Command/TransferInfo.hs @@ -15,11 +15,12 @@ import Types.Key import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered -cmd :: [Command] -cmd = [noCommit $ command "transferinfo" paramKey seek SectionPlumbing - "updates sender on number of bytes of content received"] +cmd :: Command +cmd = noCommit $ command "transferinfo" paramKey SectionPlumbing + "updates sender on number of bytes of content received" + (commandParser seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withWords start {- Security: diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 14e788893..6da2e742b 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -15,10 +15,10 @@ import Annex.Transfer import qualified Remote import Types.Remote -cmd :: [Command] -cmd = [withOptions transferKeyOptions $ +cmd :: Command +cmd = withOptions transferKeyOptions $ noCommit $ command "transferkey" paramKey seek SectionPlumbing - "transfers a key from or to a remote"] + "transfers a key from or to a remote" transferKeyOptions :: [Option] transferKeyOptions = fileOption : fromToOptions diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index d490d9be4..a151754df 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -21,9 +21,9 @@ import Git.Types (RemoteName) data TransferRequest = TransferRequest Direction Remote Key AssociatedFile -cmd :: [Command] -cmd = [command "transferkeys" paramNothing seek - SectionPlumbing "transfers keys"] +cmd :: Command +cmd = command "transferkeys" paramNothing seek + SectionPlumbing "transfers keys" seek :: CommandSeek seek = withNothing start diff --git a/Command/Trust.hs b/Command/Trust.hs index 9d380990e..6f3382c30 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -16,9 +16,9 @@ import Logs.Group import qualified Data.Set as S -cmd :: [Command] -cmd = [command "trust" (paramRepeating paramRemote) seek - SectionSetup "trust a repository"] +cmd :: Command +cmd = command "trust" (paramRepeating paramRemote) seek + SectionSetup "trust a repository" seek :: CommandSeek seek = trustCommand "trust" Trusted diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 0d88148c8..83e990921 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -22,12 +22,13 @@ import qualified Git.DiffTree as DiffTree import Utility.CopyFile import Command.PreCommit (lockPreCommitHook) -cmd :: [Command] -cmd = [withOptions annexedMatchingOptions $ - command "unannex" paramPaths seek SectionUtility - "undo accidential add command"] +cmd :: Command +cmd = withOptions annexedMatchingOptions $ + command "unannex" paramPaths SectionUtility + "undo accidential add command" + (commandParser seek) -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = wrapUnannex . (withFilesInGit $ whenAnnexed start) wrapUnannex :: Annex a -> Annex a diff --git a/Command/Undo.hs b/Command/Undo.hs index 8e6b1c44f..4740aab48 100644 --- a/Command/Undo.hs +++ b/Command/Undo.hs @@ -21,10 +21,10 @@ import qualified Git.Command as Git import qualified Git.Branch import qualified Command.Sync -cmd :: [Command] -cmd = [notBareRepo $ +cmd :: Command +cmd = notBareRepo $ command "undo" paramPaths seek - SectionCommon "undo last change to a file or directory"] + SectionCommon "undo last change to a file or directory" seek :: CommandSeek seek ps = do diff --git a/Command/Ungroup.hs b/Command/Ungroup.hs index dd6e8c952..b711a0132 100644 --- a/Command/Ungroup.hs +++ b/Command/Ungroup.hs @@ -15,9 +15,9 @@ 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 +cmd = 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 4a918070c..64c515464 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -21,9 +21,10 @@ import Utility.FileMode import System.IO.HVFS import System.IO.HVFS.Utils -cmd :: [Command] -cmd = [addCheck check $ command "uninit" paramPaths seek - SectionUtility "de-initialize git-annex and clean out repository"] +cmd :: Command +cmd = addCheck check $ command "uninit" paramPaths + SectionUtility "de-initialize git-annex and clean out repository" + (commandParser seek) check :: Annex () check = do @@ -39,7 +40,7 @@ check = do revhead = inRepo $ Git.Command.pipeReadStrict [Param "rev-parse", Param "--abbrev-ref", Param "HEAD"] -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek ps = do withFilesNotInGit False (whenAnnexed startCheckIncomplete) ps Annex.changeState $ \s -> s { Annex.fast = True } diff --git a/Command/Unlock.hs b/Command/Unlock.hs index a1b1ce411..98117f5b5 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -13,14 +13,15 @@ import Annex.Content import Annex.CatFile import Utility.CopyFile -cmd :: [Command] -cmd = - [ c "unlock" "unlock files for modification" - , c "edit" "same as unlock" - ] - where - c n = notDirect . withOptions annexedMatchingOptions - . command n paramPaths seek SectionCommon +cmd :: Command +cmd = mkcmd "unlock" "unlock files for modification" + +editcmd :: Command +editcmd = mkcmd "edit" "same as unlock" + +mkcmd :: String -> String -> Command +mkcmd n = notDirect . withOptions annexedMatchingOptions + . command n paramPaths seek SectionCommon seek :: CommandSeek seek = withFilesInGit $ whenAnnexed start diff --git a/Command/Untrust.hs b/Command/Untrust.hs index 92e28b637..220faf85e 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -11,9 +11,9 @@ import Command import Types.TrustLevel import Command.Trust (trustCommand) -cmd :: [Command] -cmd = [command "untrust" (paramRepeating paramRemote) seek - SectionSetup "do not trust a repository"] +cmd :: Command +cmd = command "untrust" (paramRepeating paramRemote) seek + SectionSetup "do not trust a repository" seek :: CommandSeek seek = trustCommand "untrust" UnTrusted diff --git a/Command/Unused.hs b/Command/Unused.hs index 77a9a92c3..1f84f012f 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -34,10 +34,11 @@ import Git.FilePath import Logs.View (is_branchView) import Annex.BloomFilter -cmd :: [Command] -cmd = [withOptions [unusedFromOption, refSpecOption] $ - command "unused" paramNothing seek - SectionMaintenance "look for unused file content"] +cmd :: Command +cmd = withOptions [unusedFromOption, refSpecOption] $ + command "unused" paramNothing + SectionMaintenance "look for unused file content" + (commandParser seek) unusedFromOption :: Option unusedFromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content" @@ -45,7 +46,7 @@ unusedFromOption = fieldOption ['f'] "from" paramRemote "remote to check for unu refSpecOption :: Option refSpecOption = fieldOption [] "used-refspec" paramRefSpec "refs to consider used (default: all refs)" -seek :: CommandSeek +seek :: CmdParams -> CommandSeek seek = withNothing start {- Finds unused content in the annex. -} diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index 081d7ff35..0fa9022ff 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -11,10 +11,10 @@ import Common.Annex import Command import Upgrade -cmd :: [Command] -cmd = [dontCheck repoExists $ -- because an old version may not seem to exist +cmd :: Command +cmd = dontCheck repoExists $ -- because an old version may not seem to exist command "upgrade" paramNothing seek - SectionMaintenance "upgrade repository layout"] + SectionMaintenance "upgrade repository layout" seek :: CommandSeek seek = withNothing start diff --git a/Command/VAdd.hs b/Command/VAdd.hs index ea98e6639..478eab098 100644 --- a/Command/VAdd.hs +++ b/Command/VAdd.hs @@ -12,9 +12,9 @@ import Command 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 :: Command +cmd = notBareRepo $ notDirect $ command "vadd" (paramRepeating "FIELD=GLOB") + seek SectionMetaData "add subdirs to current view" seek :: CommandSeek seek = withWords start diff --git a/Command/VCycle.hs b/Command/VCycle.hs index bf253adc1..31a5f80c2 100644 --- a/Command/VCycle.hs +++ b/Command/VCycle.hs @@ -14,10 +14,10 @@ import Types.View import Logs.View import Command.View (checkoutViewBranch) -cmd :: [Command] -cmd = [notBareRepo $ notDirect $ +cmd :: Command +cmd = notBareRepo $ notDirect $ command "vcycle" paramNothing seek SectionMetaData - "switch view to next layout"] + "switch view to next layout" seek :: CommandSeek seek = withNothing start diff --git a/Command/VFilter.hs b/Command/VFilter.hs index fd5ec9630..78f2d9d5c 100644 --- a/Command/VFilter.hs +++ b/Command/VFilter.hs @@ -12,9 +12,9 @@ import Command import Annex.View import Command.View (paramView, checkoutViewBranch) -cmd :: [Command] -cmd = [notBareRepo $ notDirect $ - command "vfilter" paramView seek SectionMetaData "filter current view"] +cmd :: Command +cmd = notBareRepo $ notDirect $ + command "vfilter" paramView seek SectionMetaData "filter current view" seek :: CommandSeek seek = withWords start diff --git a/Command/VPop.hs b/Command/VPop.hs index 1fb1d7a56..f6fc56b08 100644 --- a/Command/VPop.hs +++ b/Command/VPop.hs @@ -16,10 +16,10 @@ import Types.View import Logs.View import Command.View (checkoutViewBranch) -cmd :: [Command] -cmd = [notBareRepo $ notDirect $ +cmd :: Command +cmd = notBareRepo $ notDirect $ command "vpop" (paramOptional paramNumber) seek SectionMetaData - "switch back to previous view"] + "switch back to previous view" seek :: CommandSeek seek = withWords start diff --git a/Command/Version.hs b/Command/Version.hs index 1b96de9d2..3ceef3a60 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -17,10 +17,10 @@ import qualified Types.Remote as R import qualified Remote import qualified Backend -cmd :: [Command] -cmd = [withOptions [rawOption] $ +cmd :: Command +cmd = withOptions [rawOption] $ noCommit $ noRepo startNoRepo $ dontCheck repoExists $ - command "version" paramNothing seek SectionQuery "show version info"] + command "version" paramNothing seek SectionQuery "show version info" rawOption :: Option rawOption = flagOption [] "raw" "output only program version" diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index f1a64ba23..9b8177e77 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -29,9 +29,9 @@ import Types.StandardGroups import Types.ScheduledActivity import Remote -cmd :: [Command] -cmd = [command "vicfg" paramNothing seek - SectionSetup "edit git-annex's configuration"] +cmd :: Command +cmd = command "vicfg" paramNothing seek + SectionSetup "edit git-annex's configuration" seek :: CommandSeek seek = withNothing start diff --git a/Command/View.hs b/Command/View.hs index ae2878396..584cf091f 100644 --- a/Command/View.hs +++ b/Command/View.hs @@ -17,9 +17,9 @@ import Types.View import Annex.View import Logs.View -cmd :: [Command] -cmd = [notBareRepo $ notDirect $ - command "view" paramView seek SectionMetaData "enter a view branch"] +cmd :: Command +cmd = notBareRepo $ notDirect $ + command "view" paramView seek SectionMetaData "enter a view branch" seek :: CommandSeek seek = withWords start diff --git a/Command/Wanted.hs b/Command/Wanted.hs index 07f5ee7c3..215595a52 100644 --- a/Command/Wanted.hs +++ b/Command/Wanted.hs @@ -17,7 +17,7 @@ import Types.StandardGroups import qualified Data.Map as M -cmd :: [Command] +cmd :: Command cmd = cmd' "wanted" "get or set preferred content expression" preferredContentMapRaw preferredContentSet @@ -27,8 +27,8 @@ cmd' -> String -> Annex (M.Map UUID PreferredContentExpression) -> (UUID -> PreferredContentExpression -> Annex ()) - -> [Command] -cmd' name desc getter setter = [command name pdesc seek SectionSetup desc] + -> Command +cmd' name desc getter setter = command name pdesc seek SectionSetup desc where pdesc = paramPair paramRemote (paramOptional paramExpression) diff --git a/Command/Watch.hs b/Command/Watch.hs index cf86a5832..0782a4e6e 100644 --- a/Command/Watch.hs +++ b/Command/Watch.hs @@ -12,9 +12,9 @@ import Assistant import Command import Utility.HumanTime -cmd :: [Command] -cmd = [notBareRepo $ withOptions [foregroundOption, stopOption] $ - command "watch" paramNothing seek SectionCommon "watch for changes and autocommit"] +cmd :: Command +cmd = notBareRepo $ withOptions [foregroundOption, stopOption] $ + command "watch" paramNothing seek SectionCommon "watch for changes and autocommit" seek :: CommandSeek seek ps = do diff --git a/Command/WebApp.hs b/Command/WebApp.hs index e872d4be0..dab8e1e5b 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -37,10 +37,10 @@ import Control.Concurrent.STM import Network.Socket (HostName) import System.Environment (getArgs) -cmd :: [Command] -cmd = [ withOptions [listenOption] $ +cmd :: Command +cmd = withOptions [listenOption] $ noCommit $ noRepo startNoRepo $ dontCheck repoExists $ notBareRepo $ - command "webapp" paramNothing seek SectionCommon "launch webapp"] + command "webapp" paramNothing seek SectionCommon "launch webapp" listenOption :: Option listenOption = fieldOption [] "listen" paramAddress diff --git a/Command/Whereis.hs b/Command/Whereis.hs index cfcc8f224..54be0dd18 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -15,10 +15,10 @@ import Remote import Logs.Trust import Logs.Web -cmd :: [Command] -cmd = [noCommit $ withOptions (jsonOption : annexedMatchingOptions ++ keyOptions) $ +cmd :: Command +cmd = noCommit $ withOptions (jsonOption : annexedMatchingOptions ++ keyOptions) $ command "whereis" paramPaths seek SectionQuery - "lists repositories that have file content"] + "lists repositories that have file content" seek :: CommandSeek seek ps = do diff --git a/Command/XMPPGit.hs b/Command/XMPPGit.hs index 2bcb7405e..86cae9ab7 100644 --- a/Command/XMPPGit.hs +++ b/Command/XMPPGit.hs @@ -11,10 +11,10 @@ import Common.Annex import Command import Assistant.XMPP.Git -cmd :: [Command] -cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ +cmd :: Command +cmd = noCommit $ noRepo startNoRepo $ dontCheck repoExists $ command "xmppgit" paramNothing seek - SectionPlumbing "git to XMPP relay"] + SectionPlumbing "git to XMPP relay" seek :: CommandSeek seek = withWords start diff --git a/Types/Command.hs b/Types/Command.hs index de6e78038..4ab722035 100644 --- a/Types/Command.hs +++ b/Types/Command.hs @@ -1,6 +1,6 @@ {- git-annex command data types - - - 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,28 +8,31 @@ module Types.Command where import Data.Ord +import Options.Applicative.Types (Parser) import Types {- A command runs in these stages. - - - a. The check stage runs checks, that error out if + - a. The parser stage parses the command line and generates a CommandSeek + - action. -} +type CommandParser = Parser CommandSeek +{- b. The check stage runs checks, that error out if - anything prevents the command from running. -} data CommandCheck = CommandCheck { idCheck :: Int, runCheck :: Annex () } -{- b. The seek stage takes the parameters passed to the command, - - looks through the repo to find the ones that are relevant - - to that command (ie, new files to add), and runs commandAction - - to handle all necessary actions. -} -type CommandSeek = [String] -> Annex () -{- c. The start stage is run before anything is printed about the +{- c. The seek stage is passed input from the parser, looks through + - the repo to find things to act on (ie, new files to add), and + - runs commandAction to handle all necessary actions. -} +type CommandSeek = Annex () +{- d. The start stage is run before anything is printed about the - command, is passed some input, and can early abort it - if the input does not make sense. It should run quickly and - should not modify Annex state. -} type CommandStart = Annex (Maybe CommandPerform) -{- d. The perform stage is run after a message is printed about the command +{- e. The perform stage is run after a message is printed about the command - being run, and it should be where the bulk of the work happens. -} type CommandPerform = Annex (Maybe CommandCleanup) -{- e. The cleanup stage is run only if the perform stage succeeds, and it +{- f. The cleanup stage is run only if the perform stage succeeds, and it - returns the overall success/fail of the command. -} type CommandCleanup = Annex Bool @@ -42,11 +45,13 @@ data Command = Command , cmdnomessages :: Bool -- don't output normal messages , cmdname :: String , cmdparamdesc :: String -- description of params for usage - , cmdseek :: CommandSeek , cmdsection :: CommandSection , cmddesc :: String -- description of command for usage + , cmdparser :: CommandParser -- command line parser } +{- Command-line parameters, after the command is selected and options + - are parsed. -} type CmdParams = [String] {- CommandCheck functions can be compared using their unique id. -} diff --git a/git-annex.cabal b/git-annex.cabal index 941067f5d..fec1bd40d 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -113,6 +113,7 @@ Executable git-annex Main-Is: git-annex.hs Build-Depends: base (>= 4.5 && < 4.9), + optparse-applicative (>= 0.10), cryptohash (>= 0.11.0), containers (>= 0.5.0.0), exceptions (>= 0.6), @@ -164,7 +165,7 @@ Executable git-annex if flag(TestSuite) Build-Depends: tasty (>= 0.7), tasty-hunit, tasty-quickcheck, tasty-rerun, - optparse-applicative (>= 0.10), crypto-api + crypto-api CPP-Options: -DWITH_TESTSUITE if flag(TDFA) |