summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Backend.hs6
-rw-r--r--Backend/File.hs4
-rw-r--r--BackendTypes.hs2
-rw-r--r--Commands.hs24
-rw-r--r--UUID.hs10
5 files changed, 30 insertions, 16 deletions
diff --git a/Backend.hs b/Backend.hs
index f419831d2..636557d7d 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -1,7 +1,7 @@
-{- git-annex key/value storage backends
+{- git-annex key-value storage backends
-
- - git-annex uses a key/value abstraction layer to allow files contents to be
- - stored in different ways. In theory, any key/value storage system could be
+ - git-annex uses a key-value abstraction layer to allow files contents to be
+ - stored in different ways. In theory, any key-value storage system could be
- used to store the file contents, and git-annex would then retrieve them
- as needed and put them in `.git/annex/`.
-
diff --git a/Backend/File.hs b/Backend/File.hs
index b2c5c90eb..c443b4f7a 100644
--- a/Backend/File.hs
+++ b/Backend/File.hs
@@ -58,7 +58,7 @@ copyKeyFile key file = do
else return ()
trycopy remotes remotes
where
- trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++
+ trycopy full [] = error $ "unable to get file with key: " ++ (keyFile key) ++ "\n" ++
"To get that file, need access to one of these remotes: " ++
(Remotes.list full)
trycopy full (r:rs) = do
@@ -79,7 +79,7 @@ copyKeyFile key file = do
g <- Annex.gitRepo
uuids <- liftIO $ keyLocations g key
ppuuids <- prettyPrintUUIDs uuids
- error $ "no available git remotes have: " ++
+ error $ "no available git remotes have file with key: " ++
(keyFile key) ++
if (0 < length uuids)
then "\nIt has been seen before in these repositories:\n" ++ ppuuids
diff --git a/BackendTypes.hs b/BackendTypes.hs
index 13ffde7f8..41bc77858 100644
--- a/BackendTypes.hs
+++ b/BackendTypes.hs
@@ -49,7 +49,7 @@ backendName (Key (b,k)) = b
keyFrag :: Key -> KeyFrag
keyFrag (Key (b,k)) = k
--- this structure represents a key/value backend
+-- this structure represents a key-value backend
data Backend = Backend {
-- name of this backend
name :: String,
diff --git a/Commands.hs b/Commands.hs
index 11f808c21..1f9128011 100644
--- a/Commands.hs
+++ b/Commands.hs
@@ -23,7 +23,7 @@ import Core
import qualified Remotes
import qualified BackendTypes
-data CmdWants = FilesInGit | FilesNotInGit | RepoName
+data CmdWants = FilesInGit | FilesNotInGit | RepoName | SingleString
data Command = Command {
cmdname :: String,
cmdaction :: (String -> Annex ()),
@@ -34,10 +34,10 @@ cmds :: [Command]
cmds = [ (Command "add" addCmd FilesNotInGit)
, (Command "get" getCmd FilesInGit)
, (Command "drop" dropCmd FilesInGit)
- , (Command "want" wantCmd FilesInGit)
, (Command "push" pushCmd RepoName)
, (Command "pull" pullCmd RepoName)
, (Command "unannex" unannexCmd FilesInGit)
+ , (Command "describe" describeCmd SingleString)
]
{- Finds the type of parameters a command wants, from among the passed
@@ -49,6 +49,8 @@ findWanted FilesNotInGit params repo = do
findWanted FilesInGit params repo = do
files <- mapM (Git.inRepo repo) params
return $ foldl (++) [] files
+findWanted SingleString params _ = do
+ return $ [unwords params]
findWanted RepoName params _ = do
return $ params
@@ -150,11 +152,8 @@ getCmd file = notinBackend file err $ \(key, backend) -> do
where
err = error $ "not annexed " ++ file
-{- Indicates a file is wanted. -}
-wantCmd :: FilePath -> Annex ()
-wantCmd file = do error "not implemented" -- TODO
-
-{- Indicates a file is not wanted. -}
+{- Indicates a file's content is not wanted anymore, and should be removed
+ - if it's safe to do so. -}
dropCmd :: FilePath -> Annex ()
dropCmd file = notinBackend file err $ \(key, backend) -> do
force <- Annex.flagIsSet Force
@@ -185,6 +184,17 @@ pushCmd reponame = do error "not implemented" -- TODO
pullCmd :: String -> Annex ()
pullCmd reponame = do error "not implemented" -- TODO
+{- Stores description for the repository. -}
+describeCmd :: String -> Annex ()
+describeCmd description = do
+ g <- Annex.gitRepo
+ u <- getUUID g
+ describeUUID u description
+ log <- uuidLog
+ liftIO $ Git.run g ["add", log]
+ Annex.flagChange NeedCommit True
+ liftIO $ putStrLn "description set"
+
{- Updates the LocationLog when a key's presence changes. -}
logStatus :: Key -> LogStatus -> Annex ()
logStatus key status = do
diff --git a/UUID.hs b/UUID.hs
index 8cdee43de..3e6991d48 100644
--- a/UUID.hs
+++ b/UUID.hs
@@ -12,7 +12,8 @@ module UUID (
genUUID,
reposByUUID,
prettyPrintUUIDs,
- describeUUID
+ describeUUID,
+ uuidLog
) where
import Control.Monad.State
@@ -25,6 +26,7 @@ import qualified GitRepo as Git
import Types
import Locations
import qualified Annex
+import Utility
type UUID = String
@@ -110,7 +112,7 @@ describeUUID uuid desc = do
m <- uuidMap
let m' = M.insert uuid desc m
log <- uuidLog
- liftIO $ writeFile log $ serialize m'
+ liftIO $ withFileLocked log WriteMode (\h -> hPutStr h $ serialize m')
where
serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m
@@ -118,7 +120,9 @@ describeUUID uuid desc = do
uuidMap :: Annex (M.Map UUID String)
uuidMap = do
log <- uuidLog
- s <- liftIO $ catch (readFile log) (\error -> return "")
+ s <- liftIO $ catch
+ (withFileLocked log ReadMode $ \h -> hGetContentsStrict h)
+ (\error -> return "")
return $ M.fromList $ map (\l -> pair l) $ lines s
where
pair l =