This commit is contained in:
Joey Hess 2010-10-10 15:41:35 -04:00
parent eb577ee37f
commit 7880dc16fe
4 changed files with 24 additions and 18 deletions

View file

@ -28,9 +28,9 @@ data Backend = Backend {
-- name of this backend -- name of this backend
name :: String, name :: String,
-- converts a filename to a key -- converts a filename to a key
getKey :: FilePath -> IO (Maybe Key), getKey :: GitRepo -> FilePath -> IO (Maybe Key),
-- stores a file's contents to a key -- stores a file's contents to a key
storeFileKey :: FilePath -> Key -> IO (Bool), storeFileKey :: GitRepo -> FilePath -> Key -> IO (Bool),
-- retrieves a key's contents to a file -- retrieves a key's contents to a file
retrieveKeyFile :: IO Key -> FilePath -> IO (Bool) retrieveKeyFile :: IO Key -> FilePath -> IO (Bool)
} }
@ -49,11 +49,11 @@ backendFile backend repo file = gitStateDir repo ++
storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key) storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key)
storeFile [] _ _ = return Nothing storeFile [] _ _ = return Nothing
storeFile (b:bs) repo file = do storeFile (b:bs) repo file = do
try <- (getKey b) (gitRelative repo file) try <- (getKey b) repo (gitRelative repo file)
case (try) of case (try) of
Nothing -> nextbackend Nothing -> nextbackend
Just key -> do Just key -> do
stored <- (storeFileKey b) file key stored <- (storeFileKey b) repo file key
if (not stored) if (not stored)
then nextbackend then nextbackend
else do else do

View file

@ -4,6 +4,7 @@
module BackendChecksum (backend) where module BackendChecksum (backend) where
import Backend import Backend
import GitRepo
import qualified BackendFile import qualified BackendFile
import Data.Digest.Pure.SHA import Data.Digest.Pure.SHA
@ -13,6 +14,6 @@ backend = BackendFile.backend {
getKey = keyValue getKey = keyValue
} }
-- -- checksum the file to get its key
keyValue :: FilePath -> IO (Maybe Key) keyValue :: GitRepo -> FilePath -> IO (Maybe Key)
keyValue k = error "unimplemented" -- TODO keyValue k = error "checksum keyValue unimplemented" -- TODO

View file

@ -4,20 +4,24 @@
module BackendFile (backend) where module BackendFile (backend) where
import Backend import Backend
import GitRepo
backend = Backend { backend = Backend {
name = "file", name = "file",
getKey = keyValue, getKey = keyValue,
storeFileKey = moveToAnnex, storeFileKey = dummyStore,
retrieveKeyFile = copyFromOtherRepo retrieveKeyFile = copyFromOtherRepo
} }
-- direct mapping from filename to key -- direct mapping from filename to key
keyValue :: FilePath -> IO (Maybe Key) keyValue :: GitRepo -> FilePath -> IO (Maybe Key)
keyValue k = return $ Just $ id k keyValue repo file = return $ Just file
moveToAnnex :: FilePath -> Key -> IO (Bool) -- This backend does not really do any independant data storage,
moveToAnnex file key = return False -- it relies on the file contents in .git/annex/ in this repo,
-- and other accessible repos. So storing a file is a no-op.
dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool)
dummyStore repo file key = return True
copyFromOtherRepo :: IO Key -> FilePath -> IO (Bool) copyFromOtherRepo :: IO Key -> FilePath -> IO (Bool)
copyFromOtherRepo key file = return False copyFromOtherRepo key file = error "copyFromOtherRepo unimplemented" -- TODO

View file

@ -4,6 +4,7 @@
module BackendUrl (backend) where module BackendUrl (backend) where
import Backend import Backend
import GitRepo
backend = Backend { backend = Backend {
name = "url", name = "url",
@ -13,12 +14,12 @@ backend = Backend {
} }
-- cannot generate url from filename -- cannot generate url from filename
keyValue :: FilePath -> IO (Maybe Key) keyValue :: GitRepo -> FilePath -> IO (Maybe Key)
keyValue k = return Nothing keyValue repo file = return Nothing
-- cannot store to urls -- cannot store to urls
dummyStore :: FilePath -> Key -> IO (Bool) dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool)
dummyStore file url = return False dummyStore repo file url = return False
downloadUrl :: IO Key -> FilePath -> IO (Bool) downloadUrl :: IO Key -> FilePath -> IO (Bool)
downloadUrl url file = error "unimplemented" downloadUrl url file = error "downloadUrl unimplemented"