refactoring and cleanup

No code changes.

1 files changed, 30 insertions, 203 deletions

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 }