diff options
| -rw-r--r-- | Backend.hs | 6 | ||||
| -rw-r--r-- | Backend/File.hs | 4 | ||||
| -rw-r--r-- | BackendTypes.hs | 2 | ||||
| -rw-r--r-- | Commands.hs | 24 | ||||
| -rw-r--r-- | UUID.hs | 10 |
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 @@ -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 = |