summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-11-02 19:04:24 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-11-02 19:04:24 -0400
commit0eae5b806c76b0fa3e21fbae6e5f2d9a39a04cce (patch)
tree53aada39ec10bc6217507bce1a9add3b86b3793b
parent606ed6bb3566fa86c1783e3f1c7d799a6f1be8d1 (diff)
broke subcommands out into separate modules
-rw-r--r--CmdLine.hs201
-rw-r--r--Command.hs50
-rw-r--r--Command/Add.hs52
-rw-r--r--Command/Drop.hs50
-rw-r--r--Command/DropKey.hs47
-rw-r--r--Command/Fix.hs40
-rw-r--r--Command/FromKey.hs44
-rw-r--r--Command/Get.hs31
-rw-r--r--Command/Init.hs42
-rw-r--r--Command/Move.hs131
-rw-r--r--Command/SetKey.hs43
-rw-r--r--Command/Unannex.hs48
-rw-r--r--Commands.hs555
-rw-r--r--git-annex.hs2
14 files changed, 780 insertions, 556 deletions
diff --git a/CmdLine.hs b/CmdLine.hs
new file mode 100644
index 000000000..494da2873
--- /dev/null
+++ b/CmdLine.hs
@@ -0,0 +1,201 @@
+{- git-annex command line
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module CmdLine (parseCmd) where
+
+import System.Console.GetOpt
+import Control.Monad.State (liftIO)
+import System.Directory
+import Data.String.Utils
+import Control.Monad (filterM)
+import Monad (when)
+
+import qualified GitRepo as Git
+import qualified Annex
+import Locations
+import qualified Backend
+import Types
+import Core
+
+import Command
+import qualified Command.Add
+import qualified Command.Unannex
+import qualified Command.Drop
+import qualified Command.Move
+import qualified Command.Get
+import qualified Command.FromKey
+import qualified Command.DropKey
+import qualified Command.SetKey
+import qualified Command.Fix
+import qualified Command.Init
+
+data SubCommand = SubCommand {
+ subcmdname :: String,
+ subcmdparams :: String,
+ subcmdseek :: SubCmdSeek,
+ subcmddesc :: String
+}
+subCmds :: [SubCommand]
+subCmds = [
+ (SubCommand "add" path (withFilesNotInGit Command.Add.start)
+ "add files to annex")
+ , (SubCommand "get" path (withFilesInGit Command.Get.start)
+ "make content of annexed files available")
+ , (SubCommand "drop" path (withFilesInGit Command.Drop.start)
+ "indicate content of files not currently wanted")
+ , (SubCommand "move" path (withFilesInGit Command.Move.start)
+ "transfer content of files to/from another repository")
+ , (SubCommand "init" desc (withDescription Command.Init.start)
+ "initialize git-annex with repository description")
+ , (SubCommand "unannex" path (withFilesInGit Command.Unannex.start)
+ "undo accidential add command")
+ , (SubCommand "fix" path (withFilesInGit Command.Fix.start)
+ "fix up symlinks to point to annexed content")
+ , (SubCommand "pre-commit" path (withFilesToBeCommitted Command.Fix.start)
+ "fix up symlinks before they are committed")
+ , (SubCommand "fromkey" key (withFilesMissing Command.FromKey.start)
+ "adds a file using a specific key")
+ , (SubCommand "dropkey" key (withKeys Command.DropKey.start)
+ "drops annexed content for specified keys")
+ , (SubCommand "setkey" key (withTempFile Command.SetKey.start)
+ "sets annexed content for a key using a temp file")
+ ]
+ where
+ path = "PATH ..."
+ key = "KEY ..."
+ desc = "DESCRIPTION"
+
+-- Each dashed command-line option results in generation of an action
+-- in the Annex monad that performs the necessary setting.
+options :: [OptDescr (Annex ())]
+options = [
+ Option ['f'] ["force"] (NoArg (storebool "force" True))
+ "allow actions that may lose annexed data"
+ , Option ['q'] ["quiet"] (NoArg (storebool "quiet" True))
+ "avoid verbose output"
+ , Option ['v'] ["verbose"] (NoArg (storebool "quiet" False))
+ "allow verbose output"
+ , Option ['b'] ["backend"] (ReqArg (storestring "backend") "NAME")
+ "specify default key-value backend to use"
+ , Option ['k'] ["key"] (ReqArg (storestring "key") "KEY")
+ "specify a key to use"
+ , Option ['t'] ["to"] (ReqArg (storestring "torepository") "REPOSITORY")
+ "specify to where to transfer content"
+ , Option ['f'] ["from"] (ReqArg (storestring "fromrepository") "REPOSITORY")
+ "specify from where to transfer content"
+ ]
+ where
+ storebool n b = Annex.flagChange n $ FlagBool b
+ storestring n s = Annex.flagChange n $ FlagString s
+
+header :: String
+header = "Usage: git-annex " ++ (join "|" $ map subcmdname subCmds)
+
+{- Usage message with lists of options and subcommands. -}
+usage :: String
+usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs
+ where
+ cmddescs = unlines $ map (\c -> indent $ showcmd c) subCmds
+ showcmd c =
+ (subcmdname c) ++
+ (pad 11 (subcmdname c)) ++
+ (subcmdparams c) ++
+ (pad 13 (subcmdparams c)) ++
+ (subcmddesc c)
+ indent l = " " ++ l
+ pad n s = take (n - (length s)) $ repeat ' '
+
+{- Prepares a list of actions to run to perform a subcommand, based on
+ - the parameters passed to it. -}
+prepSubCmd :: SubCommand -> AnnexState -> [String] -> IO [Annex Bool]
+prepSubCmd SubCommand { subcmdseek = seek } state params = do
+ list <- Annex.eval state $ seek params
+ return $ map (\a -> doSubCmd a) list
+
+{- Runs a subcommand through the start, perform and cleanup stages -}
+doSubCmd :: SubCmdStart -> SubCmdCleanup
+doSubCmd start = do
+ s <- start
+ case (s) of
+ Nothing -> return True
+ Just perform -> do
+ p <- perform
+ case (p) of
+ Nothing -> do
+ showEndFail
+ return False
+ Just cleanup -> do
+ c <- cleanup
+ if (c)
+ then do
+ showEndOk
+ return True
+ else do
+ showEndFail
+ return False
+
+{- These functions find appropriate files or other things based on a
+ user's parameters. -}
+withFilesNotInGit :: SubCmdSeekBackendFiles
+withFilesNotInGit a params = do
+ repo <- Annex.gitRepo
+ files <- liftIO $ mapM (Git.notInRepo repo) params
+ let files' = foldl (++) [] files
+ pairs <- Backend.chooseBackends files'
+ return $ map a $ filter (\(f,_) -> notState f) pairs
+withFilesInGit :: SubCmdSeekStrings
+withFilesInGit a params = do
+ repo <- Annex.gitRepo
+ files <- liftIO $ mapM (Git.inRepo repo) params
+ return $ map a $ filter notState $ foldl (++) [] files
+withFilesMissing :: SubCmdSeekStrings
+withFilesMissing a params = do
+ files <- liftIO $ filterM missing params
+ return $ map a $ filter notState files
+ where
+ missing f = do
+ e <- doesFileExist f
+ return $ not e
+withDescription :: SubCmdSeekStrings
+withDescription a params = do
+ return $ [a $ unwords params]
+withFilesToBeCommitted :: SubCmdSeekStrings
+withFilesToBeCommitted a params = do
+ repo <- Annex.gitRepo
+ files <- liftIO $ mapM (Git.stagedFiles repo) params
+ return $ map a $ filter notState $ foldl (++) [] files
+withKeys :: SubCmdSeekStrings
+withKeys a params = return $ map a params
+withTempFile :: SubCmdSeekStrings
+withTempFile a params = return $ map a params
+
+{- filter out files from the state directory -}
+notState :: FilePath -> Bool
+notState f = stateLoc /= take (length stateLoc) f
+
+{- Parses command line and returns two lists of actions to be
+ - run in the Annex monad. The first actions configure it
+ - according to command line options, while the second actions
+ - handle subcommands. -}
+parseCmd :: [String] -> AnnexState -> IO ([Annex Bool], [Annex Bool])
+parseCmd argv state = do
+ (flags, params) <- getopt
+ when (null params) $ error usage
+ case lookupCmd (params !! 0) of
+ [] -> error usage
+ [subcommand] -> do
+ actions <- prepSubCmd subcommand state (drop 1 params)
+ let configactions = map (\flag -> do
+ flag
+ return True) flags
+ return (configactions, actions)
+ _ -> error "internal error: multiple matching subcommands"
+ 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
diff --git a/Command.hs b/Command.hs
new file mode 100644
index 000000000..3d1e75e5f
--- /dev/null
+++ b/Command.hs
@@ -0,0 +1,50 @@
+{- git-annex command types
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command where
+
+import Types
+import Backend
+
+{- A subcommand runs in four stages.
+ -
+ - 0. The seek stage takes the parameters passed to the subcommand,
+ - looks through the repo to find the ones that are relevant
+ - to that subcommand (ie, new files to add), and generates
+ - a list of start stage actions. -}
+type SubCmdSeek = [String] -> Annex [SubCmdStart]
+{- 1. The start stage is run before anything is printed about the
+ - subcommand, 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
+ - being run, and it should be where the bulk of the work happens. -}
+type SubCmdPerform = Annex (Maybe SubCmdCleanup)
+{- 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
+ - functions. -}
+type SubCmdSeekStrings = SubCmdStartString -> SubCmdSeek
+type SubCmdStartString = String -> SubCmdStart
+type SubCmdSeekBackendFiles = SubCmdStartBackendFile -> SubCmdSeek
+type SubCmdStartBackendFile = (FilePath, Maybe Backend) -> SubCmdStart
+
+notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
+notAnnexed file a = do
+ r <- Backend.lookupFile file
+ case (r) of
+ Just _ -> return Nothing
+ Nothing -> a
+
+isAnnexed :: FilePath -> ((Key, Backend) -> Annex (Maybe a)) -> Annex (Maybe a)
+isAnnexed file a = do
+ r <- Backend.lookupFile file
+ case (r) of
+ Just v -> a v
+ Nothing -> return Nothing
diff --git a/Command/Add.hs b/Command/Add.hs
new file mode 100644
index 000000000..825c1d8c1
--- /dev/null
+++ b/Command/Add.hs
@@ -0,0 +1,52 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Add where
+
+import Control.Monad.State (liftIO)
+import System.Posix.Files
+import System.Directory
+
+import Command
+import qualified Annex
+import Utility
+import Locations
+import qualified Backend
+import LocationLog
+import Types
+import Core
+
+{- 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 pair@(file, _) = notAnnexed file $ do
+ s <- liftIO $ getSymbolicLinkStatus file
+ if ((isSymbolicLink s) || (not $ isRegularFile s))
+ then return Nothing
+ else do
+ showStart "add" file
+ return $ Just $ perform pair
+
+perform :: (FilePath, Maybe Backend) -> SubCmdPerform
+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 file key = do
+ logStatus key ValuePresent
+ g <- Annex.gitRepo
+ let dest = annexLocation g key
+ liftIO $ createDirectoryIfMissing True (parentDir dest)
+ liftIO $ renameFile file dest
+ link <- calcGitLink file key
+ liftIO $ createSymbolicLink link file
+ Annex.queue "add" [] file
+ return True
diff --git a/Command/Drop.hs b/Command/Drop.hs
new file mode 100644
index 000000000..6cdf216f4
--- /dev/null
+++ b/Command/Drop.hs
@@ -0,0 +1,50 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Drop where
+
+import Control.Monad.State (liftIO)
+import System.Directory
+
+import Command
+import qualified Annex
+import Locations
+import qualified Backend
+import LocationLog
+import Types
+import Core
+
+{- Indicates a file's content is not wanted anymore, and should be removed
+ - if it's safe to do so. -}
+start :: SubCmdStartString
+start file = isAnnexed file $ \(key, backend) -> do
+ inbackend <- Backend.hasKey key
+ if (not inbackend)
+ then return Nothing
+ else do
+ showStart "drop" file
+ return $ Just $ perform key backend
+
+perform :: Key -> Backend -> SubCmdPerform
+perform key backend = do
+ success <- Backend.removeKey backend key
+ if (success)
+ then return $ Just $ cleanup key
+ else return Nothing
+
+cleanup :: Key -> SubCmdCleanup
+cleanup key = do
+ logStatus key ValueMissing
+ inannex <- inAnnex key
+ if (inannex)
+ then do
+ g <- Annex.gitRepo
+ let loc = annexLocation g key
+ liftIO $ removeFile loc
+ return True
+ else return True
+
diff --git a/Command/DropKey.hs b/Command/DropKey.hs
new file mode 100644
index 000000000..bdd9b55b1
--- /dev/null
+++ b/Command/DropKey.hs
@@ -0,0 +1,47 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.DropKey where
+
+import Control.Monad.State (liftIO)
+import System.Directory
+
+import Command
+import qualified Annex
+import Locations
+import qualified Backend
+import LocationLog
+import Types
+import Core
+
+{- Drops cached content for a key. -}
+start :: SubCmdStartString
+start keyname = do
+ backends <- Backend.list
+ let key = genKey (backends !! 0) keyname
+ present <- inAnnex key
+ force <- Annex.flagIsSet "force"
+ if (not present)
+ then return Nothing
+ else if (not force)
+ then error "dropkey is can cause data loss; use --force if you're sure you want to do this"
+ else do
+ showStart "dropkey" keyname
+ return $ Just $ perform key
+
+perform :: Key -> SubCmdPerform
+perform key = do
+ g <- Annex.gitRepo
+ let loc = annexLocation g key
+ liftIO $ removeFile loc
+ return $ Just $ cleanup key
+
+cleanup :: Key -> SubCmdCleanup
+cleanup key = do
+ logStatus key ValueMissing
+ return True
+
diff --git a/Command/Fix.hs b/Command/Fix.hs
new file mode 100644
index 000000000..90257a8a5
--- /dev/null
+++ b/Command/Fix.hs
@@ -0,0 +1,40 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Fix where
+
+import Control.Monad.State (liftIO)
+import System.Posix.Files
+import System.Directory
+
+import Command
+import qualified Annex
+import Utility
+import Core
+
+{- Fixes the symlink to an annexed file. -}
+start :: SubCmdStartString
+start file = isAnnexed file $ \(key, _) -> do
+ link <- calcGitLink file key
+ l <- liftIO $ readSymbolicLink file
+ if (link == l)
+ then return Nothing
+ else do
+ showStart "fix" file
+ return $ Just $ perform file link
+
+perform :: FilePath -> FilePath -> SubCmdPerform
+perform file link = do
+ liftIO $ createDirectoryIfMissing True (parentDir file)
+ liftIO $ removeFile file
+ liftIO $ createSymbolicLink link file
+ return $ Just $ cleanup file
+
+cleanup :: FilePath -> SubCmdCleanup
+cleanup file = do
+ Annex.queue "add" [] file
+ return True
diff --git a/Command/FromKey.hs b/Command/FromKey.hs
new file mode 100644
index 000000000..3071f218f
--- /dev/null
+++ b/Command/FromKey.hs
@@ -0,0 +1,44 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.FromKey where
+
+import Control.Monad.State (liftIO)
+import System.Posix.Files
+import System.Directory
+import Control.Monad (when, unless)
+
+import Command
+import qualified Annex
+import Utility
+import qualified Backend
+import Types
+import Core
+
+{- Adds a file pointing at a manually-specified key -}
+start :: SubCmdStartString
+start file = do
+ keyname <- Annex.flagGet "key"
+ when (null keyname) $ error "please specify the key with --key"
+ backends <- Backend.list
+ let key = genKey (backends !! 0) keyname
+
+ inbackend <- Backend.hasKey key
+ unless (inbackend) $ error $
+ "key ("++keyname++") is not present in backend"
+ showStart "fromkey" file
+ return $ Just $ perform file key
+perform :: FilePath -> Key -> SubCmdPerform
+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 file = do
+ Annex.queue "add" [] file
+ return True
diff --git a/Command/Get.hs b/Command/Get.hs
new file mode 100644
index 000000000..1433bc8d0
--- /dev/null
+++ b/Command/Get.hs
@@ -0,0 +1,31 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Get where
+
+import Command
+import qualified Backend
+import Types
+import Core
+
+{- Gets an annexed file from one of the backends. -}
+start :: SubCmdStartString
+start file = isAnnexed file $ \(key, backend) -> do
+ inannex <- inAnnex key
+ if (inannex)
+ then return Nothing
+ else do
+ showStart "get" file
+ return $ Just $ perform key backend
+
+perform :: Key -> Backend -> SubCmdPerform
+perform key backend = do
+ ok <- getViaTmp key (Backend.retrieveKeyFile backend key)
+ if (ok)
+ then return $ Just $ return True -- no cleanup needed
+ else return Nothing
+
diff --git a/Command/Init.hs b/Command/Init.hs
new file mode 100644
index 000000000..b1e4e0e06
--- /dev/null
+++ b/Command/Init.hs
@@ -0,0 +1,42 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Init where
+
+import Control.Monad.State (liftIO)
+import Control.Monad (when)
+
+import Command
+import qualified Annex
+import Core
+import qualified GitRepo as Git
+import UUID
+
+{- Stores description for the repository etc. -}
+start :: SubCmdStartString
+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 description = do
+ g <- Annex.gitRepo
+ u <- getUUID g
+ describeUUID u description
+ liftIO $ gitAttributes g
+ liftIO $ gitPreCommitHook g
+ return $ Just $ cleanup
+
+cleanup :: SubCmdCleanup
+cleanup = do
+ g <- Annex.gitRepo
+ logfile <- uuidLog
+ liftIO $ Git.run g ["add", logfile]
+ liftIO $ Git.run g ["commit", "-m", "git annex init", logfile]
+ return True
diff --git a/Command/Move.hs b/Command/Move.hs
new file mode 100644
index 000000000..cee941622
--- /dev/null
+++ b/Command/Move.hs
@@ -0,0 +1,131 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Move where
+
+import Control.Monad.State (liftIO)
+import Monad (when)
+
+import Command
+import Command.Drop
+import qualified Annex
+import Locations
+import LocationLog
+import Types
+import Core
+import qualified GitRepo as Git
+import qualified Remotes
+import UUID
+
+{- Move 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 :: SubCmdStartString
+start file = do
+ fromName <- Annex.flagGet "fromrepository"
+ toName <- Annex.flagGet "torepository"
+ case (fromName, toName) of
+ ("", "") -> error "specify either --from or --to"
+ ("", _) -> moveToStart file
+ (_ , "") -> moveFromStart file
+ (_ , _) -> error "only one of --from or --to can be specified"
+
+{- Moves the content of an annexed file to another repository,
+ - removing it from the current repository, and updates locationlog
+ - information on both.
+ -
+ - If the destination already has the content, it is still removed
+ - from the current repository.
+ -
+ - Note that unlike drop, this does not honor annex.numcopies.
+ - A file's content can be moved even if there are insufficient copies to
+ - allow it to be dropped.
+ -}
+moveToStart :: SubCmdStartString
+moveToStart file = isAnnexed file $ \(key, _) -> do
+ ishere <- inAnnex key
+ if (not ishere)
+ then return Nothing -- not here, so nothing to do
+ else do
+ showStart "move" file
+ return $ Just $ moveToPerform key
+moveToPerform :: Key -> SubCmdPerform
+moveToPerform key = do
+ -- checking the remote is expensive, so not done in the start step
+ remote <- Remotes.commandLineRemote
+ isthere <- Remotes.inAnnex remote key
+ case isthere of
+ Left err -> do
+ showNote $ show err
+ return Nothing
+ Right False -> do
+ Core.showNote $ "moving to " ++ (Git.repoDescribe remote) ++ "..."
+ let tmpfile = (annexTmpLocation remote) ++ (keyFile key)
+ ok <- Remotes.copyToRemote remote key tmpfile
+ if (ok)
+ then return $ Just $ moveToCleanup remote key tmpfile
+ else return Nothing -- failed
+ Right True -> return $ Just $ Command.Drop.cleanup key
+moveToCleanup :: Git.Repo -> Key -> FilePath -> SubCmdCleanup
+moveToCleanup remote key tmpfile = do
+ -- Tell remote to use the transferred content.
+ ok <- Remotes.runCmd remote "git-annex" ["setkey", "--quiet",
+ "--backend=" ++ (backendName key),
+ "--key=" ++ keyName key,
+ tmpfile]
+ if ok
+ then do
+ -- Record that the key is present on the remote.
+ g <- Annex.gitRepo
+ remoteuuid <- getUUID remote
+ logfile <- liftIO $ logChange g key remoteuuid ValuePresent
+ Annex.queue "add" [] logfile
+ -- Cleanup on the local side is the same as done for the
+ -- drop subcommand.
+ Command.Drop.cleanup key
+ else return False
+
+{- Moves the content of an annexed file from another repository to the current
+ - repository and updates locationlog information on both.
+ -
+ - If the current repository already has the content, it is still removed
+ - from the other repository.
+ -}
+moveFromStart :: SubCmdStartString
+moveFromStart file = isAnnexed file $ \(key, _) -> do
+ remote <- Remotes.commandLineRemote
+ l <- Remotes.keyPossibilities key
+ if (null $ filter (\r -> Remotes.same r remote) l)
+ then return Nothing
+ else do
+ showStart "move" file
+ return $ Just $ moveFromPerform key
+moveFromPerform :: Key -> SubCmdPerform
+moveFromPerform key = do
+ remote <- Remotes.commandLineRemote
+ ishere <- inAnnex key
+ if (ishere)
+ then return $ Just $ moveFromCleanup remote key
+ else do
+ Core.showNote $ "moving from " ++ (Git.repoDescribe remote) ++ "..."
+ ok <- getViaTmp key (Remotes.copyFromRemote remote key)
+ if (ok)
+ then return $ Just $ moveFromCleanup remote key
+ else return Nothing -- fail
+moveFromCleanup :: Git.Repo -> Key -> SubCmdCleanup
+moveFromCleanup remote key = do
+ ok <- Remotes.runCmd remote "git-annex" ["dropkey", "--quiet", "--force",
+ "--backend=" ++ (backendName key),
+ keyName key]
+ when ok $ do
+ -- Record locally that the key is not on the remote.
+ remoteuuid <- getUUID remote
+ g <- Annex.gitRepo
+ logfile <- liftIO $ logChange g key remoteuuid ValueMissing
+ Annex.queue "add" [] logfile
+ return ok
diff --git a/Command/SetKey.hs b/Command/SetKey.hs
new file mode 100644
index 000000000..a5710643e
--- /dev/null
+++ b/Command/SetKey.hs
@@ -0,0 +1,43 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.SetKey where
+
+import Control.Monad.State (liftIO)
+import Control.Monad (when)
+
+import Command
+import qualified Annex
+import Utility
+import Locations
+import qualified Backend
+import LocationLog
+import Types
+import Core
+
+{- Sets cached content for a key. -}
+start :: SubCmdStartString
+start tmpfile = do
+ keyname <- Annex.flagGet "key"
+ when (null keyname) $ error "please specify the key with --key"
+ backends <- Backend.list
+ let key = genKey (backends !! 0) keyname
+ showStart "setkey" tmpfile
+ return $ Just $ perform tmpfile key
+perform :: FilePath -> Key -> SubCmdPerform
+perform tmpfile key = do
+ g <- Annex.gitRepo
+ let loc = annexLocation g key
+ ok <- liftIO $ boolSystem "mv" [tmpfile, loc]
+ if (not ok)
+ then error "mv failed!"
+ else return $ Just $ cleanup key
+cleanup :: Key -> SubCmdCleanup
+cleanup key = do
+ logStatus key ValuePresent
+ return True
+
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
new file mode 100644
index 000000000..5cffb2d89
--- /dev/null
+++ b/Command/Unannex.hs
@@ -0,0 +1,48 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Unannex where
+
+import Control.Monad.State (liftIO)
+import System.Directory
+
+import Command
+import qualified Annex
+import Utility
+import Locations
+import qualified Backend
+import LocationLog
+import Types
+import Core
+import qualified GitRepo as Git
+
+{- The unannex subcommand undoes an add. -}
+start :: SubCmdStartString
+start file = isAnnexed file $ \(key, backend) -> do
+ showStart "unannex" file
+ return $ Just $ perform file key backend
+
+perform :: FilePath -> Key -> Backend -> SubCmdPerform
+perform file key backend = do
+ -- force backend to always remove
+ Annex.flagChange "force" $ FlagBool True
+ ok <- Backend.removeKey backend key
+ if (ok)
+ then return $ Just $ cleanup file key
+ else return Nothing
+
+cleanup :: FilePath -> Key -> SubCmdCleanup
+cleanup file key = do
+ logStatus key ValueMissing
+ g <- Annex.gitRepo
+ let src = annexLocation g key
+ liftIO $ removeFile file
+ liftIO $ Git.run g ["rm", "--quiet", file]
+ -- git rm deletes empty directories; put them back
+ liftIO $ createDirectoryIfMissing True (parentDir file)
+ liftIO $ renameFile src file
+ return True
diff --git a/Commands.hs b/Commands.hs
deleted file mode 100644
index 330b71ed2..000000000
--- a/Commands.hs
+++ /dev/null
@@ -1,555 +0,0 @@
-{- git-annex command line
- -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Commands (parseCmd) where
-
-import System.Console.GetOpt
-import Control.Monad.State (liftIO)
-import System.Posix.Files
-import System.Directory
-import Data.String.Utils
-import Control.Monad (filterM)
-import Monad (when, unless)
-
-import qualified GitRepo as Git
-import qualified Annex
-import Utility
-import Locations
-import qualified Backend
-import UUID
-import LocationLog
-import Types
-import Core
-import qualified Remotes
-
-{- A subcommand runs in four stages.
- -
- - 0. The seek stage takes the parameters passed to the subcommand,
- - looks through the repo to find the ones that are relevant
- - to that subcommand (ie, new files to add), and generates
- - a list of start stage actions. -}
-type SubCmdSeek = [String] -> Annex [SubCmdStart]
-{- 1. The start stage is run before anything is printed about the
- - subcommand, 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
- - being run, and it should be where the bulk of the work happens. -}
-type SubCmdPerform = Annex (Maybe SubCmdCleanup)
-{- 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
- - functions. -}
-type SubCmdSeekStrings = SubCmdStartString -> SubCmdSeek
-type SubCmdStartString = String -> SubCmdStart
-type SubCmdSeekBackendFiles = SubCmdStartBackendFile -> SubCmdSeek
-type SubCmdStartBackendFile = (FilePath, Maybe Backend) -> SubCmdStart
-
-data SubCommand = SubCommand {
- subcmdname :: String,
- subcmdparams :: String,
- subcmdseek :: SubCmdSeek,
- subcmddesc :: String
-}
-subCmds :: [SubCommand]
-subCmds = [
- (SubCommand "add" path (withFilesNotInGit addStart)
- "add files to annex")
- , (SubCommand "get" path (withFilesInGit getStart)
- "make content of annexed files available")
- , (SubCommand "drop" path (withFilesInGit dropStart)
- "indicate content of files not currently wanted")
- , (SubCommand "move" path (withFilesInGit moveStart)
- "transfer content of files to/from another repository")
- , (SubCommand "init" desc (withDescription initStart)
- "initialize git-annex with repository description")
- , (SubCommand "unannex" path (withFilesInGit unannexStart)
- "undo accidential add command")
- , (SubCommand "fix" path (withFilesInGit fixStart)
- "fix up symlinks to point to annexed content")
- , (SubCommand "pre-commit" path (withFilesToBeCommitted fixStart)
- "fix up symlinks before they are committed")
- , (SubCommand "fromkey" key (withFilesMissing fromKeyStart)
- "adds a file using a specific key")
- , (SubCommand "dropkey" key (withKeys dropKeyStart)
- "drops annexed content for specified keys")
- , (SubCommand "setkey" key (withTempFile setKeyStart)
- "sets annexed content for a key using a temp file")
- ]
- where
- path = "PATH ..."
- key = "KEY ..."
- desc = "DESCRIPTION"
-
--- Each dashed command-line option results in generation of an action
--- in the Annex monad that performs the necessary setting.
-options :: [OptDescr (Annex ())]
-options = [
- Option ['f'] ["force"] (NoArg (storebool "force" True))
- "allow actions that may lose annexed data"
- , Option ['q'] ["quiet"] (NoArg (storebool "quiet" True))
- "avoid verbose output"
- , Option ['v'] ["verbose"] (NoArg (storebool "quiet" False))
- "allow verbose output"
- , Option ['b'] ["backend"] (ReqArg (storestring "backend") "NAME")
- "specify default key-value backend to use"
- , Option ['k'] ["key"] (ReqArg (storestring "key") "KEY")
- "specify a key to use"
- , Option ['t'] ["to"] (ReqArg (storestring "torepository") "REPOSITORY")
- "specify to where to transfer content"
- , Option ['f'] ["from"] (ReqArg (storestring "fromrepository") "REPOSITORY")
- "specify from where to transfer content"
- ]
- where
- storebool n b = Annex.flagChange n $ FlagBool b
- storestring n s = Annex.flagChange n $ FlagString s
-
-header :: String
-header = "Usage: git-annex " ++ (join "|" $ map subcmdname subCmds)
-
-{- Usage message with lists of options and subcommands. -}
-usage :: String
-usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs
- where
- cmddescs = unlines $ map (\c -> indent $ showcmd c) subCmds
- showcmd c =
- (subcmdname c) ++
- (pad 11 (subcmdname c)) ++
- (subcmdparams c) ++
- (pad 13 (subcmdparams c)) ++
- (subcmddesc c)
- indent l = " " ++ l
- pad n s = take (n - (length s)) $ repeat ' '
-
-{- Prepares a list of actions to run to perform a subcommand, based on
- - the parameters passed to it. -}
-prepSubCmd :: SubCommand -> AnnexState -> [String] -> IO [Annex Bool]
-prepSubCmd SubCommand { subcmdseek = seek } state params = do
- list <- Annex.eval state $ seek params
- return $ map (\a -> doSubCmd a) list
-
-{- Runs a subcommand through the start, perform and cleanup stages -}
-doSubCmd :: SubCmdStart -> SubCmdCleanup
-doSubCmd start = do
- s <- start
- case (s) of
- Nothing -> return True
- Just perform -> do
- p <- perform
- case (p) of
- Nothing -> do
- showEndFail
- return False
- Just cleanup -> do
- c <- cleanup
- if (c)
- then do
- showEndOk
- return True
- else do
- showEndFail
- return False
-
-{- These functions find appropriate files or other things based on a
- user's parameters. -}
-withFilesNotInGit :: SubCmdSeekBackendFiles
-withFilesNotInGit a params = do
- repo <- Annex.gitRepo
- files <- liftIO $ mapM (Git.notInRepo repo) params
- let files' = foldl (++) [] files
- pairs <- Backend.chooseBackends files'
- return $ map a $ filter (\(f,_) -> notState f) pairs
-withFilesInGit :: SubCmdSeekStrings
-withFilesInGit a params = do
- repo <- Annex.gitRepo
- files <- liftIO $ mapM (Git.inRepo repo) params
- return $ map a $ filter notState $ foldl (++) [] files
-withFilesMissing :: SubCmdSeekStrings
-withFilesMissing a params = do
- files <- liftIO $ filterM missing params
- return $ map a $ filter notState files
- where
- missing f = do
- e <- doesFileExist f
- return $ not e
-withDescription :: SubCmdSeekStrings
-withDescription a params = do
- return $ [a $ unwords params]
-withFilesToBeCommitted :: SubCmdSeekStrings
-withFilesToBeCommitted a params = do
- repo <- Annex.gitRepo
- files <- liftIO $ mapM (Git.stagedFiles repo) params
- return $ map a $ filter notState $ foldl (++) [] files
-withKeys :: SubCmdSeekStrings
-withKeys a params = return $ map a params
-withTempFile :: SubCmdSeekStrings
-withTempFile a params = return $ map a params
-
-{- filter out files from the state directory -}
-notState :: FilePath -> Bool
-notState f = stateLoc /= take (length stateLoc) f
-
-{- Parses command line and returns two lists of actions to be
- - run in the Annex monad. The first actions configure it
- - according to command line options, while the second actions
- - handle subcommands. -}
-parseCmd :: [String] -> AnnexState -> IO ([Annex Bool], [Annex Bool])
-parseCmd argv state = do
- (flags, params) <- getopt
- when (null params) $ error usage
- case lookupCmd (params !! 0) of
- [] -> error usage
- [subcommand] -> do
- actions <- prepSubCmd subcommand state (drop 1 params)
- let configactions = map (\flag -> do
- flag
- return True) flags
- return (configactions, actions)
- _ -> error "internal error: multiple matching subcommands"
- 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
-
-{- 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. -}
-addStart :: SubCmdStartBackendFile
-addStart pair@(file, _) = notAnnexed file $ do
- s <- liftIO $ getSymbolicLinkStatus file
- if ((isSymbolicLink s) || (not $ isRegularFile s))
- then return Nothing
- else do
- showStart "add" file
- return $ Just $ addPerform pair
-addPerform :: (FilePath, Maybe Backend) -> SubCmdPerform
-addPerform (file, backend) = do
- stored <- Backend.storeFileKey file backend
- case (stored) of
- Nothing -> return Nothing
- Just (key, _) -> return $ Just $ addCleanup file key
-addCleanup :: FilePath -> Key -> SubCmdCleanup
-addCleanup file key = do
- logStatus key ValuePresent
- g <- Annex.gitRepo
- let dest = annexLocation g key
- liftIO $ createDirectoryIfMissing True (parentDir dest)
- liftIO $ renameFile file dest
- link <- calcGitLink file key
- liftIO $ createSymbolicLink link file
- Annex.queue "add" [] file
- return True
-
-{- The unannex subcommand undoes an add. -}
-unannexStart :: SubCmdStartString
-unannexStart file = isAnnexed file $ \(key, backend) -> do
- showStart "unannex" file
- return $ Just $ unannexPerform file key backend
-unannexPerform :: FilePath -> Key -> Backend -> SubCmdPerform
-unannexPerform file key backend = do
- -- force backend to always remove
- Annex.flagChange "force" $ FlagBool True
- ok <- Backend.removeKey backend key
- if (ok)
- then return $ Just $ unannexCleanup file key
- else return Nothing
-unannexCleanup :: FilePath -> Key -> SubCmdCleanup
-unannexCleanup file key = do
- logStatus key ValueMissing
- g <- Annex.gitRepo
- let src = annexLocation g key
- liftIO $ removeFile file
- liftIO $ Git.run g ["rm", "--quiet", file]
- -- git rm deletes empty directories; put them back
- liftIO $ createDirectoryIfMissing True (parentDir file)
- liftIO $ renameFile src file
- return True
-
-{- Gets an annexed file from one of the backends. -}
-getStart :: SubCmdStartString
-getStart file = isAnnexed file $ \(key, backend) -> do
- inannex <- inAnnex key
- if (inannex)
- then return Nothing
- else do
- showStart "get" file
- return $ Just $ getPerform key backend
-getPerform :: Key -> Backend -> SubCmdPerform
-getPerform key backend = do
- ok <- getViaTmp key (Backend.retrieveKeyFile backend key)
- if (ok)
- then return $ Just $ return True -- no cleanup needed
- else return Nothing
-
-{- Indicates a file's content is not wanted anymore, and should be removed
- - if it's safe to do so. -}
-dropStart :: SubCmdStartString
-dropStart file = isAnnexed file $ \(key, backend) -> do
- inbackend <- Backend.hasKey key
- if (not inbackend)
- then return Nothing
- else do
- showStart "drop" file
- return $ Just $ dropPerform key backend
-dropPerform :: Key -> Backend -> SubCmdPerform
-dropPerform key backend = do
- success <- Backend.removeKey backend key
- if (success)
- then return $ Just $ dropCleanup key
- else return Nothing
-dropCleanup :: Key -> SubCmdCleanup
-dropCleanup key = do
- logStatus key ValueMissing
- inannex <- inAnnex key
- if (inannex)
- then do
- g <- Annex.gitRepo
- let loc = annexLocation g key
- liftIO $ removeFile loc
- return True
- else return True
-
-{- Drops cached content for a key. -}
-dropKeyStart :: SubCmdStartString
-dropKeyStart keyname = do
- backends <- Backend.list
- let key = genKey (backends !! 0) keyname
- present <- inAnnex key
- force <- Annex.flagIsSet "force"
- if (not present)
- then return Nothing
- else if (not force)
- then error "dropkey is can cause data loss; use --force if you're sure you want to do this"
- else do
- showStart "dropkey" keyname
- return $ Just $ dropKeyPerform key
-dropKeyPerform :: Key -> SubCmdPerform
-dropKeyPerform key = do
- g <- Annex.gitRepo
- let loc = annexLocation g key
- liftIO $ removeFile loc
- return $ Just $ dropKeyCleanup key
-dropKeyCleanup :: Key -> SubCmdCleanup
-dropKeyCleanup key = do
- logStatus key ValueMissing
- return True
-
-{- Sets cached content for a key. -}
-setKeyStart :: SubCmdStartString
-setKeyStart tmpfile = do
- keyname <- Annex.flagGet "key"
- when (null keyname) $ error "please specify the key with --key"
- backends <- Backend.list
- let key = genKey (backends !! 0) keyname
- showStart "setkey" tmpfile
- return $ Just $ setKeyPerform tmpfile key
-setKeyPerform :: FilePath -> Key -> SubCmdPerform
-setKeyPerform tmpfile key = do
- g <- Annex.gitRepo
- let loc = annexLocation g key
- ok <- liftIO $ boolSystem "mv" [tmpfile, loc]
- if (not ok)
- then error "mv failed!"
- else return $ Just $ setKeyCleanup key
-setKeyCleanup :: Key -> SubCmdCleanup
-setKeyCleanup key = do
- logStatus key ValuePresent
- return True
-
-{- Fixes the symlink to an annexed file. -}
-fixStart :: SubCmdStartString
-fixStart file = isAnnexed file $ \(key, _) -> do
- link <- calcGitLink file key
- l <- liftIO $ readSymbolicLink file
- if (link == l)
- then return Nothing
- else do
- showStart "fix" file
- return $ Just $ fixPerform file link
-fixPerform :: FilePath -> FilePath -> SubCmdPerform
-fixPerform file link = do
- liftIO $ createDirectoryIfMissing True (parentDir file)
- liftIO $ removeFile file
- liftIO $ createSymbolicLink link file
- return $ Just $ fixCleanup file
-fixCleanup :: FilePath -> SubCmdCleanup
-fixCleanup file = do
- Annex.queue "add" [] file
- return True
-
-{- Stores description for the repository etc. -}
-initStart :: SubCmdStartString
-initStart description = do
- when (null description) $ error $
- "please specify a description of this repository\n" ++ usage
- showStart "init" description
- return $ Just $ initPerform description
-initPerform :: String -> SubCmdPerform
-initPerform description = do
- g <- Annex.gitRepo
- u <- getUUID g
- describeUUID u description
- liftIO $ gitAttributes g
- liftIO $ gitPreCommitHook g
- return $ Just $ initCleanup
-initCleanup :: SubCmdCleanup
-initCleanup = do
- g <- Annex.gitRepo
- logfile <- uuidLog
- liftIO $ Git.run g ["add", logfile]
- liftIO $ Git.run g ["commit", "-m", "git annex init", logfile]
- return True
-
-{- Adds a file pointing at a manually-specified key -}
-fromKeyStart :: SubCmdStartString
-fromKeyStart file = do
- keyname <- Annex.flagGet "key"
- when (null keyname) $ error "please specify the key with --key"
- backends <- Backend.list
- let key = genKey (backends !! 0) keyname
-
- inbackend <- Backend.hasKey key
- unless (inbackend) $ error $
- "key ("++keyname++") is not present in backend"
- showStart "fromkey" file
- return $ Just $ fromKeyPerform file key
-fromKeyPerform :: FilePath -> Key -> SubCmdPerform
-fromKeyPerform file key = do
- link <- calcGitLink file key
- liftIO $ createDirectoryIfMissing True (parentDir file)
- liftIO $ createSymbolicLink link file
- return $ Just $ fromKeyCleanup file
-fromKeyCleanup :: FilePath -> SubCmdCleanup
-fromKeyCleanup file = do
- Annex.queue "add" [] file
- return True
-
-{- Move 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. -}
-moveStart :: SubCmdStartString
-moveStart file = do
- fromName <- Annex.flagGet "fromrepository"
- toName <- Annex.flagGet "torepository"
- case (fromName, toName) of
- ("", "") -> error "specify either --from or --to"
- ("", _) -> moveToStart file
- (_ , "") -> moveFromStart file
- (_ , _) -> error "only one of --from or --to can be specified"
-
-{- Moves the content of an annexed file to another repository,
- - removing it from the current repository, and updates locationlog
- - information on both.
- -
- - If the destination already has the content, it is still removed
- - from the current repository.
- -
- - Note that unlike drop, this does not honor annex.numcopies.
- - A file's content can be moved even if there are insufficient copies to
- - allow it to be dropped.
- -}
-moveToStart :: SubCmdStartString
-moveToStart file = isAnnexed file $ \(key, _) -> do
- ishere <- inAnnex key
- if (not ishere)
- then return Nothing -- not here, so nothing to do
- else do
- showStart "move" file
- return $ Just $ moveToPerform key
-moveToPerform :: Key -> SubCmdPerform
-moveToPerform key = do
- -- checking the remote is expensive, so not done in the start step
- remote <- Remotes.commandLineRemote
- isthere <- Remotes.inAnnex remote key
- case isthere of
- Left err -> do
- showNote $ show err
- return Nothing
- Right False -> do
- Core.showNote $ "moving to " ++ (Git.repoDescribe remote) ++ "..."
- let tmpfile = (annexTmpLocation remote) ++ (keyFile key)
- ok <- Remotes.copyToRemote remote key tmpfile
- if (ok)
- then return $ Just $ moveToCleanup remote key tmpfile
- else return Nothing -- failed
- Right True -> return $ Just $ dropCleanup key
-moveToCleanup :: Git.Repo -> Key -> FilePath -> SubCmdCleanup
-moveToCleanup remote key tmpfile = do
- -- Tell remote to use the transferred content.
- ok <- Remotes.runCmd remote "git-annex" ["setkey", "--quiet",
- "--backend=" ++ (backendName key),
- "--key=" ++ keyName key,
- tmpfile]
- if ok
- then do
- -- Record that the key is present on the remote.
- g <- Annex.gitRepo
- remoteuuid <- getUUID remote
- logfile <- liftIO $ logChange g key remoteuuid ValuePresent
- Annex.queue "add" [] logfile
- -- Cleanup on the local side is the same as done for the
- -- drop subcommand.
- dropCleanup key
- else return False
-
-{- Moves the content of an annexed file from another repository to the current
- - repository and updates locationlog information on both.
- -
- - If the current repository already has the content, it is still removed
- - from the other repository.
- -}
-moveFromStart :: SubCmdStartString
-moveFromStart file = isAnnexed file $ \(key, _) -> do
- remote <- Remotes.commandLineRemote
- l <- Remotes.keyPossibilities key
- if (null $ filter (\r -> Remotes.same r remote) l)
- then return Nothing
- else do
- showStart "move" file
- return $ Just $ moveFromPerform key
-moveFromPerform :: Key -> SubCmdPerform
-moveFromPerform key = do
- remote <- Remotes.commandLineRemote
- ishere <- inAnnex key
- if (ishere)
- then return $ Just $ moveFromCleanup remote key
- else do
- Core.showNote $ "moving from " ++ (Git.repoDescribe remote) ++ "..."
- ok <- getViaTmp key (Remotes.copyFromRemote remote key)
- if (ok)
- then return $ Just $ moveFromCleanup remote key
- else return Nothing -- fail
-moveFromCleanup :: Git.Repo -> Key -> SubCmdCleanup
-moveFromCleanup remote key = do
- ok <- Remotes.runCmd remote "git-annex" ["dropkey", "--quiet", "--force",
- "--backend=" ++ (backendName key),
- keyName key]
- when ok $ do
- -- Record locally that the key is not on the remote.
- remoteuuid <- getUUID remote
- g <- Annex.gitRepo
- logfile <- liftIO $ logChange g key remoteuuid ValueMissing
- Annex.queue "add" [] logfile
- return ok
-
--- helpers
-notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
-notAnnexed file a = do
- r <- Backend.lookupFile file
- case (r) of
- Just _ -> return Nothing
- Nothing -> a
-isAnnexed :: FilePath -> ((Key, Backend) -> Annex (Maybe a)) -> Annex (Maybe a)
-isAnnexed file a = do
- r <- Backend.lookupFile file
- case (r) of
- Just v -> a v
- Nothing -> return Nothing
diff --git a/git-annex.hs b/git-annex.hs
index 370c22a1e..098ccac2d 100644
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -9,7 +9,7 @@ import System.Environment
import qualified Annex
import Core
-import Commands
+import CmdLine
import qualified GitRepo as Git
import BackendList