summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-10-29 23:48:46 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-10-30 00:28:22 -0400
commit4e9be0d1f86893a469b33b763b55edfe75bdb3aa (patch)
treee721a64007bc52df419a720caf2907dcf62e54ef
parentef5330120c0b522ff159a5b3caba7a926236947b (diff)
refactoring and cleanup
No code changes.
-rw-r--r--Checks.hs45
-rw-r--r--CmdLine.hs1
-rw-r--r--Command.hs233
-rw-r--r--Command/FromKey.hs1
-rw-r--r--Command/Fsck.hs2
-rw-r--r--Command/SetKey.hs1
-rw-r--r--Config.hs12
-rw-r--r--GitAnnex.hs1
-rw-r--r--Options.hs39
-rw-r--r--Seek.hs117
-rw-r--r--Types/Command.hs45
-rw-r--r--git-annex-shell.hs1
12 files changed, 288 insertions, 210 deletions
diff --git a/Checks.hs b/Checks.hs
new file mode 100644
index 000000000..cd172c609
--- /dev/null
+++ b/Checks.hs
@@ -0,0 +1,45 @@
+{- git-annex command checks
+ -
+ - Common sanity checks for commands, and an interface to selectively
+ - remove them, or add others.
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Checks where
+
+import Common.Annex
+import Types.Command
+import Init
+import qualified Annex
+
+commonChecks :: [CommandCheck]
+commonChecks = [fromOpt, toOpt, repoExists]
+
+repoExists :: CommandCheck
+repoExists = CommandCheck 0 ensureInitialized
+
+fromOpt :: CommandCheck
+fromOpt = CommandCheck 1 $ do
+ v <- Annex.getState Annex.fromremote
+ unless (v == Nothing) $ error "cannot use --from with this command"
+
+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 }
diff --git a/CmdLine.hs b/CmdLine.hs
index 9f1ded498..fffd343f0 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -20,7 +20,6 @@ import qualified Annex.Queue
import qualified Git
import Annex.Content
import Command
-import Options
{- Runs the passed command line. -}
dispatch :: [String] -> [Command] -> [Option] -> String -> Git.Repo -> IO ()
diff --git a/Command.hs b/Command.hs
index 32f6743f3..74b1ff21c 100644
--- a/Command.hs
+++ b/Command.hs
@@ -5,52 +5,38 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-module Command where
+module Command (
+ module Types.Command,
+ module Seek,
+ module Checks,
+ module Options,
+ command,
+ next,
+ stop,
+ prepCommand,
+ doCommand,
+ notAnnexed,
+ isAnnexed,
+ notBareRepo,
+ isBareRepo,
+ autoCopies
+) where
import Common.Annex
import qualified Backend
import qualified Annex
import qualified Git
-import qualified Git.LsFiles as LsFiles
-import Types.Key
+import Types.Command
import Logs.Trust
import Logs.Location
import Config
-import Backend
-import Limit
-import Init
+import Seek
+import Checks
+import Options
-{- A command runs in these stages.
- -
- - a. The check stage runs checks, that error out if
- - anything prevents the command from running. -}
-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
- - a list of start stage actions. -}
-type CommandSeek = [String] -> Annex [CommandStart]
-{- c. 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
- - 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
- - returns the overall success/fail of the command. -}
-type CommandCleanup = Annex Bool
-
-data Command = Command {
- cmdcheck :: [CommandCheck],
- cmdname :: String,
- cmdparams :: String,
- cmdseek :: [CommandSeek],
- cmddesc :: String
-}
+{- Generates a command with the common checks. -}
+command :: String -> String -> [CommandSeek] -> String -> Command
+command = Command commonChecks
{- For start and perform stages to indicate what step to run next. -}
next :: a -> Annex (Maybe a)
@@ -60,15 +46,14 @@ next a = return $ Just a
stop :: Annex (Maybe a)
stop = return Nothing
-{- 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. -}
prepCommand :: Command -> [String] -> Annex [Annex Bool]
-prepCommand Command { cmdseek = seek } params =
- return . map doCommand . concat =<< mapM (\s -> s params) seek
+prepCommand cmd ps = return . map doCommand =<< seekCommand cmd ps
+
+{- Runs a command through the seek stage. -}
+seekCommand :: Command -> [String] -> Annex [CommandStart]
+seekCommand Command { cmdseek = seek } ps = concat <$> mapM (\s -> s ps) seek
{- Runs a command through the start, perform and cleanup stages -}
doCommand :: CommandStart -> CommandCleanup
@@ -81,147 +66,20 @@ doCommand = start
success = return True
failure = showEndFail >> return False
-{- These functions find appropriate files or other things based on a
- user's parameters, and prepare actions operating on them. -}
-withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
-withFilesInGit a params = do
- repo <- gitRepo
- runFiltered a $ liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
-withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek
-withAttrFilesInGit attr a params = do
- repo <- gitRepo
- files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
- runFilteredGen a fst $ liftIO $ Git.checkAttr repo attr files
-withNumCopies :: (FilePath -> Maybe Int -> CommandStart) -> CommandSeek
-withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params
- where
- go (file, v) = a file (readMaybe v)
-withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
-withBackendFilesInGit a params = do
- repo <- gitRepo
- files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
- backendPairs a files
-withFilesMissing :: (String -> CommandStart) -> CommandSeek
-withFilesMissing a params = runFiltered a $ liftIO $ filterM missing params
- where
- missing = liftM not . doesFileExist
-withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek
-withFilesNotInGit a params = do
- repo <- gitRepo
- force <- Annex.getState Annex.force
- newfiles <- liftIO $ runPreserveOrder (LsFiles.notInRepo repo force) params
- backendPairs a newfiles
-withWords :: ([String] -> CommandStart) -> CommandSeek
-withWords a params = return [a params]
-withStrings :: (String -> CommandStart) -> CommandSeek
-withStrings a params = return $ map a params
-withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek
-withFilesToBeCommitted a params = do
- repo <- gitRepo
- runFiltered a $
- liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params
-withFilesUnlocked :: (BackendFile -> CommandStart) -> CommandSeek
-withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
-withFilesUnlockedToBeCommitted :: (BackendFile -> CommandStart) -> CommandSeek
-withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
-withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek
-withFilesUnlocked' typechanged a params = do
- -- unlocked files have changed type from a symlink to a regular file
- repo <- gitRepo
- typechangedfiles <- liftIO $ runPreserveOrder (typechanged repo) params
- unlockedfiles <- liftIO $ filterM notSymlink $
- map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles
- backendPairs a unlockedfiles
-withKeys :: (Key -> CommandStart) -> CommandSeek
-withKeys a params = return $ map (a . parse) params
- where
- parse p = fromMaybe (error "bad key") $ readKey p
-withNothing :: CommandStart -> CommandSeek
-withNothing a [] = return [a]
-withNothing _ _ = error "This command takes no parameters."
-
-runFiltered :: (FilePath -> Annex (Maybe a)) -> Annex [FilePath] -> Annex [Annex (Maybe a)]
-runFiltered a = runFilteredGen a id
-
-backendPairs :: (BackendFile -> CommandStart) -> CommandSeek
-backendPairs a fs = runFilteredGen a snd (Backend.chooseBackends fs)
-
-runFilteredGen :: (b -> Annex (Maybe a)) -> (b -> FilePath) -> Annex [b] -> Annex [Annex (Maybe a)]
-runFilteredGen a d fs = do
- matcher <- Limit.getMatcher
- runActions (proc matcher) fs
- where
- proc matcher v = do
- let f = d v
- ok <- matcher f
- if ok then a v else stop
-
-runActions :: (b -> Annex (Maybe a)) -> Annex [b] -> Annex [Annex (Maybe a)]
-runActions a fs = liftM (map a) fs
-
notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file
isAnnexed :: FilePath -> ((Key, Backend Annex) -> Annex (Maybe a)) -> Annex (Maybe a)
isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file
-isBareRepo :: Annex Bool
-isBareRepo = Git.repoIsLocalBare <$> gitRepo
-
notBareRepo :: Annex a -> Annex a
notBareRepo a = do
whenM isBareRepo $
error "You cannot run this subcommand in a bare repository."
a
-notSymlink :: FilePath -> IO Bool
-notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
-
-{- Descriptions of params used in usage messages. -}
-paramPaths :: String
-paramPaths = paramOptional $ paramRepeating paramPath -- most often used
-paramPath :: String
-paramPath = "PATH"
-paramKey :: String
-paramKey = "KEY"
-paramDesc :: String
-paramDesc = "DESC"
-paramUrl :: String
-paramUrl = "URL"
-paramNumber :: String
-paramNumber = "NUMBER"
-paramRemote :: String
-paramRemote = "REMOTE"
-paramGlob :: String
-paramGlob = "GLOB"
-paramName :: String
-paramName = "NAME"
-paramUUID :: String
-paramUUID = "UUID"
-paramType :: String
-paramType = "TYPE"
-paramKeyValue :: String
-paramKeyValue = "K=V"
-paramNothing :: String
-paramNothing = ""
-paramRepeating :: String -> String
-paramRepeating s = s ++ " ..."
-paramOptional :: String -> String
-paramOptional s = "[" ++ s ++ "]"
-paramPair :: String -> String -> String
-paramPair a b = a ++ " " ++ b
-
-{- The Key specified by the --key parameter. -}
-cmdlineKey :: Annex Key
-cmdlineKey = do
- k <- Annex.getState Annex.defaultkey
- case k of
- Nothing -> nokey
- Just "" -> nokey
- Just kstring -> maybe badkey return $ readKey kstring
- where
- nokey = error "please specify the key with --key"
- badkey = error "bad key"
+isBareRepo :: Annex Bool
+isBareRepo = Git.repoIsLocalBare <$> gitRepo
{- Used for commands that have an auto mode that checks the number of known
- copies of a key.
@@ -238,34 +96,3 @@ autoCopies key vs numcopiesattr a = do
(_, have) <- trustPartition UnTrusted =<< keyLocations key
if length have `vs` needed then a else stop
else a
-
-{- Common checks for commands, and an interface to selectively remove them,
- - or add others. -}
-commonChecks :: [CommandCheck]
-commonChecks = [fromOpt, toOpt, repoExists]
-
-repoExists :: CommandCheck
-repoExists = CommandCheck 0 ensureInitialized
-
-fromOpt :: CommandCheck
-fromOpt = CommandCheck 1 $ do
- v <- Annex.getState Annex.fromremote
- unless (v == Nothing) $ error "cannot use --from with this command"
-
-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 }
diff --git a/Command/FromKey.hs b/Command/FromKey.hs
index fe9b5c96a..4e4644708 100644
--- a/Command/FromKey.hs
+++ b/Command/FromKey.hs
@@ -12,6 +12,7 @@ import Command
import qualified Annex.Queue
import Annex.Content
import Types.Key
+import Config
def :: [Command]
def = [command "fromkey" paramPath seek "adds a file using a specific key"]
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 1f30d2eb6..073652d2c 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -49,7 +49,7 @@ withBarePresentKeys a params = isBareRepo >>= go
go True = do
unless (null params) $ do
error "fsck should be run without parameters in a bare repository"
- runActions a loggedKeys
+ prepStart a loggedKeys
startBare :: Key -> CommandStart
startBare key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of
diff --git a/Command/SetKey.hs b/Command/SetKey.hs
index 9c31abb08..0c70d12b0 100644
--- a/Command/SetKey.hs
+++ b/Command/SetKey.hs
@@ -11,6 +11,7 @@ import Common.Annex
import Command
import Logs.Location
import Annex.Content
+import Config
def :: [Command]
def = [command "setkey" paramPath seek
diff --git a/Config.hs b/Config.hs
index f4c3843af..f994002b9 100644
--- a/Config.hs
+++ b/Config.hs
@@ -10,6 +10,7 @@ module Config where
import Common.Annex
import qualified Git
import qualified Annex
+import Types.Key (readKey)
type ConfigKey = String
@@ -92,3 +93,14 @@ getNumCopies v =
return $ read $ Git.configGet g config "1"
config = "annex.numcopies"
+{- The Key specified by the --key parameter. -}
+cmdlineKey :: Annex Key
+cmdlineKey = do
+ k <- Annex.getState Annex.defaultkey
+ case k of
+ Nothing -> nokey
+ Just "" -> nokey
+ Just kstring -> maybe badkey return $ readKey kstring
+ where
+ nokey = error "please specify the key with --key"
+ badkey = error "bad key"
diff --git a/GitAnnex.hs b/GitAnnex.hs
index c07e727fa..89fb4e591 100644
--- a/GitAnnex.hs
+++ b/GitAnnex.hs
@@ -13,7 +13,6 @@ import Common.Annex
import qualified Git
import CmdLine
import Command
-import Options
import Types.TrustLevel
import qualified Annex
import qualified Remote
diff --git a/Options.hs b/Options.hs
index 0c7b4d5f4..a8c165a81 100644
--- a/Options.hs
+++ b/Options.hs
@@ -1,6 +1,6 @@
-{- git-annex dashed options
+{- git-annex command-line options
-
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -12,7 +12,6 @@ import System.Log.Logger
import Common.Annex
import qualified Annex
-import Command
import Limit
{- Each dashed command-line option results in generation of an action
@@ -59,3 +58,37 @@ matcherOptions =
where
longopt o = Option [] [o] $ NoArg $ addToken o
shortopt o = Option o [] $ NoArg $ addToken o
+
+{- Descriptions of params used in usage messages. -}
+paramPaths :: String
+paramPaths = paramOptional $ paramRepeating paramPath -- most often used
+paramPath :: String
+paramPath = "PATH"
+paramKey :: String
+paramKey = "KEY"
+paramDesc :: String
+paramDesc = "DESC"
+paramUrl :: String
+paramUrl = "URL"
+paramNumber :: String
+paramNumber = "NUMBER"
+paramRemote :: String
+paramRemote = "REMOTE"
+paramGlob :: String
+paramGlob = "GLOB"
+paramName :: String
+paramName = "NAME"
+paramUUID :: String
+paramUUID = "UUID"
+paramType :: String
+paramType = "TYPE"
+paramKeyValue :: String
+paramKeyValue = "K=V"
+paramNothing :: String
+paramNothing = ""
+paramRepeating :: String -> String
+paramRepeating s = s ++ " ..."
+paramOptional :: String -> String
+paramOptional s = "[" ++ s ++ "]"
+paramPair :: String -> String -> String
+paramPair a b = a ++ " " ++ b
diff --git a/Seek.hs b/Seek.hs
new file mode 100644
index 000000000..4ae943157
--- /dev/null
+++ b/Seek.hs
@@ -0,0 +1,117 @@
+{- git-annex command seeking
+ -
+ - These functions find appropriate files or other things based on
+ - the values a user passes to a command, and prepare actions operating
+ - on them.
+ -
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Seek where
+
+import Common.Annex
+import Types.Command
+import Types.Key
+import Backend
+import qualified Annex
+import qualified Git
+import qualified Git.LsFiles as LsFiles
+import qualified Limit
+
+withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
+withFilesInGit a params = do
+ repo <- gitRepo
+ prepFiltered a $ liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
+
+withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek
+withAttrFilesInGit attr a params = do
+ repo <- gitRepo
+ files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
+ prepFilteredGen a fst $ liftIO $ Git.checkAttr repo attr files
+
+withNumCopies :: (FilePath -> Maybe Int -> CommandStart) -> CommandSeek
+withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params
+ where
+ go (file, v) = a file (readMaybe v)
+
+withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
+withBackendFilesInGit a params = do
+ repo <- gitRepo
+ files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
+ prepBackendPairs a files
+
+withFilesMissing :: (String -> CommandStart) -> CommandSeek
+withFilesMissing a params = prepFiltered a $ liftIO $ filterM missing params
+ where
+ missing = liftM not . doesFileExist
+
+withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek
+withFilesNotInGit a params = do
+ repo <- gitRepo
+ force <- Annex.getState Annex.force
+ newfiles <- liftIO $ runPreserveOrder (LsFiles.notInRepo repo force) params
+ prepBackendPairs a newfiles
+
+withWords :: ([String] -> CommandStart) -> CommandSeek
+withWords a params = return [a params]
+
+withStrings :: (String -> CommandStart) -> CommandSeek
+withStrings a params = return $ map a params
+
+withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek
+withFilesToBeCommitted a params = do
+ repo <- gitRepo
+ prepFiltered a $
+ liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params
+
+withFilesUnlocked :: (BackendFile -> CommandStart) -> CommandSeek
+withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
+
+withFilesUnlockedToBeCommitted :: (BackendFile -> CommandStart) -> CommandSeek
+withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
+
+withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek
+withFilesUnlocked' typechanged a params = do
+ -- unlocked files have changed type from a symlink to a regular file
+ repo <- gitRepo
+ typechangedfiles <- liftIO $ runPreserveOrder (typechanged repo) params
+ unlockedfiles <- liftIO $ filterM notSymlink $
+ map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles
+ prepBackendPairs a unlockedfiles
+
+withKeys :: (Key -> CommandStart) -> CommandSeek
+withKeys a params = return $ map (a . parse) params
+ where
+ parse p = fromMaybe (error "bad key") $ readKey p
+
+withNothing :: CommandStart -> CommandSeek
+withNothing a [] = return [a]
+withNothing _ _ = error "This command takes no parameters."
+
+
+prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]
+prepFiltered a = prepFilteredGen a id
+
+prepBackendPairs :: (BackendFile -> CommandStart) -> CommandSeek
+prepBackendPairs a fs = prepFilteredGen a snd (chooseBackends fs)
+
+prepFilteredGen :: (b -> CommandStart) -> (b -> FilePath) -> Annex [b] -> Annex [CommandStart]
+prepFilteredGen a d fs = do
+ matcher <- Limit.getMatcher
+ prepStart (proc matcher) fs
+ where
+ proc matcher v = do
+ let f = d v
+ ok <- matcher f
+ if ok then a v else return Nothing
+
+{- Generates a list of CommandStart actions that will be run to perform a
+ - command, using a list (ie of files) coming from an action. The list
+ - will be produced and consumed lazily. -}
+prepStart :: (b -> CommandStart) -> Annex [b] -> Annex [CommandStart]
+prepStart a fs = liftM (map a) fs
+
+notSymlink :: FilePath -> IO Bool
+notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
diff --git a/Types/Command.hs b/Types/Command.hs
new file mode 100644
index 000000000..d39876a7a
--- /dev/null
+++ b/Types/Command.hs
@@ -0,0 +1,45 @@
+{- git-annex command data types
+ -
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.Command where
+
+import Types
+
+{- A command runs in these stages.
+ -
+ - a. 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 generates
+ - a list of start stage actions. -}
+type CommandSeek = [String] -> Annex [CommandStart]
+{- c. 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
+ - 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
+ - returns the overall success/fail of the command. -}
+type CommandCleanup = Annex Bool
+
+{- A command is defined by specifying these things. -}
+data Command = Command {
+ cmdcheck :: [CommandCheck],
+ cmdname :: String,
+ cmdparams :: String,
+ cmdseek :: [CommandSeek],
+ cmddesc :: String
+}
+
+{- CommandCheck functions can be compared using their unique id. -}
+instance Eq CommandCheck where
+ a == b = idCheck a == idCheck b
diff --git a/git-annex-shell.hs b/git-annex-shell.hs
index 328d7b100..10eeb454a 100644
--- a/git-annex-shell.hs
+++ b/git-annex-shell.hs
@@ -12,7 +12,6 @@ import Common.Annex
import qualified Git
import CmdLine
import Command
-import Options
import Annex.UUID
import qualified Command.ConfigList