parameterize Backend type

This allows the Backend type to not depend on the Annex type, and
so the Annex type can later be moved out of TypeInternals.
This commit is contained in:
Joey Hess 2011-01-25 21:02:34 -04:00
parent f8e303e1c9
commit 109a719b03
14 changed files with 43 additions and 41 deletions

View file

@ -33,14 +33,15 @@ import Types
import qualified TypeInternals as Internals import qualified TypeInternals as Internals
{- Create and returns an Annex state object for the specified git repo. -} {- Create and returns an Annex state object for the specified git repo. -}
new :: Git.Repo -> [Backend] -> IO AnnexState new :: Git.Repo -> [Backend Annex] -> IO AnnexState
new gitrepo allbackends = do new gitrepo allbackends = do
let s = Internals.AnnexState { let s = Internals.AnnexState {
Internals.repo = gitrepo, Internals.repo = gitrepo,
Internals.backends = [], Internals.backends = [],
Internals.supportedBackends = allbackends, Internals.supportedBackends = allbackends,
Internals.flags = M.empty, Internals.flags = M.empty,
Internals.repoqueue = GitQueue.empty Internals.repoqueue = GitQueue.empty,
Internals.quiet = False
} }
(_,s') <- Annex.run s prep (_,s') <- Annex.run s prep
return s' return s'
@ -69,19 +70,19 @@ gitRepoChange r = do
put state { Internals.repo = r } put state { Internals.repo = r }
{- Returns the backends being used. -} {- Returns the backends being used. -}
backends :: Annex [Backend] backends :: Annex [Backend Annex]
backends = do backends = do
state <- get state <- get
return (Internals.backends state) return (Internals.backends state)
{- Sets the backends to use. -} {- Sets the backends to use. -}
backendsChange :: [Backend] -> Annex () backendsChange :: [Backend Annex] -> Annex ()
backendsChange b = do backendsChange b = do
state <- get state <- get
put state { Internals.backends = b } put state { Internals.backends = b }
{- Returns the full list of supported backends. -} {- Returns the full list of supported backends. -}
supportedBackends :: Annex [Backend] supportedBackends :: Annex [Backend Annex]
supportedBackends = do supportedBackends = do
state <- get state <- get
return (Internals.supportedBackends state) return (Internals.supportedBackends state)

View file

@ -42,7 +42,7 @@ import qualified TypeInternals as Internals
import Messages import Messages
{- List of backends in the order to try them when storing a new key. -} {- List of backends in the order to try them when storing a new key. -}
list :: Annex [Backend] list :: Annex [Backend Annex]
list = do list = do
l <- Annex.backends -- list is cached here l <- Annex.backends -- list is cached here
if not $ null l if not $ null l
@ -64,12 +64,12 @@ list = do
else map (lookupBackendName bs) $ words s else map (lookupBackendName bs) $ words s
{- Looks up a backend in a list. May fail if unknown. -} {- Looks up a backend in a list. May fail if unknown. -}
lookupBackendName :: [Backend] -> String -> Backend lookupBackendName :: [Backend Annex] -> String -> Backend Annex
lookupBackendName bs s = lookupBackendName bs s =
case maybeLookupBackendName bs s of case maybeLookupBackendName bs s of
Just b -> b Just b -> b
Nothing -> error $ "unknown backend " ++ s Nothing -> error $ "unknown backend " ++ s
maybeLookupBackendName :: [Backend] -> String -> Maybe Backend maybeLookupBackendName :: [Backend Annex] -> String -> Maybe (Backend Annex)
maybeLookupBackendName bs s = maybeLookupBackendName bs s =
if 1 /= length matches if 1 /= length matches
then Nothing then Nothing
@ -77,14 +77,14 @@ maybeLookupBackendName bs s =
where matches = filter (\b -> s == Internals.name b) bs where matches = filter (\b -> s == Internals.name b) bs
{- Attempts to store a file in one of the backends. -} {- Attempts to store a file in one of the backends. -}
storeFileKey :: FilePath -> Maybe Backend -> Annex (Maybe (Key, Backend)) storeFileKey :: FilePath -> Maybe (Backend Annex) -> Annex (Maybe (Key, Backend Annex))
storeFileKey file trybackend = do storeFileKey file trybackend = do
bs <- list bs <- list
let bs' = case trybackend of let bs' = case trybackend of
Nothing -> bs Nothing -> bs
Just backend -> backend:bs Just backend -> backend:bs
storeFileKey' bs' file storeFileKey' bs' file
storeFileKey' :: [Backend] -> FilePath -> Annex (Maybe (Key, Backend)) storeFileKey' :: [Backend Annex] -> FilePath -> Annex (Maybe (Key, Backend Annex))
storeFileKey' [] _ = return Nothing storeFileKey' [] _ = return Nothing
storeFileKey' (b:bs) file = do storeFileKey' (b:bs) file = do
result <- (Internals.getKey b) file result <- (Internals.getKey b) file
@ -100,11 +100,11 @@ storeFileKey' (b:bs) file = do
{- Attempts to retrieve an key from one of the backends, saving it to {- Attempts to retrieve an key from one of the backends, saving it to
- a specified location. -} - a specified location. -}
retrieveKeyFile :: Backend -> Key -> FilePath -> Annex Bool retrieveKeyFile :: Backend Annex -> Key -> FilePath -> Annex Bool
retrieveKeyFile backend key dest = (Internals.retrieveKeyFile backend) key dest retrieveKeyFile backend key dest = (Internals.retrieveKeyFile backend) key dest
{- Removes a key from a backend. -} {- Removes a key from a backend. -}
removeKey :: Backend -> Key -> Maybe Int -> Annex Bool removeKey :: Backend Annex -> Key -> Maybe Int -> Annex Bool
removeKey backend key numcopies = (Internals.removeKey backend) key numcopies removeKey backend key numcopies = (Internals.removeKey backend) key numcopies
{- Checks if a key is present in its backend. -} {- Checks if a key is present in its backend. -}
@ -114,12 +114,12 @@ hasKey key = do
(Internals.hasKey backend) key (Internals.hasKey backend) key
{- Checks a key's backend for problems. -} {- Checks a key's backend for problems. -}
fsckKey :: Backend -> Key -> Maybe Int -> Annex Bool fsckKey :: Backend Annex -> Key -> Maybe Int -> Annex Bool
fsckKey backend key numcopies = (Internals.fsckKey backend) key numcopies fsckKey backend key numcopies = (Internals.fsckKey backend) key numcopies
{- Looks up the key and backend corresponding to an annexed file, {- Looks up the key and backend corresponding to an annexed file,
- by examining what the file symlinks to. -} - by examining what the file symlinks to. -}
lookupFile :: FilePath -> Annex (Maybe (Key, Backend)) lookupFile :: FilePath -> Annex (Maybe (Key, Backend Annex))
lookupFile file = do lookupFile file = do
bs <- Annex.supportedBackends bs <- Annex.supportedBackends
tl <- liftIO $ try getsymlink tl <- liftIO $ try getsymlink
@ -147,7 +147,7 @@ lookupFile file = do
{- Looks up the backends that should be used for each file in a list. {- Looks up the backends that should be used for each file in a list.
- That can be configured on a per-file basis in the gitattributes file. - That can be configured on a per-file basis in the gitattributes file.
-} -}
chooseBackends :: [FilePath] -> Annex [(FilePath, Maybe Backend)] chooseBackends :: [FilePath] -> Annex [(FilePath, Maybe (Backend Annex))]
chooseBackends fs = do chooseBackends fs = do
g <- Annex.gitRepo g <- Annex.gitRepo
bs <- Annex.supportedBackends bs <- Annex.supportedBackends
@ -155,7 +155,7 @@ chooseBackends fs = do
return $ map (\(f,b) -> (f, maybeLookupBackendName bs b)) pairs return $ map (\(f,b) -> (f, maybeLookupBackendName bs b)) pairs
{- Returns the backend to use for a key. -} {- Returns the backend to use for a key. -}
keyBackend :: Key -> Annex Backend keyBackend :: Key -> Annex (Backend Annex)
keyBackend key = do keyBackend key = do
bs <- Annex.supportedBackends bs <- Annex.supportedBackends
return $ lookupBackendName bs $ backendName key return $ lookupBackendName bs $ backendName key

View file

@ -27,7 +27,7 @@ import qualified Annex
import UUID import UUID
import Messages import Messages
backend :: Backend backend :: Backend Annex
backend = Backend { backend = Backend {
name = mustProvide, name = mustProvide,
getKey = mustProvide, getKey = mustProvide,

View file

@ -20,7 +20,7 @@ import qualified Annex
import Locations import Locations
import Content import Content
backend :: Backend backend :: Backend Annex
backend = Backend.File.backend { backend = Backend.File.backend {
name = "SHA1", name = "SHA1",
getKey = keyValue, getKey = keyValue,

View file

@ -14,7 +14,7 @@ import TypeInternals
import Utility import Utility
import Messages import Messages
backend :: Backend backend :: Backend Annex
backend = Backend { backend = Backend {
name = "URL", name = "URL",
getKey = keyValue, getKey = keyValue,

View file

@ -21,7 +21,7 @@ import qualified Annex
import Content import Content
import Messages import Messages
backend :: Backend backend :: Backend Annex
backend = Backend.File.backend { backend = Backend.File.backend {
name = "WORM", name = "WORM",
getKey = keyValue, getKey = keyValue,

View file

@ -13,7 +13,7 @@ import qualified Backend.SHA1
import qualified Backend.URL import qualified Backend.URL
import Types import Types
allBackends :: [Backend] allBackends :: [Backend Annex]
allBackends = allBackends =
[ Backend.WORM.backend [ Backend.WORM.backend
, Backend.SHA1.backend , Backend.SHA1.backend

View file

@ -43,7 +43,7 @@ type CommandCleanup = Annex Bool
- functions. -} - functions. -}
type CommandSeekStrings = CommandStartString -> CommandSeek type CommandSeekStrings = CommandStartString -> CommandSeek
type CommandStartString = String -> CommandStart type CommandStartString = String -> CommandStart
type BackendFile = (FilePath, Maybe Backend) type BackendFile = (FilePath, Maybe (Backend Annex))
type CommandSeekBackendFiles = CommandStartBackendFile -> CommandSeek type CommandSeekBackendFiles = CommandStartBackendFile -> CommandSeek
type CommandStartBackendFile = BackendFile -> CommandStart type CommandStartBackendFile = BackendFile -> CommandStart
type AttrFile = (FilePath, String) type AttrFile = (FilePath, String)
@ -95,7 +95,7 @@ notAnnexed file a = do
Just _ -> return Nothing Just _ -> return Nothing
Nothing -> a Nothing -> a
isAnnexed :: FilePath -> ((Key, Backend) -> Annex (Maybe a)) -> Annex (Maybe a) isAnnexed :: FilePath -> ((Key, Backend Annex) -> Annex (Maybe a)) -> Annex (Maybe a)
isAnnexed file a = do isAnnexed file a = do
r <- Backend.lookupFile file r <- Backend.lookupFile file
case r of case r of

View file

@ -37,7 +37,7 @@ start (file, attr) = isAnnexed file $ \(key, backend) -> do
where where
numcopies = readMaybe attr :: Maybe Int numcopies = readMaybe attr :: Maybe Int
perform :: Key -> Backend -> Maybe Int -> CommandPerform perform :: Key -> Backend Annex -> Maybe Int -> CommandPerform
perform key backend numcopies = do perform key backend numcopies = do
success <- Backend.removeKey backend key numcopies success <- Backend.removeKey backend key numcopies
if success if success

View file

@ -28,7 +28,7 @@ start (file, attr) = isAnnexed file $ \(key, backend) -> do
where where
numcopies = readMaybe attr :: Maybe Int numcopies = readMaybe attr :: Maybe Int
perform :: Key -> Backend -> Maybe Int -> CommandPerform perform :: Key -> Backend Annex -> Maybe Int -> CommandPerform
perform key backend numcopies = do perform key backend numcopies = do
success <- Backend.fsckKey backend key numcopies success <- Backend.fsckKey backend key numcopies
if success if success

View file

@ -30,7 +30,7 @@ start file = isAnnexed file $ \(key, backend) -> do
showStart "get" file showStart "get" file
return $ Just $ perform key backend return $ Just $ perform key backend
perform :: Key -> Backend -> CommandPerform perform :: Key -> Backend Annex -> CommandPerform
perform key backend = do perform key backend = do
ok <- getViaTmp key (Backend.retrieveKeyFile backend key) ok <- getViaTmp key (Backend.retrieveKeyFile backend key)
if ok if ok

View file

@ -42,7 +42,7 @@ start (file, b) = isAnnexed file $ \(key, oldbackend) -> do
return $ head backends return $ head backends
choosebackend (Just backend) = return backend choosebackend (Just backend) = return backend
perform :: FilePath -> Key -> Backend -> CommandPerform perform :: FilePath -> Key -> Backend Annex -> CommandPerform
perform file oldkey newbackend = do perform file oldkey newbackend = do
g <- Annex.gitRepo g <- Annex.gitRepo

View file

@ -36,7 +36,7 @@ start file = isAnnexed file $ \(key, backend) -> do
return $ Just $ perform file key backend return $ Just $ perform file key backend
else return Nothing else return Nothing
perform :: FilePath -> Key -> Backend -> CommandPerform perform :: FilePath -> Key -> Backend Annex -> CommandPerform
perform file key backend = do perform file key backend = do
-- force backend to always remove -- force backend to always remove
ok <- Backend.removeKey backend key (Just 0) ok <- Backend.removeKey backend key (Just 0)

View file

@ -28,10 +28,11 @@ data Flag =
-- but it uses Backend, so has to be here to avoid a depends loop. -- but it uses Backend, so has to be here to avoid a depends loop.
data AnnexState = AnnexState { data AnnexState = AnnexState {
repo :: Git.Repo, repo :: Git.Repo,
backends :: [Backend], backends :: [Backend Annex],
supportedBackends :: [Backend], supportedBackends :: [Backend Annex],
flags :: M.Map FlagName Flag, flags :: M.Map FlagName Flag,
repoqueue :: GitQueue.Queue repoqueue :: GitQueue.Queue,
quiet :: Bool
} deriving (Show) } deriving (Show)
-- git-annex's monad -- git-annex's monad
@ -43,7 +44,7 @@ type BackendName = String
data Key = Key (BackendName, KeyName) deriving (Eq, Ord) data Key = Key (BackendName, KeyName) deriving (Eq, Ord)
-- constructs a key in a backend -- constructs a key in a backend
genKey :: Backend -> KeyName -> Key genKey :: Backend a -> KeyName -> Key
genKey b f = Key (name b,f) genKey b f = Key (name b,f)
-- show a key to convert it to a string; the string includes the -- show a key to convert it to a string; the string includes the
@ -77,28 +78,28 @@ keyName :: Key -> KeyName
keyName (Key (_,k)) = k keyName (Key (_,k)) = k
-- this structure represents a key-value backend -- this structure represents a key-value backend
data Backend = Backend { data Backend a = 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 -> Annex (Maybe Key), getKey :: FilePath -> a (Maybe Key),
-- stores a file's contents to a key -- stores a file's contents to a key
storeFileKey :: FilePath -> Key -> Annex Bool, storeFileKey :: FilePath -> Key -> a Bool,
-- retrieves a key's contents to a file -- retrieves a key's contents to a file
retrieveKeyFile :: Key -> FilePath -> Annex Bool, retrieveKeyFile :: Key -> FilePath -> a Bool,
-- removes a key, optionally checking that enough copies are stored -- removes a key, optionally checking that enough copies are stored
-- elsewhere -- elsewhere
removeKey :: Key -> Maybe Int -> Annex Bool, removeKey :: Key -> Maybe Int -> a Bool,
-- checks if a backend is storing the content of a key -- checks if a backend is storing the content of a key
hasKey :: Key -> Annex Bool, hasKey :: Key -> a Bool,
-- called during fsck to check a key -- called during fsck to check a key
-- (second parameter may be the number of copies that there should -- (second parameter may be the number of copies that there should
-- be of the key) -- be of the key)
fsckKey :: Key -> Maybe Int -> Annex Bool fsckKey :: Key -> Maybe Int -> a Bool
} }
instance Show Backend where instance Show (Backend a) where
show backend = "Backend { name =\"" ++ name backend ++ "\" }" show backend = "Backend { name =\"" ++ name backend ++ "\" }"
instance Eq Backend where instance Eq (Backend a) where
a == b = name a == name b a == b = name a == name b