diff options
Diffstat (limited to 'Command.hs')
| -rw-r--r-- | Command.hs | 53 |
1 files changed, 43 insertions, 10 deletions
diff --git a/Command.hs b/Command.hs index 35034a494..bee63bb74 100644 --- a/Command.hs +++ b/Command.hs @@ -1,16 +1,18 @@ {- git-annex command infrastructure - - - Copyright 2010-2014 Joey Hess <id@joeyh.name> + - Copyright 2010-2015 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} module Command ( command, + withParams, + (<--<), noRepo, noCommit, noMessages, - withOptions, + withGlobalOptions, next, stop, stopUnless, @@ -25,16 +27,38 @@ import qualified Backend import qualified Git import Types.Command as ReExported import Types.Option as ReExported +import Types.DeferredParse as ReExported import CmdLine.Seek as ReExported import Checks as ReExported import CmdLine.Usage as ReExported import CmdLine.Action as ReExported import CmdLine.Option as ReExported +import CmdLine.GlobalSetter as ReExported import CmdLine.GitAnnex.Options as ReExported +import Options.Applicative as ReExported hiding (command) -{- Generates a normal command -} -command :: String -> String -> CommandSeek -> CommandSection -> String -> Command -command = Command [] Nothing commonChecks False False +import qualified Options.Applicative as O + +{- Generates a normal Command -} +command :: String -> CommandSection -> String -> CmdParamsDesc -> (CmdParamsDesc -> CommandParser) -> Command +command name section desc paramdesc mkparser = + Command commonChecks False False name paramdesc + section desc (mkparser paramdesc) Nothing + +{- Simple option parser that takes all non-option params as-is. -} +withParams :: (CmdParams -> v) -> CmdParamsDesc -> O.Parser v +withParams mkseek paramdesc = mkseek <$> cmdParams paramdesc + +{- Uses the supplied option parser, which yields a deferred parse, + - and calls finishParse on the result before passing it to the + - CommandSeek constructor. -} +(<--<) :: DeferredParseClass a + => (a -> CommandSeek) + -> (CmdParamsDesc -> Parser a) + -> CmdParamsDesc + -> Parser CommandSeek +(<--<) mkseek optparser paramsdesc = + (mkseek <=< finishParse) <$> optparser paramsdesc {- Indicates that a command doesn't need to commit any changes to - the git-annex branch. -} @@ -48,12 +72,21 @@ noMessages c = c { cmdnomessages = True } {- Adds a fallback action to a command, that will be run if it's used - outside a git repository. -} -noRepo :: (CmdParams -> IO ()) -> Command -> Command -noRepo a c = c { cmdnorepo = Just a } +noRepo :: (String -> O.Parser (IO ())) -> Command -> Command +noRepo a c = c { cmdnorepo = Just (a (cmdparamdesc c)) } -{- Adds options to a command. -} -withOptions :: [Option] -> Command -> Command -withOptions o c = c { cmdoptions = cmdoptions c ++ o } +{- Adds global options to a command's option parser, and modifies its seek + - option to first run actions for them. + -} +withGlobalOptions :: [GlobalOption] -> Command -> Command +withGlobalOptions os c = c { cmdparser = apply <$> mixin (cmdparser c) } + where + mixin p = (,) + <$> p + <*> combineGlobalOptions os + apply (seek, globalsetters) = do + void $ getParsed globalsetters + seek {- For start and perform stages to indicate what step to run next. -} next :: a -> Annex (Maybe a) |