diff options
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Add.hs | 10 | ||||
-rw-r--r-- | Command/Drop.hs | 18 | ||||
-rw-r--r-- | Command/DropKey.hs | 9 | ||||
-rw-r--r-- | Command/Fix.hs | 1 | ||||
-rw-r--r-- | Command/FromKey.hs | 1 | ||||
-rw-r--r-- | Command/Fsck.hs | 29 | ||||
-rw-r--r-- | Command/Get.hs | 1 | ||||
-rw-r--r-- | Command/Init.hs | 3 | ||||
-rw-r--r-- | Command/Move.hs | 5 | ||||
-rw-r--r-- | Command/SetKey.hs | 23 | ||||
-rw-r--r-- | Command/Unannex.hs | 10 |
11 files changed, 38 insertions, 72 deletions
diff --git a/Command/Add.hs b/Command/Add.hs index 825c1d8c1..6c5d24f84 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -9,16 +9,14 @@ 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 +import Messages {- 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 @@ -41,11 +39,9 @@ perform (file, backend) = do cleanup :: FilePath -> Key -> SubCmdCleanup cleanup file key = do + moveAnnex key file 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 diff --git a/Command/Drop.hs b/Command/Drop.hs index 6cdf216f4..48433b14c 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -7,16 +7,14 @@ module Command.Drop where -import Control.Monad.State (liftIO) -import System.Directory +import Control.Monad (when) import Command -import qualified Annex -import Locations import qualified Backend import LocationLog import Types import Core +import Messages {- Indicates a file's content is not wanted anymore, and should be removed - if it's safe to do so. -} @@ -38,13 +36,7 @@ perform key backend = do 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 - + when (inannex) $ removeAnnex key + logStatus key ValueMissing + return True diff --git a/Command/DropKey.hs b/Command/DropKey.hs index bdd9b55b1..e0b20918c 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -7,16 +7,13 @@ 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 +import Messages {- Drops cached content for a key. -} start :: SubCmdStartString @@ -35,9 +32,7 @@ start keyname = do perform :: Key -> SubCmdPerform perform key = do - g <- Annex.gitRepo - let loc = annexLocation g key - liftIO $ removeFile loc + removeAnnex key return $ Just $ cleanup key cleanup :: Key -> SubCmdCleanup diff --git a/Command/Fix.hs b/Command/Fix.hs index 90257a8a5..7963a1d2e 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -15,6 +15,7 @@ import Command import qualified Annex import Utility import Core +import Messages {- Fixes the symlink to an annexed file. -} start :: SubCmdStartString diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 3071f218f..de555475c 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -18,6 +18,7 @@ import Utility import qualified Backend import Types import Core +import Messages {- Adds a file pointing at a manually-specified key -} start :: SubCmdStartString diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 785aecd8a..5405ce120 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -8,19 +8,11 @@ module Command.Fsck where import qualified Data.Map as M -import System.Directory -import System.Posix.Files -import Monad (filterM) -import Control.Monad.State (liftIO) -import Data.Maybe import Command import Types import Core -import Locations -import qualified Annex -import qualified GitRepo as Git -import qualified Backend +import Messages {- Checks the whole annex for problems. -} start :: SubCmdStart @@ -71,22 +63,3 @@ unusedKeys = do existsMap :: Ord k => [k] -> M.Map k Int existsMap l = M.fromList $ map (\k -> (k, 1)) l - -getKeysPresent :: Annex [Key] -getKeysPresent = do - g <- Annex.gitRepo - let top = annexDir g - contents <- liftIO $ getDirectoryContents top - files <- liftIO $ filterM (isreg top) contents - return $ map fileKey files - where - isreg top f = do - s <- getFileStatus $ top ++ "/" ++ f - return $ isRegularFile s - -getKeysReferenced :: Annex [Key] -getKeysReferenced = do - g <- Annex.gitRepo - files <- liftIO $ Git.inRepo g $ Git.workTree g - keypairs <- mapM Backend.lookupFile files - return $ map fst $ catMaybes keypairs diff --git a/Command/Get.hs b/Command/Get.hs index 1433bc8d0..c50b5a377 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -11,6 +11,7 @@ import Command import qualified Backend import Types import Core +import Messages {- Gets an annexed file from one of the backends. -} start :: SubCmdStartString diff --git a/Command/Init.hs b/Command/Init.hs index b1e4e0e06..fa5725c48 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -15,6 +15,8 @@ import qualified Annex import Core import qualified GitRepo as Git import UUID +import Version +import Messages {- Stores description for the repository etc. -} start :: SubCmdStartString @@ -29,6 +31,7 @@ perform description = do g <- Annex.gitRepo u <- getUUID g describeUUID u description + setVersion liftIO $ gitAttributes g liftIO $ gitPreCommitHook g return $ Just $ cleanup diff --git a/Command/Move.hs b/Command/Move.hs index cee941622..6ca923a31 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -20,6 +20,7 @@ import Core import qualified GitRepo as Git import qualified Remotes import UUID +import Messages {- Move a file either --to or --from a repository. - @@ -64,7 +65,7 @@ moveToPerform key = do showNote $ show err return Nothing Right False -> do - Core.showNote $ "moving to " ++ (Git.repoDescribe remote) ++ "..." + showNote $ "moving to " ++ (Git.repoDescribe remote) ++ "..." let tmpfile = (annexTmpLocation remote) ++ (keyFile key) ok <- Remotes.copyToRemote remote key tmpfile if (ok) @@ -112,7 +113,7 @@ moveFromPerform key = do if (ishere) then return $ Just $ moveFromCleanup remote key else do - Core.showNote $ "moving from " ++ (Git.repoDescribe remote) ++ "..." + showNote $ "moving from " ++ (Git.repoDescribe remote) ++ "..." ok <- getViaTmp key (Remotes.copyFromRemote remote key) if (ok) then return $ Just $ moveFromCleanup remote key diff --git a/Command/SetKey.hs b/Command/SetKey.hs index a5710643e..50e9a590b 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -13,29 +13,30 @@ import Control.Monad (when) import Command import qualified Annex import Utility -import Locations import qualified Backend import LocationLog import Types import Core +import Messages {- Sets cached content for a key. -} start :: SubCmdStartString -start tmpfile = do +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 - showStart "setkey" tmpfile - return $ Just $ perform tmpfile key + showStart "setkey" file + return $ Just $ perform file 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 +perform file key = do + -- the file might be on a different filesystem, so mv is used + -- rather than simply calling moveToObjectDir key file + ok <- getViaTmp key $ \dest -> liftIO $ boolSystem "mv" [file, dest] + if ok + then return $ Just $ cleanup key + else error "mv failed!" + cleanup :: Key -> SubCmdCleanup cleanup key = do logStatus key ValuePresent diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 5cffb2d89..a9c18f765 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -13,12 +13,12 @@ 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 +import Messages {- The unannex subcommand undoes an add. -} start :: SubCmdStartString @@ -37,12 +37,14 @@ perform file key backend = do 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 + + fromAnnex key file + logStatus key ValueMissing + return True |