diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-01-21 13:14:38 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-01-21 13:14:38 -0400 |
commit | 2716c7ffc02731b90312a8754df61322f6e303d2 (patch) | |
tree | b7df6585a479956cdb56c5006d7d07bf3839aaf6 | |
parent | 6ccc1e78c24c23bc2d140de32a63379638dce9ee (diff) |
merge Checks into Command
-rw-r--r-- | Checks.hs | 49 | ||||
-rw-r--r-- | Command.hs | 59 |
2 files changed, 38 insertions, 70 deletions
diff --git a/Checks.hs b/Checks.hs deleted file mode 100644 index 3b4566caf..000000000 --- a/Checks.hs +++ /dev/null @@ -1,49 +0,0 @@ -{- git-annex command checks - - - - Common sanity checks for commands, and an interface to selectively - - remove them, or add others. - - - - Copyright 2011-2013 Joey Hess <id@joeyh.name> - - - - Licensed under the GNU GPL version 3 or higher. - -} - -module Checks where - -import Annex.Common -import Types.Command -import Annex.Init -import Config -import Utility.Daemon -import qualified Git - -commonChecks :: [CommandCheck] -commonChecks = [repoExists] - -repoExists :: CommandCheck -repoExists = CommandCheck 0 ensureInitialized - -notDirect :: Command -> Command -notDirect = addCheck $ whenM isDirect $ - error "You cannot run this command in a direct mode repository." - -notBareRepo :: Command -> Command -notBareRepo = addCheck $ whenM (fromRepo Git.repoIsLocalBare) $ - error "You cannot run this command in a bare repository." - -noDaemonRunning :: Command -> Command -noDaemonRunning = addCheck $ whenM (isJust <$> daemonpid) $ - error "You cannot run this command while git-annex watch or git-annex assistant is running." - where - daemonpid = liftIO . checkDaemon =<< fromRepo gitAnnexPidFile - -dontCheck :: CommandCheck -> Command -> Command -dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c - -addCheck :: Annex () -> Command -> Command -addCheck check cmd = mutateCheck cmd $ \c -> - CommandCheck (length c + 100) check : c - -mutateCheck :: Command -> ([CommandCheck] -> [CommandCheck]) -> Command -mutateCheck cmd@(Command { cmdcheck = c }) a = cmd { cmdcheck = a c } - diff --git a/Command.hs b/Command.hs index 3726e4777..9f45e088f 100644 --- a/Command.hs +++ b/Command.hs @@ -6,29 +6,14 @@ -} module Command ( - command, - withParams, - (<--<), - noRepo, - noCommit, - noMessages, - withGlobalOptions, - next, - stop, - stopUnless, - whenAnnexed, - ifAnnexed, - lookupFile, - isBareRepo, + module Command, module ReExported ) where import Annex.Common as ReExported -import Annex.WorkTree -import qualified Git +import Annex.WorkTree as ReExported (whenAnnexed, ifAnnexed) import Types.Command as ReExported import Types.DeferredParse as ReExported -import Checks as ReExported import CmdLine.Seek as ReExported import CmdLine.Usage as ReExported import CmdLine.Action as ReExported @@ -37,8 +22,10 @@ import CmdLine.GlobalSetter as ReExported import CmdLine.GitAnnex.Options as ReExported import CmdLine.Batch as ReExported import Options.Applicative as ReExported hiding (command) - -import qualified Options.Applicative as O +import qualified Git +import Annex.Init +import Config +import Utility.Daemon {- Generates a normal Command -} command :: String -> CommandSection -> String -> CmdParamsDesc -> (CmdParamsDesc -> CommandParser) -> Command @@ -47,7 +34,7 @@ command name section desc paramdesc mkparser = section desc (mkparser paramdesc) Nothing {- Simple option parser that takes all non-option params as-is. -} -withParams :: (CmdParams -> v) -> CmdParamsDesc -> O.Parser v +withParams :: (CmdParams -> v) -> CmdParamsDesc -> Parser v withParams mkseek paramdesc = mkseek <$> cmdParams paramdesc {- Uses the supplied option parser, which yields a deferred parse, @@ -76,7 +63,7 @@ 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 :: (String -> O.Parser (IO ())) -> Command -> Command +noRepo :: (String -> Parser (IO ())) -> Command -> Command noRepo a c = c { cmdnorepo = Just (a (cmdparamdesc c)) } {- Adds global options to a command's option parser, and modifies its seek @@ -106,3 +93,33 @@ stopUnless c a = ifM c ( a , stop ) isBareRepo :: Annex Bool isBareRepo = fromRepo Git.repoIsLocalBare + +commonChecks :: [CommandCheck] +commonChecks = [repoExists] + +repoExists :: CommandCheck +repoExists = CommandCheck 0 ensureInitialized + +notDirect :: Command -> Command +notDirect = addCheck $ whenM isDirect $ + error "You cannot run this command in a direct mode repository." + +notBareRepo :: Command -> Command +notBareRepo = addCheck $ whenM (fromRepo Git.repoIsLocalBare) $ + error "You cannot run this command in a bare repository." + +noDaemonRunning :: Command -> Command +noDaemonRunning = addCheck $ whenM (isJust <$> daemonpid) $ + error "You cannot run this command while git-annex watch or git-annex assistant is running." + where + daemonpid = liftIO . checkDaemon =<< fromRepo gitAnnexPidFile + +dontCheck :: CommandCheck -> Command -> Command +dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c + +addCheck :: Annex () -> Command -> Command +addCheck check cmd = mutateCheck cmd $ \c -> + CommandCheck (length c + 100) check : c + +mutateCheck :: Command -> ([CommandCheck] -> [CommandCheck]) -> Command +mutateCheck cmd@(Command { cmdcheck = c }) a = cmd { cmdcheck = a c } |