summaryrefslogtreecommitdiff
path: root/Command.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-10-29 15:19:05 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-10-29 15:19:05 -0400
commitf97c783283847c6cc4516673fe638b4d551e671d (patch)
tree3d9e96c4803f3310d82683f00c876f1d80c7be8e /Command.hs
parent0d92aca1aabbbeb2d50d91807312ff6039971751 (diff)
clean up check selection code
This new approach allows filtering out checks from the default set that are not appropriate for a command, rather than having to list every check that is appropriate. It also reduces some boilerplate. Haskell does not define Eq for functions, so I had to go a long way around with each check having a unique id. Meh.
Diffstat (limited to 'Command.hs')
-rw-r--r--Command.hs47
1 files changed, 30 insertions, 17 deletions
diff --git a/Command.hs b/Command.hs
index 5690118c4..b039403ca 100644
--- a/Command.hs
+++ b/Command.hs
@@ -24,7 +24,9 @@ import Init
-
- a. The check stage runs checks, that error out if
- anything prevents the command from running. -}
-type CommandCheck = Annex ()
+data CommandCheck = CommandCheck { idCheck :: Int, runCheck :: Annex () }
+instance Eq CommandCheck where
+ a == b = idCheck a == idCheck b
{- 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 generates
@@ -43,9 +45,9 @@ type CommandPerform = Annex (Maybe CommandCleanup)
type CommandCleanup = Annex Bool
data Command = Command {
+ cmdcheck :: [CommandCheck],
cmdname :: String,
cmdparams :: String,
- cmdcheck :: CommandCheck,
cmdseek :: [CommandSeek],
cmddesc :: String
}
@@ -58,9 +60,9 @@ next a = return $ Just a
stop :: Annex (Maybe a)
stop = return Nothing
-{- Checks that the command can be run in the current environment. -}
-checkCommand :: Command -> Annex ()
-checkCommand Command { cmdcheck = check } = check
+{- Generates a command with the common checks. -}
+command :: String -> String -> [CommandSeek] -> String -> Command
+command = Command commonChecks
{- Prepares a list of actions to run to perform a command, based on
- the parameters passed to it. -}
@@ -232,22 +234,33 @@ autoCopies key vs numcopiesattr a = do
if length have `vs` needed then a else stop
else a
-{- Checks -}
-defaultChecks :: CommandCheck
-defaultChecks = noFrom >> noTo >> needsRepo
-
-noChecks :: CommandCheck
-noChecks = return ()
+{- Common checks for commands, and an interface to selectively remove them,
+ - or add others. -}
+commonChecks :: [CommandCheck]
+commonChecks = [fromOpt, toOpt, repoExists]
-needsRepo :: CommandCheck
-needsRepo = ensureInitialized
+repoExists :: CommandCheck
+repoExists = CommandCheck 0 ensureInitialized
-noFrom :: CommandCheck
-noFrom = do
+fromOpt :: CommandCheck
+fromOpt = CommandCheck 1 $ do
v <- Annex.getState Annex.fromremote
unless (v == Nothing) $ error "cannot use --from with this command"
-noTo :: CommandCheck
-noTo = do
+toOpt :: CommandCheck
+toOpt = CommandCheck 2 $ do
v <- Annex.getState Annex.toremote
unless (v == Nothing) $ error "cannot use --to with this command"
+
+checkCommand :: Command -> Annex ()
+checkCommand Command { cmdcheck = c } = sequence_ $ map runCheck c
+
+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 }