diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-12 16:06:10 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-12 16:06:10 -0400 |
commit | 2ac47a3a59b2b9b8980b4a9d3277bcb653bcb026 (patch) | |
tree | 2d40eae24513c5f895a9da771f0b34d228439c97 | |
parent | 759f146d0fd5857cbbb796367c3dd8c695550b46 (diff) |
thread State thru to backends
-rw-r--r-- | Annex.hs | 10 | ||||
-rw-r--r-- | Backend.hs | 55 | ||||
-rw-r--r-- | BackendChecksum.hs | 4 | ||||
-rw-r--r-- | BackendFile.hs | 10 | ||||
-rw-r--r-- | BackendList.hs | 2 | ||||
-rw-r--r-- | BackendType.hs | 31 | ||||
-rw-r--r-- | BackendUrl.hs | 7 | ||||
-rw-r--r-- | Types.hs | 25 |
8 files changed, 67 insertions, 77 deletions
@@ -45,12 +45,12 @@ startAnnex = do - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do - alreadyannexed <- lookupBackend (backends state) (repo state) file + alreadyannexed <- lookupBackend (backends state) state file case (alreadyannexed) of Just _ -> error $ "already annexed: " ++ file Nothing -> do checkLegal file - stored <- storeFile (backends state) (repo state) file + stored <- storeFile (backends state) state file case (stored) of Nothing -> error $ "no backend could store: " ++ file Just key -> symlink key @@ -70,11 +70,11 @@ annexFile state file = do {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () unannexFile state file = do - alreadyannexed <- lookupBackend (backends state) (repo state) file + alreadyannexed <- lookupBackend (backends state) state file case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just _ -> do - mkey <- dropFile (backends state) (repo state) file + mkey <- dropFile (backends state) state file case (mkey) of Nothing -> return () Just key -> do @@ -86,7 +86,7 @@ unannexFile state file = do {- Transfers the file from a remote. -} annexGetFile :: State -> FilePath -> IO () annexGetFile state file = do - alreadyannexed <- lookupBackend (backends state) (repo state) file + alreadyannexed <- lookupBackend (backends state) state file case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just _ -> do error "not implemented" -- TODO diff --git a/Backend.hs b/Backend.hs index 2d3ea42d6..ddfd8b19d 100644 --- a/Backend.hs +++ b/Backend.hs @@ -28,74 +28,75 @@ import System.Directory import Locations import GitRepo import Utility -import BackendType +import Types {- 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) +backendFile :: Backend -> State -> FilePath -> String +backendFile backend state file = + gitStateDir (repo state) ++ (gitRelative (repo state) file) ++ + "." ++ (name backend) {- Attempts to store a file in one of the backends, and returns - its key. -} -storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key) +storeFile :: [Backend] -> State -> FilePath -> IO (Maybe Key) storeFile [] _ _ = return Nothing -storeFile (b:bs) repo file = do - try <- (getKey b) repo (gitRelative repo file) +storeFile (b:bs) state file = do + try <- (getKey b) state (gitRelative (repo state) file) case (try) of Nothing -> nextbackend Just key -> do - stored <- (storeFileKey b) repo file key + stored <- (storeFileKey b) state file key if (not stored) then nextbackend else do bookkeeping key return $ Just key where - nextbackend = storeFile bs repo file - backendfile = backendFile b repo file + nextbackend = storeFile bs state file + backendfile = backendFile b state file bookkeeping key = do createDirectoryIfMissing True (parentDir backendfile) writeFile backendfile key {- Attempts to retrieve an file from one of the backends, saving it to - a specified location. -} -retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO Bool -retrieveFile backends repo file dest = do - result <- lookupBackend backends repo file +retrieveFile :: [Backend] -> State -> FilePath -> FilePath -> IO Bool +retrieveFile backends state file dest = do + result <- lookupBackend backends state file case (result) of Nothing -> return False Just b -> do - key <- lookupKey b repo file + key <- lookupKey b state file (retrieveKeyFile b) key dest {- Drops the key for a file from the backend that has it. -} -dropFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key) -dropFile backends repo file = do - result <- lookupBackend backends repo file +dropFile :: [Backend] -> State -> FilePath -> IO (Maybe Key) +dropFile backends state file = do + result <- lookupBackend backends state file case (result) of Nothing -> return Nothing Just b -> do - key <- lookupKey b repo file + key <- lookupKey b state file (removeKey b) key - removeFile $ backendFile b repo file + removeFile $ backendFile b state file return $ Just key {- Looks up the key a backend uses for an already annexed file. -} -lookupKey :: Backend -> GitRepo -> FilePath -> IO Key -lookupKey backend repo file = readFile (backendFile backend repo file) +lookupKey :: Backend -> State -> FilePath -> IO Key +lookupKey backend state file = readFile (backendFile backend state file) {- Looks up the backend used for an already annexed file. -} -lookupBackend :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Backend) +lookupBackend :: [Backend] -> State -> FilePath -> IO (Maybe Backend) lookupBackend [] _ _ = return Nothing -lookupBackend (b:bs) repo file = do - present <- checkBackend b repo file +lookupBackend (b:bs) state file = do + present <- checkBackend b state file if present then return $ Just b else - lookupBackend bs repo file + lookupBackend bs state 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 +checkBackend :: Backend -> State -> FilePath -> IO (Bool) +checkBackend backend state file = doesFileExist $ backendFile backend state file diff --git a/BackendChecksum.hs b/BackendChecksum.hs index e80dbe793..72b4744e3 100644 --- a/BackendChecksum.hs +++ b/BackendChecksum.hs @@ -5,7 +5,7 @@ module BackendChecksum (backend) where import qualified BackendFile import Data.Digest.Pure.SHA -import BackendType +import Types import GitRepo -- based on BackendFile just with a different key type @@ -15,5 +15,5 @@ backend = BackendFile.backend { } -- checksum the file to get its key -keyValue :: GitRepo -> FilePath -> IO (Maybe Key) +keyValue :: State -> FilePath -> IO (Maybe Key) keyValue k = error "checksum keyValue unimplemented" -- TODO diff --git a/BackendFile.hs b/BackendFile.hs index ae53f460f..33c2985bc 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -3,7 +3,7 @@ module BackendFile (backend) where -import BackendType +import Types import GitRepo backend = Backend { @@ -15,15 +15,15 @@ backend = Backend { } -- direct mapping from filename to key -keyValue :: GitRepo -> FilePath -> IO (Maybe Key) -keyValue repo file = return $ Just file +keyValue :: State -> FilePath -> IO (Maybe Key) +keyValue state file = return $ Just file {- This backend does not really do any independant data storage, - it relies on the file contents in .git/annex/ in this repo, - and other accessible repos. So storing or removing a key is - a no-op. -} -dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool) -dummyStore repo file key = return True +dummyStore :: State -> FilePath -> Key -> IO (Bool) +dummyStore state file key = return True dummyRemove :: Key -> IO Bool dummyRemove url = return False diff --git a/BackendList.hs b/BackendList.hs index f733a44be..104444dc2 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -7,7 +7,7 @@ module BackendList ( lookupBackendName ) where -import BackendType +import Types -- When adding a new backend, import it here and add it to the list. import qualified BackendFile diff --git a/BackendType.hs b/BackendType.hs deleted file mode 100644 index 3bc822f32..000000000 --- a/BackendType.hs +++ /dev/null @@ -1,31 +0,0 @@ -{- git-annex backend data types - - -} - -module BackendType ( - -- the entire types are exported, for use in backend implementations - Key(..), - Backend(..) -) where - -import GitRepo - --- annexed filenames are mapped into keys -type Key = FilePath - --- this structure represents a key/value backend -data Backend = Backend { - -- name of this backend - name :: String, - -- converts a filename to a key - getKey :: GitRepo -> FilePath -> IO (Maybe Key), - -- stores a file's contents to a key - storeFileKey :: GitRepo -> FilePath -> Key -> IO Bool, - -- retrieves a key's contents to a file - retrieveKeyFile :: Key -> FilePath -> IO Bool, - -- removes a key - removeKey :: Key -> IO Bool -} - -instance Show Backend where - show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" - diff --git a/BackendUrl.hs b/BackendUrl.hs index 4ba1dbadb..aad647744 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -3,8 +3,7 @@ module BackendUrl (backend) where -import BackendType -import GitRepo +import Types backend = Backend { name = "url", @@ -15,11 +14,11 @@ backend = Backend { } -- cannot generate url from filename -keyValue :: GitRepo -> FilePath -> IO (Maybe Key) +keyValue :: State -> FilePath -> IO (Maybe Key) keyValue repo file = return Nothing -- cannot change urls -dummyStore :: GitRepo -> FilePath -> Key -> IO Bool +dummyStore :: State -> FilePath -> Key -> IO Bool dummyStore repo file url = return False dummyRemove :: Key -> IO Bool dummyRemove url = return False @@ -1,14 +1,35 @@ {- git-annex core data types -} module Types ( - State(..) + State(..), + Key(..), + Backend(..) ) where -import BackendType import GitRepo -- git-annex's runtime state data State = State { repo :: GitRepo, backends :: [Backend] +} deriving (Show) + +-- annexed filenames are mapped into keys +type Key = FilePath + +-- this structure represents a key/value backend +data Backend = Backend { + -- name of this backend + name :: String, + -- converts a filename to a key + getKey :: State -> FilePath -> IO (Maybe Key), + -- stores a file's contents to a key + storeFileKey :: State -> FilePath -> Key -> IO Bool, + -- retrieves a key's contents to a file + retrieveKeyFile :: Key -> FilePath -> IO Bool, + -- removes a key + removeKey :: Key -> IO Bool } + +instance Show Backend where + show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" |