summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
Diffstat (limited to 'Command')
-rw-r--r--Command/Add.hs10
-rw-r--r--Command/Drop.hs18
-rw-r--r--Command/DropKey.hs9
-rw-r--r--Command/Fix.hs1
-rw-r--r--Command/FromKey.hs1
-rw-r--r--Command/Fsck.hs29
-rw-r--r--Command/Get.hs1
-rw-r--r--Command/Init.hs3
-rw-r--r--Command/Move.hs5
-rw-r--r--Command/SetKey.hs23
-rw-r--r--Command/Unannex.hs10
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-09 05:25:18 +0000