summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
Diffstat (limited to 'Command')
-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
21 files changed, 77 insertions, 74 deletions
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-10-31 05:56:51 +0000