summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex.hs4
-rw-r--r--CmdLine.hs69
-rw-r--r--Command.hs112
-rw-r--r--Command/Add.hs11
-rw-r--r--Command/Copy.hs2
-rw-r--r--Command/Drop.hs8
-rw-r--r--Command/DropKey.hs8
-rw-r--r--Command/DropUnused.hs4
-rw-r--r--Command/Find.hs4
-rw-r--r--Command/Fix.hs8
-rw-r--r--Command/FromKey.hs8
-rw-r--r--Command/Fsck.hs6
-rw-r--r--Command/Get.hs6
-rw-r--r--Command/Init.hs8
-rw-r--r--Command/Lock.hs6
-rw-r--r--Command/Move.hs16
-rw-r--r--Command/PreCommit.hs10
-rw-r--r--Command/SetKey.hs8
-rw-r--r--Command/Trust.hs6
-rw-r--r--Command/Unannex.hs8
-rw-r--r--Command/Uninit.hs6
-rw-r--r--Command/Unlock.hs6
-rw-r--r--Command/Untrust.hs6
-rw-r--r--Command/Unused.hs6
24 files changed, 177 insertions, 159 deletions
diff --git a/Annex.hs b/Annex.hs
index af761051d..6e5198e8e 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -110,10 +110,10 @@ flagGet name = do
{- Adds a git command to the queue. -}
queue :: String -> [String] -> FilePath -> Annex ()
-queue subcommand params file = do
+queue command params file = do
state <- get
let q = Internals.repoqueue state
- put state { Internals.repoqueue = GitQueue.add q subcommand params file }
+ put state { Internals.repoqueue = GitQueue.add q command params file }
{- Returns the queue. -}
queueGet :: Annex GitQueue.Queue
diff --git a/CmdLine.hs b/CmdLine.hs
index 7eab0a7e2..40ce4b121 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -37,51 +37,50 @@ import qualified Command.Uninit
import qualified Command.Trust
import qualified Command.Untrust
-subCmds :: [SubCommand]
-subCmds =
- [ SubCommand "add" path Command.Add.seek
- "add files to annex"
- , SubCommand "get" path Command.Get.seek
+cmds :: [Command]
+cmds =
+ [ Command.Add.command
+ , Command "get" path Command.Get.seek
"make content of annexed files available"
- , SubCommand "drop" path Command.Drop.seek
+ , Command "drop" path Command.Drop.seek
"indicate content of files not currently wanted"
- , SubCommand "move" path Command.Move.seek
+ , Command "move" path Command.Move.seek
"move content of files to/from another repository"
- , SubCommand "copy" path Command.Copy.seek
+ , Command "copy" path Command.Copy.seek
"copy content of files to/from another repository"
- , SubCommand "unlock" path Command.Unlock.seek
+ , Command "unlock" path Command.Unlock.seek
"unlock files for modification"
- , SubCommand "edit" path Command.Unlock.seek
+ , Command "edit" path Command.Unlock.seek
"same as unlock"
- , SubCommand "lock" path Command.Lock.seek
+ , Command "lock" path Command.Lock.seek
"undo unlock command"
- , SubCommand "init" desc Command.Init.seek
+ , Command "init" desc Command.Init.seek
"initialize git-annex with repository description"
- , SubCommand "unannex" path Command.Unannex.seek
+ , Command "unannex" path Command.Unannex.seek
"undo accidential add command"
- , SubCommand "uninit" path Command.Uninit.seek
+ , Command "uninit" path Command.Uninit.seek
"de-initialize git-annex and clean out repository"
- , SubCommand "pre-commit" path Command.PreCommit.seek
+ , Command "pre-commit" path Command.PreCommit.seek
"run by git pre-commit hook"
- , SubCommand "trust" remote Command.Trust.seek
+ , Command "trust" remote Command.Trust.seek
"trust a repository"
- , SubCommand "untrust" remote Command.Untrust.seek
+ , Command "untrust" remote Command.Untrust.seek
"do not trust a repository"
- , SubCommand "fromkey" key Command.FromKey.seek
+ , Command "fromkey" key Command.FromKey.seek
"adds a file using a specific key"
- , SubCommand "dropkey" key Command.DropKey.seek
+ , Command "dropkey" key Command.DropKey.seek
"drops annexed content for specified keys"
- , SubCommand "setkey" key Command.SetKey.seek
+ , Command "setkey" key Command.SetKey.seek
"sets annexed content for a key using a temp file"
- , SubCommand "fix" path Command.Fix.seek
+ , Command "fix" path Command.Fix.seek
"fix up symlinks to point to annexed content"
- , SubCommand "fsck" maybepath Command.Fsck.seek
+ , Command "fsck" maybepath Command.Fsck.seek
"check for problems"
- , SubCommand "unused" nothing Command.Unused.seek
+ , Command "unused" nothing Command.Unused.seek
"look for unused file content"
- , SubCommand "dropunused" number Command.DropUnused.seek
+ , Command "dropunused" number Command.DropUnused.seek
"drop unused file content"
- , SubCommand "find" maybepath Command.Find.seek
+ , Command "find" maybepath Command.Find.seek
"lists available files"
]
where
@@ -125,13 +124,13 @@ header = "Usage: git-annex subcommand [option ..]"
usage :: String
usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs
where
- cmddescs = unlines $ map (indent . showcmd) subCmds
+ cmddescs = unlines $ map (indent . showcmd) cmds
showcmd c =
- subcmdname c ++
- pad 11 (subcmdname c) ++
- subcmdparams c ++
- pad 13 (subcmdparams c) ++
- subcmddesc c
+ cmdname c ++
+ pad 11 (cmdname c) ++
+ cmdparams c ++
+ pad 13 (cmdparams c) ++
+ cmddesc c
indent l = " " ++ l
pad n s = replicate (n - length s) ' '
@@ -143,12 +142,12 @@ parseCmd argv = do
when (null params) $ error usage
case lookupCmd (head params) of
[] -> error usage
- [subcommand] -> do
+ [command] -> do
_ <- sequence flags
- prepSubCmd subcommand (drop 1 params)
- _ -> error "internal error: multiple matching subcommands"
+ prepCmd command (drop 1 params)
+ _ -> error "internal error: multiple matching commands"
where
getopt = case getOpt Permute options argv of
(flags, params, []) -> return (flags, params)
(_, _, errs) -> ioError (userError (concat errs ++ usage))
- lookupCmd cmd = filter (\c -> cmd == subcmdname c) subCmds
+ lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds
diff --git a/Command.hs b/Command.hs
index e30904d0f..2144da353 100644
--- a/Command.hs
+++ b/Command.hs
@@ -21,54 +21,54 @@ import qualified Annex
import qualified GitRepo as Git
import Locations
-{- A subcommand runs in four stages.
+{- A command runs in four stages.
-
- - 0. The seek stage takes the parameters passed to the subcommand,
+ - 0. The seek stage takes the parameters passed to the command,
- looks through the repo to find the ones that are relevant
- - to that subcommand (ie, new files to add), and generates
+ - to that command (ie, new files to add), and generates
- a list of start stage actions. -}
-type SubCmdSeek = [String] -> Annex [SubCmdStart]
+type CommandSeek = [String] -> Annex [CommandStart]
{- 1. The start stage is run before anything is printed about the
- - subcommand, is passed some input, and can early abort it
+ - 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 SubCmdStart = Annex (Maybe SubCmdPerform)
-{- 2. The perform stage is run after a message is printed about the subcommand
+type CommandStart = Annex (Maybe CommandPerform)
+{- 2. 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 SubCmdPerform = Annex (Maybe SubCmdCleanup)
+type CommandPerform = Annex (Maybe CommandCleanup)
{- 3. The cleanup stage is run only if the perform stage succeeds, and it
- - returns the overall success/fail of the subcommand. -}
-type SubCmdCleanup = Annex Bool
-{- Some helper functions are used to build up SubCmdSeek and SubCmdStart
+ - returns the overall success/fail of the command. -}
+type CommandCleanup = Annex Bool
+{- Some helper functions are used to build up CommandSeek and CommandStart
- functions. -}
-type SubCmdSeekStrings = SubCmdStartString -> SubCmdSeek
-type SubCmdStartString = String -> SubCmdStart
+type CommandSeekStrings = CommandStartString -> CommandSeek
+type CommandStartString = String -> CommandStart
type BackendFile = (FilePath, Maybe Backend)
-type SubCmdSeekBackendFiles = SubCmdStartBackendFile -> SubCmdSeek
-type SubCmdStartBackendFile = BackendFile -> SubCmdStart
+type CommandSeekBackendFiles = CommandStartBackendFile -> CommandSeek
+type CommandStartBackendFile = BackendFile -> CommandStart
type AttrFile = (FilePath, String)
-type SubCmdSeekAttrFiles = SubCmdStartAttrFile -> SubCmdSeek
-type SubCmdStartAttrFile = AttrFile -> SubCmdStart
-type SubCmdSeekNothing = SubCmdStart -> SubCmdSeek
-type SubCmdStartNothing = SubCmdStart
-
-data SubCommand = SubCommand {
- subcmdname :: String,
- subcmdparams :: String,
- subcmdseek :: [SubCmdSeek],
- subcmddesc :: String
+type CommandSeekAttrFiles = CommandStartAttrFile -> CommandSeek
+type CommandStartAttrFile = AttrFile -> CommandStart
+type CommandSeekNothing = CommandStart -> CommandSeek
+type CommandStartNothing = CommandStart
+
+data Command = Command {
+ cmdname :: String,
+ cmdparams :: String,
+ cmdseek :: [CommandSeek],
+ cmddesc :: String
}
-{- Prepares a list of actions to run to perform a subcommand, based on
+{- Prepares a list of actions to run to perform a command, based on
- the parameters passed to it. -}
-prepSubCmd :: SubCommand -> [String] -> Annex [Annex Bool]
-prepSubCmd SubCommand { subcmdseek = seek } params = do
+prepCmd :: Command -> [String] -> Annex [Annex Bool]
+prepCmd Command { cmdseek = seek } params = do
lists <- mapM (\s -> s params) seek
- return $ map doSubCmd $ foldl (++) [] lists
+ return $ map doCommand $ foldl (++) [] lists
-{- Runs a subcommand through the start, perform and cleanup stages -}
-doSubCmd :: SubCmdStart -> SubCmdCleanup
-doSubCmd start = do
+{- Runs a command through the start, perform and cleanup stages -}
+doCommand :: CommandStart -> CommandCleanup
+doCommand start = do
s <- start
case s of
Nothing -> return True
@@ -104,20 +104,20 @@ isAnnexed file a = do
{- These functions find appropriate files or other things based on a
user's parameters, and run a specified action on them. -}
-withFilesInGit :: SubCmdSeekStrings
+withFilesInGit :: CommandSeekStrings
withFilesInGit a params = do
repo <- Annex.gitRepo
files <- liftIO $ Git.inRepo repo params
files' <- filterFiles files
return $ map a files'
-withAttrFilesInGit :: String -> SubCmdSeekAttrFiles
+withAttrFilesInGit :: String -> CommandSeekAttrFiles
withAttrFilesInGit attr a params = do
repo <- Annex.gitRepo
files <- liftIO $ Git.inRepo repo params
files' <- filterFiles files
pairs <- liftIO $ Git.checkAttr repo attr files'
return $ map a pairs
-withFilesMissing :: SubCmdSeekStrings
+withFilesMissing :: CommandSeekStrings
withFilesMissing a params = do
files <- liftIO $ filterM missing params
files' <- filterFiles files
@@ -126,27 +126,27 @@ withFilesMissing a params = do
missing f = do
e <- doesFileExist f
return $ not e
-withFilesNotInGit :: SubCmdSeekBackendFiles
+withFilesNotInGit :: CommandSeekBackendFiles
withFilesNotInGit a params = do
repo <- Annex.gitRepo
newfiles <- liftIO $ Git.notInRepo repo params
newfiles' <- filterFiles newfiles
backendPairs a newfiles'
-withString :: SubCmdSeekStrings
+withString :: CommandSeekStrings
withString a params = return [a $ unwords params]
-withStrings :: SubCmdSeekStrings
+withStrings :: CommandSeekStrings
withStrings a params = return $ map a params
-withFilesToBeCommitted :: SubCmdSeekStrings
+withFilesToBeCommitted :: CommandSeekStrings
withFilesToBeCommitted a params = do
repo <- Annex.gitRepo
tocommit <- liftIO $ Git.stagedFiles repo params
tocommit' <- filterFiles tocommit
return $ map a tocommit'
-withFilesUnlocked :: SubCmdSeekBackendFiles
+withFilesUnlocked :: CommandSeekBackendFiles
withFilesUnlocked = withFilesUnlocked' Git.typeChangedFiles
-withFilesUnlockedToBeCommitted :: SubCmdSeekBackendFiles
+withFilesUnlockedToBeCommitted :: CommandSeekBackendFiles
withFilesUnlockedToBeCommitted = withFilesUnlocked' Git.typeChangedStagedFiles
-withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> SubCmdSeekBackendFiles
+withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> CommandSeekBackendFiles
withFilesUnlocked' typechanged a params = do
-- unlocked files have changed type from a symlink to a regular file
repo <- Annex.gitRepo
@@ -155,29 +155,29 @@ withFilesUnlocked' typechanged a params = do
map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles
unlockedfiles' <- filterFiles unlockedfiles
backendPairs a unlockedfiles'
-withKeys :: SubCmdSeekStrings
+withKeys :: CommandSeekStrings
withKeys a params = return $ map a params
-withTempFile :: SubCmdSeekStrings
+withTempFile :: CommandSeekStrings
withTempFile a params = return $ map a params
-withNothing :: SubCmdSeekNothing
+withNothing :: CommandSeekNothing
withNothing a [] = return [a]
withNothing _ _ = return []
-backendPairs :: SubCmdSeekBackendFiles
+backendPairs :: CommandSeekBackendFiles
backendPairs a files = do
pairs <- Backend.chooseBackends files
return $ map a pairs
{- Default to acting on all files matching the seek action if
- none are specified. -}
-withAll :: (a -> SubCmdSeek) -> a -> SubCmdSeek
+withAll :: (a -> CommandSeek) -> a -> CommandSeek
withAll w a [] = do
g <- Annex.gitRepo
w a [Git.workTree g]
withAll w a p = w a p
{- Provides a default parameter to act on if none is specified. -}
-withDefault :: String-> (a -> SubCmdSeek) -> (a -> SubCmdSeek)
+withDefault :: String-> (a -> CommandSeek) -> (a -> CommandSeek)
withDefault d w a [] = w a [d]
withDefault _ w a p = w a p
@@ -204,3 +204,19 @@ notSymlink :: FilePath -> IO Bool
notSymlink f = do
s <- liftIO $ getSymbolicLinkStatus f
return $ not $ isSymbolicLink s
+
+{- descriptions of params used in usage message -}
+paramPath :: String
+paramPath = "PATH ..."
+paramMaybePath :: String
+paramMaybePath = "[PATH ...]"
+paramKey :: String
+paramKey = "KEY ..."
+paramDesc :: String
+paramDesc = "DESCRIPTION"
+paramNumber :: String
+paramNumber = "NUMBER ..."
+paramRemote :: String
+paramRemote = "REMOTE ..."
+paramNothing :: String
+paramNothing = ""
diff --git a/Command/Add.hs b/Command/Add.hs
index d141448a3..08a880206 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -18,14 +18,17 @@ import Types
import Core
import Messages
+command :: Command
+command = Command "add" paramPath seek "add files to annex"
+
{- Add acts on both files not checked into git yet, and unlocked files. -}
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withFilesNotInGit start, withFilesUnlocked start]
{- The add subcommand annexes a file, storing it in a backend, and then
- moving it into the annex directory and setting up the symlink pointing
- to its content. -}
-start :: SubCmdStartBackendFile
+start :: CommandStartBackendFile
start pair@(file, _) = notAnnexed file $ do
s <- liftIO $ getSymbolicLinkStatus file
if (isSymbolicLink s) || (not $ isRegularFile s)
@@ -34,14 +37,14 @@ start pair@(file, _) = notAnnexed file $ do
showStart "add" file
return $ Just $ perform pair
-perform :: BackendFile -> SubCmdPerform
+perform :: BackendFile -> CommandPerform
perform (file, backend) = do
stored <- Backend.storeFileKey file backend
case stored of
Nothing -> return Nothing
Just (key, _) -> return $ Just $ cleanup file key
-cleanup :: FilePath -> Key -> SubCmdCleanup
+cleanup :: FilePath -> Key -> CommandCleanup
cleanup file key = do
moveAnnex key file
logStatus key ValuePresent
diff --git a/Command/Copy.hs b/Command/Copy.hs
index aa55731d9..873df7ef2 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -11,5 +11,5 @@ import Command
import qualified Command.Move
-- A copy is just a move that does not delete the source file.
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withFilesInGit $ Command.Move.start False]
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 7c4fbea60..3f2740570 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -17,12 +17,12 @@ import Core
import Messages
import Utility
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withAttrFilesInGit "annex.numcopies" start]
{- Indicates a file's content is not wanted anymore, and should be removed
- if it's safe to do so. -}
-start :: SubCmdStartAttrFile
+start :: CommandStartAttrFile
start (file, attr) = isAnnexed file $ \(key, backend) -> do
inbackend <- Backend.hasKey key
if not inbackend
@@ -33,14 +33,14 @@ start (file, attr) = isAnnexed file $ \(key, backend) -> do
where
numcopies = readMaybe attr :: Maybe Int
-perform :: Key -> Backend -> Maybe Int -> SubCmdPerform
+perform :: Key -> Backend -> Maybe Int -> CommandPerform
perform key backend numcopies = do
success <- Backend.removeKey backend key numcopies
if success
then return $ Just $ cleanup key
else return Nothing
-cleanup :: Key -> SubCmdCleanup
+cleanup :: Key -> CommandCleanup
cleanup key = do
inannex <- inAnnex key
when inannex $ removeAnnex key
diff --git a/Command/DropKey.hs b/Command/DropKey.hs
index aa72e1bbd..870e9a7ab 100644
--- a/Command/DropKey.hs
+++ b/Command/DropKey.hs
@@ -15,11 +15,11 @@ import Types
import Core
import Messages
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withKeys start]
{- Drops cached content for a key. -}
-start :: SubCmdStartString
+start :: CommandStartString
start keyname = do
backends <- Backend.list
let key = genKey (head backends) keyname
@@ -33,12 +33,12 @@ start keyname = do
showStart "dropkey" keyname
return $ Just $ perform key
-perform :: Key -> SubCmdPerform
+perform :: Key -> CommandPerform
perform key = do
removeAnnex key
return $ Just $ cleanup key
-cleanup :: Key -> SubCmdCleanup
+cleanup :: Key -> CommandCleanup
cleanup key = do
logStatus key ValueMissing
return True
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index 016a9faa7..9984e49f3 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -18,11 +18,11 @@ import qualified Annex
import qualified Command.Drop
import Backend
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withStrings start]
{- Drops unused content by number. -}
-start :: SubCmdStartString
+start :: CommandStartString
start s = do
m <- readUnusedLog
case M.lookup s m of
diff --git a/Command/Find.hs b/Command/Find.hs
index 7b3c8c463..9927b692d 100644
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -13,11 +13,11 @@ import Control.Monad.State (liftIO)
import Command
import Core
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withDefault "." withFilesInGit start]
{- Output a list of files. -}
-start :: SubCmdStartString
+start :: CommandStartString
start file = isAnnexed file $ \(key, _) -> do
exists <- inAnnex key
when exists $ liftIO $ putStrLn file
diff --git a/Command/Fix.hs b/Command/Fix.hs
index 33630031f..accdadd31 100644
--- a/Command/Fix.hs
+++ b/Command/Fix.hs
@@ -17,11 +17,11 @@ import Utility
import Core
import Messages
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withFilesInGit start]
{- Fixes the symlink to an annexed file. -}
-start :: SubCmdStartString
+start :: CommandStartString
start file = isAnnexed file $ \(key, _) -> do
link <- calcGitLink file key
l <- liftIO $ readSymbolicLink file
@@ -31,14 +31,14 @@ start file = isAnnexed file $ \(key, _) -> do
showStart "fix" file
return $ Just $ perform file link
-perform :: FilePath -> FilePath -> SubCmdPerform
+perform :: FilePath -> FilePath -> CommandPerform
perform file link = do
liftIO $ createDirectoryIfMissing True (parentDir file)
liftIO $ removeFile file
liftIO $ createSymbolicLink link file
return $ Just $ cleanup file
-cleanup :: FilePath -> SubCmdCleanup
+cleanup :: FilePath -> CommandCleanup
cleanup file = do
Annex.queue "add" ["--"] file
return True
diff --git a/Command/FromKey.hs b/Command/FromKey.hs
index eb9ad5e51..991428136 100644
--- a/Command/FromKey.hs
+++ b/Command/FromKey.hs
@@ -20,11 +20,11 @@ import Types
import Core
import Messages
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withFilesMissing start]
{- Adds a file pointing at a manually-specified key -}
-start :: SubCmdStartString
+start :: CommandStartString
start file = do
keyname <- Annex.flagGet "key"
when (null keyname) $ error "please specify the key with --key"
@@ -36,13 +36,13 @@ start file = do
"key ("++keyname++") is not present in backend"
showStart "fromkey" file
return $ Just $ perform file key
-perform :: FilePath -> Key -> SubCmdPerform
+perform :: FilePath -> Key -> CommandPerform
perform file key = do
link <- calcGitLink file key
liftIO $ createDirectoryIfMissing True (parentDir file)
liftIO $ createSymbolicLink link file
return $ Just $ cleanup file
-cleanup :: FilePath -> SubCmdCleanup
+cleanup :: FilePath -> CommandCleanup
cleanup file = do
Annex.queue "add" ["--"] file
return True
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 9acecfce6..034bdc388 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -13,18 +13,18 @@ import Types
import Messages
import Utility
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withAll (withAttrFilesInGit "annex.numcopies") start]
{- Checks a file's backend data for problems. -}
-start :: SubCmdStartAttrFile
+start :: CommandStartAttrFile
start (file, attr) = isAnnexed file $ \(key, backend) -> do
showStart "fsck" file
return $ Just $ perform key backend numcopies
where
numcopies = readMaybe attr :: Maybe Int
-perform :: Key -> Backend -> Maybe Int -> SubCmdPerform
+perform :: Key -> Backend -> Maybe Int -> CommandPerform
perform key backend numcopies = do
success <- Backend.fsckKey backend key numcopies
if success
diff --git a/Command/Get.hs b/Command/Get.hs
index 628ed6293..214b689b8 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -13,11 +13,11 @@ import Types
import Core
import Messages
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withFilesInGit start]
{- Gets an annexed file from one of the backends. -}
-start :: SubCmdStartString
+start :: CommandStartString
start file = isAnnexed file $ \(key, backend) -> do
inannex <- inAnnex key
if inannex
@@ -26,7 +26,7 @@ start file = isAnnexed file $ \(key, backend) -> do
showStart "get" file
return $ Just $ perform key backend
-perform :: Key -> Backend -> SubCmdPerform
+perform :: Key -> Backend -> CommandPerform
perform key backend = do
ok <- getViaTmp key (Backend.retrieveKeyFile backend key)
if ok
diff --git a/Command/Init.hs b/Command/Init.hs
index e19849ba3..806c34c98 100644
--- a/Command/Init.hs
+++ b/Command/Init.hs
@@ -20,18 +20,18 @@ import Messages
import Locations
import Types
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withString start]
{- Stores description for the repository etc. -}
-start :: SubCmdStartString
+start :: CommandStartString
start description = do
when (null description) $
error "please specify a description of this repository\n"
showStart "init" description
return $ Just $ perform description
-perform :: String -> SubCmdPerform
+perform :: String -> CommandPerform
perform description = do
g <- Annex.gitRepo
u <- getUUID g
@@ -41,7 +41,7 @@ perform description = do
gitPreCommitHookWrite g
return $ Just cleanup
-cleanup :: SubCmdCleanup
+cleanup :: CommandCleanup
cleanup = do
g <- Annex.gitRepo
logfile <- uuidLog
diff --git a/Command/Lock.hs b/Command/Lock.hs
index 27a030bc2..381162536 100644
--- a/Command/Lock.hs
+++ b/Command/Lock.hs
@@ -15,16 +15,16 @@ import Messages
import qualified Annex
import qualified GitRepo as Git
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withFilesUnlocked start]
{- Undo unlock -}
-start :: SubCmdStartBackendFile
+start :: CommandStartBackendFile
start (file, _) = do
showStart "lock" file
return $ Just $ perform file
-perform :: FilePath -> SubCmdPerform
+perform :: FilePath -> CommandPerform
perform file = do
liftIO $ removeFile file
g <- Annex.gitRepo
diff --git a/Command/Move.hs b/Command/Move.hs
index eb223f5ab..8ba8dbfac 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -21,14 +21,14 @@ import qualified Remotes
import UUID
import Messages
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withFilesInGit $ start True]
{- Move (or copy) a file either --to or --from a repository.
-
- This only operates on the cached file content; it does not involve
- moving data in the key-value backend. -}
-start :: Bool -> SubCmdStartString
+start :: Bool -> CommandStartString
start move file = do
fromName <- Annex.flagGet "fromrepository"
toName <- Annex.flagGet "torepository"
@@ -61,7 +61,7 @@ remoteHasKey remote key present = do
- A file's content can be moved even if there are insufficient copies to
- allow it to be dropped.
-}
-toStart :: Bool -> SubCmdStartString
+toStart :: Bool -> CommandStartString
toStart move file = isAnnexed file $ \(key, _) -> do
ishere <- inAnnex key
if not ishere
@@ -69,7 +69,7 @@ toStart move file = isAnnexed file $ \(key, _) -> do
else do
showAction move file
return $ Just $ toPerform move key
-toPerform :: Bool -> Key -> SubCmdPerform
+toPerform :: Bool -> Key -> CommandPerform
toPerform move key = do
-- checking the remote is expensive, so not done in the start step
remote <- Remotes.commandLineRemote
@@ -86,7 +86,7 @@ toPerform move key = do
then return $ Just $ toCleanup move remote key tmpfile
else return Nothing -- failed
Right True -> return $ Just $ Command.Drop.cleanup key
-toCleanup :: Bool -> Git.Repo -> Key -> FilePath -> SubCmdCleanup
+toCleanup :: Bool -> Git.Repo -> Key -> FilePath -> CommandCleanup
toCleanup move remote key tmpfile = do
-- Tell remote to use the transferred content.
ok <- Remotes.runCmd remote "git-annex" ["setkey", "--quiet",
@@ -107,7 +107,7 @@ toCleanup move remote key tmpfile = do
- If the current repository already has the content, it is still removed
- from the other repository when moving.
-}
-fromStart :: Bool -> SubCmdStartString
+fromStart :: Bool -> CommandStartString
fromStart move file = isAnnexed file $ \(key, _) -> do
remote <- Remotes.commandLineRemote
(trusted, untrusted, _) <- Remotes.keyPossibilities key
@@ -116,7 +116,7 @@ fromStart move file = isAnnexed file $ \(key, _) -> do
else do
showAction move file
return $ Just $ fromPerform move key
-fromPerform :: Bool -> Key -> SubCmdPerform
+fromPerform :: Bool -> Key -> CommandPerform
fromPerform move key = do
remote <- Remotes.commandLineRemote
ishere <- inAnnex key
@@ -128,7 +128,7 @@ fromPerform move key = do
if ok
then return $ Just $ fromCleanup move remote key
else return Nothing -- fail
-fromCleanup :: Bool -> Git.Repo -> Key -> SubCmdCleanup
+fromCleanup :: Bool -> Git.Repo -> Key -> CommandCleanup
fromCleanup True remote key = do
ok <- Remotes.runCmd remote "git-annex"
["dropkey", "--quiet", "--force",
diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs
index 513d5d43f..8d488514a 100644
--- a/Command/PreCommit.hs
+++ b/Command/PreCommit.hs
@@ -17,21 +17,21 @@ import qualified Command.Fix
{- The pre-commit hook needs to fix symlinks to all files being committed.
- And, it needs to inject unlocked files into the annex. -}
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withFilesToBeCommitted Command.Fix.start,
withFilesUnlockedToBeCommitted start]
-start :: SubCmdStartBackendFile
+start :: CommandStartBackendFile
start pair = return $ Just $ perform pair
-perform :: BackendFile -> SubCmdPerform
+perform :: BackendFile -> CommandPerform
perform pair@(file, _) = do
- ok <- doSubCmd $ Command.Add.start pair
+ ok <- doCommand $ Command.Add.start pair
if ok
then return $ Just $ cleanup file
else error $ "failed to add " ++ file ++ "; canceling commit"
-cleanup :: FilePath -> SubCmdCleanup
+cleanup :: FilePath -> CommandCleanup
cleanup file = do
-- git commit will have staged the file's content;
-- drop that and run command queued by Add.state to
diff --git a/Command/SetKey.hs b/Command/SetKey.hs
index 55472ccae..4c82de3a5 100644
--- a/Command/SetKey.hs
+++ b/Command/SetKey.hs
@@ -19,11 +19,11 @@ import Types
import Core
import Messages
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withTempFile start]
{- Sets cached content for a key. -}
-start :: SubCmdStartString
+start :: CommandStartString
start file = do
keyname <- Annex.flagGet "key"
when (null keyname) $ error "please specify the key with --key"
@@ -31,7 +31,7 @@ start file = do
let key = genKey (head backends) keyname
showStart "setkey" file
return $ Just $ perform file key
-perform :: FilePath -> Key -> SubCmdPerform
+perform :: FilePath -> Key -> CommandPerform
perform file key = do
-- the file might be on a different filesystem, so mv is used
-- rather than simply calling moveToObjectDir key file
@@ -43,7 +43,7 @@ perform file key = do
then return $ Just $ cleanup key
else error "mv failed!"
-cleanup :: Key -> SubCmdCleanup
+cleanup :: Key -> CommandCleanup
cleanup key = do
logStatus key ValuePresent
return True
diff --git a/Command/Trust.hs b/Command/Trust.hs
index 8060ee66f..3c3ec3b7e 100644
--- a/Command/Trust.hs
+++ b/Command/Trust.hs
@@ -17,17 +17,17 @@ import qualified Remotes
import UUID
import Messages
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withString start]
{- Marks a remote as trusted. -}
-start :: SubCmdStartString
+start :: CommandStartString
start name = do
r <- Remotes.byName name
showStart "trust" name
return $ Just $ perform r
-perform :: Git.Repo -> SubCmdPerform
+perform :: Git.Repo -> CommandPerform
perform repo = do
uuid <- getUUID repo
trusted <- getTrusted
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index 9580fc5e7..42354b8c4 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -20,16 +20,16 @@ import Core
import qualified GitRepo as Git
import Messages
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withFilesInGit start]
{- The unannex subcommand undoes an add. -}
-start :: SubCmdStartString
+start :: CommandStartString
start file = isAnnexed file $ \(key, backend) -> do
showStart "unannex" file
return $ Just $ perform file key backend
-perform :: FilePath -> Key -> Backend -> SubCmdPerform
+perform :: FilePath -> Key -> Backend -> CommandPerform
perform file key backend = do
-- force backend to always remove
ok <- Backend.removeKey backend key (Just 0)
@@ -37,7 +37,7 @@ perform file key backend = do
then return $ Just $ cleanup file key
else return Nothing
-cleanup :: FilePath -> Key -> SubCmdCleanup
+cleanup :: FilePath -> Key -> CommandCleanup
cleanup file key = do
g <- Annex.gitRepo
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index fcb77a92b..6001c55cd 100644
--- a/Command/Uninit.hs
+++ b/Command/Uninit.hs
@@ -20,15 +20,15 @@ import qualified Annex
import qualified Command.Unannex
import qualified Command.Init
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withAll withFilesInGit Command.Unannex.start, withNothing start]
-start :: SubCmdStartNothing
+start :: CommandStartNothing
start = do
showStart "uninit" ""
return $ Just $ perform
-perform :: SubCmdPerform
+perform :: CommandPerform
perform = do
g <- Annex.gitRepo
diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index ff22fa84b..21f34d1db 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -18,17 +18,17 @@ import Locations
import Core
import CopyFile
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withFilesInGit start]
{- The unlock subcommand replaces the symlink with a copy of the file's
- content. -}
-start :: SubCmdStartString
+start :: CommandStartString
start file = isAnnexed file $ \(key, _) -> do
showStart "unlock" file
return $ Just $ perform file key
-perform :: FilePath -> Key -> SubCmdPerform
+perform :: FilePath -> Key -> CommandPerform
perform dest key = do
g <- Annex.gitRepo
let src = annexLocation g key
diff --git a/Command/Untrust.hs b/Command/Untrust.hs
index 5ed8de245..6458040b3 100644
--- a/Command/Untrust.hs
+++ b/Command/Untrust.hs
@@ -17,17 +17,17 @@ import qualified Remotes
import UUID
import Messages
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withString start]
{- Marks a remote as not trusted. -}
-start :: SubCmdStartString
+start :: CommandStartString
start name = do
r <- Remotes.byName name
showStart "untrust" name
return $ Just $ perform r
-perform :: Git.Repo -> SubCmdPerform
+perform :: Git.Repo -> CommandPerform
perform repo = do
uuid <- getUUID repo
trusted <- getTrusted
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 69a16f254..dba9aa517 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -17,16 +17,16 @@ import Messages
import Locations
import qualified Annex
-seek :: [SubCmdSeek]
+seek :: [CommandSeek]
seek = [withNothing start]
{- Finds unused content in the annex. -}
-start :: SubCmdStartNothing
+start :: CommandStartNothing
start = do
showStart "unused" ""
return $ Just perform
-perform :: SubCmdPerform
+perform :: CommandPerform
perform = do
_ <- checkUnused
return $ Just $ return True
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 10:42:34 +0000