thread State thru to backends
This commit is contained in:
parent
759f146d0f
commit
2ac47a3a59
8 changed files with 67 additions and 77 deletions
10
Annex.hs
10
Annex.hs
|
@ -45,12 +45,12 @@ startAnnex = do
|
||||||
- the annex directory and setting up the symlink pointing to its content. -}
|
- the annex directory and setting up the symlink pointing to its content. -}
|
||||||
annexFile :: State -> FilePath -> IO ()
|
annexFile :: State -> FilePath -> IO ()
|
||||||
annexFile state file = do
|
annexFile state file = do
|
||||||
alreadyannexed <- lookupBackend (backends state) (repo state) file
|
alreadyannexed <- lookupBackend (backends state) state file
|
||||||
case (alreadyannexed) of
|
case (alreadyannexed) of
|
||||||
Just _ -> error $ "already annexed: " ++ file
|
Just _ -> error $ "already annexed: " ++ file
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
checkLegal file
|
checkLegal file
|
||||||
stored <- storeFile (backends state) (repo state) file
|
stored <- storeFile (backends state) state file
|
||||||
case (stored) of
|
case (stored) of
|
||||||
Nothing -> error $ "no backend could store: " ++ file
|
Nothing -> error $ "no backend could store: " ++ file
|
||||||
Just key -> symlink key
|
Just key -> symlink key
|
||||||
|
@ -70,11 +70,11 @@ annexFile state file = do
|
||||||
{- Inverse of annexFile. -}
|
{- Inverse of annexFile. -}
|
||||||
unannexFile :: State -> FilePath -> IO ()
|
unannexFile :: State -> FilePath -> IO ()
|
||||||
unannexFile state file = do
|
unannexFile state file = do
|
||||||
alreadyannexed <- lookupBackend (backends state) (repo state) file
|
alreadyannexed <- lookupBackend (backends state) state file
|
||||||
case (alreadyannexed) of
|
case (alreadyannexed) of
|
||||||
Nothing -> error $ "not annexed " ++ file
|
Nothing -> error $ "not annexed " ++ file
|
||||||
Just _ -> do
|
Just _ -> do
|
||||||
mkey <- dropFile (backends state) (repo state) file
|
mkey <- dropFile (backends state) state file
|
||||||
case (mkey) of
|
case (mkey) of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just key -> do
|
Just key -> do
|
||||||
|
@ -86,7 +86,7 @@ unannexFile state file = do
|
||||||
{- Transfers the file from a remote. -}
|
{- Transfers the file from a remote. -}
|
||||||
annexGetFile :: State -> FilePath -> IO ()
|
annexGetFile :: State -> FilePath -> IO ()
|
||||||
annexGetFile state file = do
|
annexGetFile state file = do
|
||||||
alreadyannexed <- lookupBackend (backends state) (repo state) file
|
alreadyannexed <- lookupBackend (backends state) state file
|
||||||
case (alreadyannexed) of
|
case (alreadyannexed) of
|
||||||
Nothing -> error $ "not annexed " ++ file
|
Nothing -> error $ "not annexed " ++ file
|
||||||
Just _ -> do error "not implemented" -- TODO
|
Just _ -> do error "not implemented" -- TODO
|
||||||
|
|
55
Backend.hs
55
Backend.hs
|
@ -28,74 +28,75 @@ import System.Directory
|
||||||
import Locations
|
import Locations
|
||||||
import GitRepo
|
import GitRepo
|
||||||
import Utility
|
import Utility
|
||||||
import BackendType
|
import Types
|
||||||
|
|
||||||
{- Name of state file that holds the key for an annexed file,
|
{- Name of state file that holds the key for an annexed file,
|
||||||
- using a given backend. -}
|
- using a given backend. -}
|
||||||
backendFile :: Backend -> GitRepo -> FilePath -> String
|
backendFile :: Backend -> State -> FilePath -> String
|
||||||
backendFile backend repo file = gitStateDir repo ++
|
backendFile backend state file =
|
||||||
(gitRelative repo file) ++ "." ++ (name backend)
|
gitStateDir (repo state) ++ (gitRelative (repo state) file) ++
|
||||||
|
"." ++ (name backend)
|
||||||
|
|
||||||
{- Attempts to store a file in one of the backends, and returns
|
{- Attempts to store a file in one of the backends, and returns
|
||||||
- its key. -}
|
- its key. -}
|
||||||
storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key)
|
storeFile :: [Backend] -> State -> FilePath -> IO (Maybe Key)
|
||||||
storeFile [] _ _ = return Nothing
|
storeFile [] _ _ = return Nothing
|
||||||
storeFile (b:bs) repo file = do
|
storeFile (b:bs) state file = do
|
||||||
try <- (getKey b) repo (gitRelative repo file)
|
try <- (getKey b) state (gitRelative (repo state) file)
|
||||||
case (try) of
|
case (try) of
|
||||||
Nothing -> nextbackend
|
Nothing -> nextbackend
|
||||||
Just key -> do
|
Just key -> do
|
||||||
stored <- (storeFileKey b) repo file key
|
stored <- (storeFileKey b) state file key
|
||||||
if (not stored)
|
if (not stored)
|
||||||
then nextbackend
|
then nextbackend
|
||||||
else do
|
else do
|
||||||
bookkeeping key
|
bookkeeping key
|
||||||
return $ Just key
|
return $ Just key
|
||||||
where
|
where
|
||||||
nextbackend = storeFile bs repo file
|
nextbackend = storeFile bs state file
|
||||||
backendfile = backendFile b repo file
|
backendfile = backendFile b state file
|
||||||
bookkeeping key = do
|
bookkeeping key = do
|
||||||
createDirectoryIfMissing True (parentDir backendfile)
|
createDirectoryIfMissing True (parentDir backendfile)
|
||||||
writeFile backendfile key
|
writeFile backendfile key
|
||||||
|
|
||||||
{- Attempts to retrieve an file from one of the backends, saving it to
|
{- Attempts to retrieve an file from one of the backends, saving it to
|
||||||
- a specified location. -}
|
- a specified location. -}
|
||||||
retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO Bool
|
retrieveFile :: [Backend] -> State -> FilePath -> FilePath -> IO Bool
|
||||||
retrieveFile backends repo file dest = do
|
retrieveFile backends state file dest = do
|
||||||
result <- lookupBackend backends repo file
|
result <- lookupBackend backends state file
|
||||||
case (result) of
|
case (result) of
|
||||||
Nothing -> return False
|
Nothing -> return False
|
||||||
Just b -> do
|
Just b -> do
|
||||||
key <- lookupKey b repo file
|
key <- lookupKey b state file
|
||||||
(retrieveKeyFile b) key dest
|
(retrieveKeyFile b) key dest
|
||||||
|
|
||||||
{- Drops the key for a file from the backend that has it. -}
|
{- Drops the key for a file from the backend that has it. -}
|
||||||
dropFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key)
|
dropFile :: [Backend] -> State -> FilePath -> IO (Maybe Key)
|
||||||
dropFile backends repo file = do
|
dropFile backends state file = do
|
||||||
result <- lookupBackend backends repo file
|
result <- lookupBackend backends state file
|
||||||
case (result) of
|
case (result) of
|
||||||
Nothing -> return Nothing
|
Nothing -> return Nothing
|
||||||
Just b -> do
|
Just b -> do
|
||||||
key <- lookupKey b repo file
|
key <- lookupKey b state file
|
||||||
(removeKey b) key
|
(removeKey b) key
|
||||||
removeFile $ backendFile b repo file
|
removeFile $ backendFile b state file
|
||||||
return $ Just key
|
return $ Just key
|
||||||
|
|
||||||
{- Looks up the key a backend uses for an already annexed file. -}
|
{- Looks up the key a backend uses for an already annexed file. -}
|
||||||
lookupKey :: Backend -> GitRepo -> FilePath -> IO Key
|
lookupKey :: Backend -> State -> FilePath -> IO Key
|
||||||
lookupKey backend repo file = readFile (backendFile backend repo file)
|
lookupKey backend state file = readFile (backendFile backend state file)
|
||||||
|
|
||||||
{- Looks up the backend used for an already annexed 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 [] _ _ = return Nothing
|
||||||
lookupBackend (b:bs) repo file = do
|
lookupBackend (b:bs) state file = do
|
||||||
present <- checkBackend b repo file
|
present <- checkBackend b state file
|
||||||
if present
|
if present
|
||||||
then
|
then
|
||||||
return $ Just b
|
return $ Just b
|
||||||
else
|
else
|
||||||
lookupBackend bs repo file
|
lookupBackend bs state file
|
||||||
|
|
||||||
{- Checks if a file is available via a given backend. -}
|
{- Checks if a file is available via a given backend. -}
|
||||||
checkBackend :: Backend -> GitRepo -> FilePath -> IO (Bool)
|
checkBackend :: Backend -> State -> FilePath -> IO (Bool)
|
||||||
checkBackend backend repo file = doesFileExist $ backendFile backend repo file
|
checkBackend backend state file = doesFileExist $ backendFile backend state file
|
||||||
|
|
|
@ -5,7 +5,7 @@ module BackendChecksum (backend) where
|
||||||
|
|
||||||
import qualified BackendFile
|
import qualified BackendFile
|
||||||
import Data.Digest.Pure.SHA
|
import Data.Digest.Pure.SHA
|
||||||
import BackendType
|
import Types
|
||||||
import GitRepo
|
import GitRepo
|
||||||
|
|
||||||
-- based on BackendFile just with a different key type
|
-- based on BackendFile just with a different key type
|
||||||
|
@ -15,5 +15,5 @@ backend = BackendFile.backend {
|
||||||
}
|
}
|
||||||
|
|
||||||
-- checksum the file to get its key
|
-- 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
|
keyValue k = error "checksum keyValue unimplemented" -- TODO
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
|
|
||||||
module BackendFile (backend) where
|
module BackendFile (backend) where
|
||||||
|
|
||||||
import BackendType
|
import Types
|
||||||
import GitRepo
|
import GitRepo
|
||||||
|
|
||||||
backend = Backend {
|
backend = Backend {
|
||||||
|
@ -15,15 +15,15 @@ backend = Backend {
|
||||||
}
|
}
|
||||||
|
|
||||||
-- direct mapping from filename to key
|
-- direct mapping from filename to key
|
||||||
keyValue :: GitRepo -> FilePath -> IO (Maybe Key)
|
keyValue :: State -> FilePath -> IO (Maybe Key)
|
||||||
keyValue repo file = return $ Just file
|
keyValue state file = return $ Just file
|
||||||
|
|
||||||
{- This backend does not really do any independant data storage,
|
{- This backend does not really do any independant data storage,
|
||||||
- it relies on the file contents in .git/annex/ in this repo,
|
- it relies on the file contents in .git/annex/ in this repo,
|
||||||
- and other accessible repos. So storing or removing a key is
|
- and other accessible repos. So storing or removing a key is
|
||||||
- a no-op. -}
|
- a no-op. -}
|
||||||
dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool)
|
dummyStore :: State -> FilePath -> Key -> IO (Bool)
|
||||||
dummyStore repo file key = return True
|
dummyStore state file key = return True
|
||||||
dummyRemove :: Key -> IO Bool
|
dummyRemove :: Key -> IO Bool
|
||||||
dummyRemove url = return False
|
dummyRemove url = return False
|
||||||
|
|
||||||
|
|
|
@ -7,7 +7,7 @@ module BackendList (
|
||||||
lookupBackendName
|
lookupBackendName
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import BackendType
|
import Types
|
||||||
|
|
||||||
-- When adding a new backend, import it here and add it to the list.
|
-- When adding a new backend, import it here and add it to the list.
|
||||||
import qualified BackendFile
|
import qualified BackendFile
|
||||||
|
|
|
@ -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) ++ "\" }"
|
|
||||||
|
|
|
@ -3,8 +3,7 @@
|
||||||
|
|
||||||
module BackendUrl (backend) where
|
module BackendUrl (backend) where
|
||||||
|
|
||||||
import BackendType
|
import Types
|
||||||
import GitRepo
|
|
||||||
|
|
||||||
backend = Backend {
|
backend = Backend {
|
||||||
name = "url",
|
name = "url",
|
||||||
|
@ -15,11 +14,11 @@ backend = Backend {
|
||||||
}
|
}
|
||||||
|
|
||||||
-- cannot generate url from filename
|
-- cannot generate url from filename
|
||||||
keyValue :: GitRepo -> FilePath -> IO (Maybe Key)
|
keyValue :: State -> FilePath -> IO (Maybe Key)
|
||||||
keyValue repo file = return Nothing
|
keyValue repo file = return Nothing
|
||||||
|
|
||||||
-- cannot change urls
|
-- cannot change urls
|
||||||
dummyStore :: GitRepo -> FilePath -> Key -> IO Bool
|
dummyStore :: State -> FilePath -> Key -> IO Bool
|
||||||
dummyStore repo file url = return False
|
dummyStore repo file url = return False
|
||||||
dummyRemove :: Key -> IO Bool
|
dummyRemove :: Key -> IO Bool
|
||||||
dummyRemove url = return False
|
dummyRemove url = return False
|
||||||
|
|
25
Types.hs
25
Types.hs
|
@ -1,14 +1,35 @@
|
||||||
{- git-annex core data types -}
|
{- git-annex core data types -}
|
||||||
|
|
||||||
module Types (
|
module Types (
|
||||||
State(..)
|
State(..),
|
||||||
|
Key(..),
|
||||||
|
Backend(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import BackendType
|
|
||||||
import GitRepo
|
import GitRepo
|
||||||
|
|
||||||
-- git-annex's runtime state
|
-- git-annex's runtime state
|
||||||
data State = State {
|
data State = State {
|
||||||
repo :: GitRepo,
|
repo :: GitRepo,
|
||||||
backends :: [Backend]
|
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) ++ "\" }"
|
||||||
|
|
Loading…
Reference in a new issue