From 80ce5f90db1de10a5fa42583efcb7390cf185662 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 13:47:04 -0400 Subject: [PATCH] update --- Backend.hs | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++ BackendFile.hs | 17 +++++++++++++++ BackendUrl.hs | 17 +++++++++++++++ GitRepo.hs | 14 ++++++------ git-annex.hs | 6 ++++++ 5 files changed, 106 insertions(+), 6 deletions(-) create mode 100644 Backend.hs create mode 100644 BackendFile.hs create mode 100644 BackendUrl.hs diff --git a/Backend.hs b/Backend.hs new file mode 100644 index 0000000000..cb91325c61 --- /dev/null +++ b/Backend.hs @@ -0,0 +1,58 @@ +{- 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 + - used to store the file contents, and git-annex would then retrieve them + - as needed and put them in `.git/annex/`. + - + - When a file is annexed, a key is generated from its content and/or metadata. + - This key can later be used to retrieve the file's content (its value). This + - key generation must be stable for a given file content, name, and size. + - + - The mapping from filename to its key is stored in the .git-annex directory, + - in a file named `$filename.$backend` + - + - Multiple pluggable backends are supported, and more than one can be used + - to store different files' contents in a given repository. + - -} + +module Backend where + +import GitRepo +import System.Directory + +data Backend = Backend { + name :: String, -- name of this backend + keyvalue :: FilePath -> Maybe String, -- maps from key to value + retrievekey :: IO String -> IO (Bool) -- retrieves value given key +} + +{- Name of state file that holds the key for an annexed file, + - using a given backend. -} +backendFile :: Backend -> GitRepo -> FilePath -> String +backendFile backend repo file = gitStateDir repo ++ + (gitRelative repo file) ++ "." ++ (name backend) + +{- Looks up the backend used for an already annexed file. -} +lookupBackend :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Backend) +lookupBackend [] repo file = return Nothing +lookupBackend (b:bs) repo file = do + present <- checkBackend b repo file + if present + then + return $ Just b + else + lookupBackend bs repo file + +{- Checks if a file is available via a given backend. -} +checkBackend :: Backend -> GitRepo -> FilePath -> IO (Bool) +checkBackend backend repo file = doesFileExist $ backendFile backend repo file + +{- Attempts to retrieve an annexed file from one of the backends. -} +retrieveFile :: [Backend] -> GitRepo -> FilePath -> IO (Bool) +retrieveFile backends repo file = do + result <- lookupBackend backends repo file + case (result) of + Nothing -> return False + Just b -> (retrievekey b) key + where key = readFile (backendFile b repo file) diff --git a/BackendFile.hs b/BackendFile.hs new file mode 100644 index 0000000000..b1a3be58a6 --- /dev/null +++ b/BackendFile.hs @@ -0,0 +1,17 @@ +{- git-annex "file" backend + - -} + +module BackendFile (backend) where + +import Backend + +backend = Backend { + name = "file", + keyvalue = keyValue, + retrievekey = copyFile +} + +-- direct mapping from filename to key +keyValue k = Just $ id k + +copyFile f = error "unimplemented" diff --git a/BackendUrl.hs b/BackendUrl.hs new file mode 100644 index 0000000000..f95c53bbfc --- /dev/null +++ b/BackendUrl.hs @@ -0,0 +1,17 @@ +{- git-annex "url" backend + - -} + +module BackendUrl (backend) where + +import Backend + +backend = Backend { + name = "url", + keyvalue = keyValue, + retrievekey = downloadUrl +} + +-- cannot generate url from filename +keyValue k = Nothing + +downloadUrl k = error "unimplemented" diff --git a/GitRepo.hs b/GitRepo.hs index 140fb628a7..8974d9db6c 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -8,14 +8,16 @@ import System.Path import Data.String.Utils import Utility +type GitRepo = FilePath + {- Long-term state is stored in files inside the .git-annex directory - in the git repository. -} stateLoc = ".git-annex" -gitStateDir :: String -> String +gitStateDir :: GitRepo -> FilePath gitStateDir repo = repo ++ "/" ++ stateLoc ++ "/" {- Path to a repository's gitattributes file. -} -gitAttributes :: FilePath -> IO String +gitAttributes :: GitRepo -> IO String gitAttributes repo = do bare <- isBareRepo repo if (bare) @@ -25,7 +27,7 @@ gitAttributes repo = do {- Path to a repository's .git directory. - (For a bare repository, that is the root of the repository.) - TODO: support GIT_DIR -} -gitDir :: FilePath -> IO String +gitDir :: GitRepo -> IO String gitDir repo = do bare <- isBareRepo repo if (bare) @@ -35,7 +37,7 @@ gitDir repo = do {- Given a relative or absolute filename, calculates the name to use - relative to a git repository directory (which must be absolute). - This is the same form displayed and used by git. -} -gitRelative :: FilePath -> String -> String +gitRelative :: GitRepo -> String -> String gitRelative repo file = drop (length absrepo) absfile where -- normalize both repo and file, so that repo @@ -48,7 +50,7 @@ gitRelative repo file = drop (length absrepo) absfile Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo {- Sets up a git repo for git-annex. May be called repeatedly. -} -gitPrep :: FilePath -> IO () +gitPrep :: GitRepo -> IO () gitPrep repo = do -- configure git to use union merge driver on state files let attrLine = stateLoc ++ "/* merge=union" @@ -66,7 +68,7 @@ gitPrep repo = do {- Finds the top of the current git repository, which may be in a parent - directory. -} -repoTop :: IO String +repoTop :: IO GitRepo repoTop = do cwd <- getCurrentDirectory top <- seekUp cwd isRepoTop diff --git a/git-annex.hs b/git-annex.hs index 8944b50f55..77faea2b78 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -3,6 +3,12 @@ import LocationLog import GitRepo +import Backend + +-- When adding a new backend, import it here and add it to the backends list. +import qualified BackendFile +import qualified BackendUrl +backends = [BackendFile.backend, BackendUrl.backend] main = do repo <- repoTop