diff options
| -rw-r--r-- | Annex.hs | 11 | ||||
| -rw-r--r-- | Backend.hs | 22 | ||||
| -rw-r--r-- | Backend/File.hs | 2 | ||||
| -rw-r--r-- | Backend/SHA1.hs | 2 | ||||
| -rw-r--r-- | Backend/URL.hs | 2 | ||||
| -rw-r--r-- | Backend/WORM.hs | 2 | ||||
| -rw-r--r-- | BackendList.hs | 2 | ||||
| -rw-r--r-- | Command.hs | 4 | ||||
| -rw-r--r-- | Command/Drop.hs | 2 | ||||
| -rw-r--r-- | Command/Fsck.hs | 2 | ||||
| -rw-r--r-- | Command/Get.hs | 2 | ||||
| -rw-r--r-- | Command/Migrate.hs | 2 | ||||
| -rw-r--r-- | Command/Unannex.hs | 2 | ||||
| -rw-r--r-- | TypeInternals.hs | 27 |
14 files changed, 43 insertions, 41 deletions
@@ -33,14 +33,15 @@ import Types import qualified TypeInternals as Internals {- 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 let s = Internals.AnnexState { Internals.repo = gitrepo, Internals.backends = [], Internals.supportedBackends = allbackends, Internals.flags = M.empty, - Internals.repoqueue = GitQueue.empty + Internals.repoqueue = GitQueue.empty, + Internals.quiet = False } (_,s') <- Annex.run s prep return s' @@ -69,19 +70,19 @@ gitRepoChange r = do put state { Internals.repo = r } {- Returns the backends being used. -} -backends :: Annex [Backend] +backends :: Annex [Backend Annex] backends = do state <- get return (Internals.backends state) {- Sets the backends to use. -} -backendsChange :: [Backend] -> Annex () +backendsChange :: [Backend Annex] -> Annex () backendsChange b = do state <- get put state { Internals.backends = b } {- Returns the full list of supported backends. -} -supportedBackends :: Annex [Backend] +supportedBackends :: Annex [Backend Annex] supportedBackends = do state <- get return (Internals.supportedBackends state) diff --git a/Backend.hs b/Backend.hs index a417c7247..caf50005a 100644 --- a/Backend.hs +++ b/Backend.hs @@ -42,7 +42,7 @@ import qualified TypeInternals as Internals import Messages {- List of backends in the order to try them when storing a new key. -} -list :: Annex [Backend] +list :: Annex [Backend Annex] list = do l <- Annex.backends -- list is cached here if not $ null l @@ -64,12 +64,12 @@ list = do else map (lookupBackendName bs) $ words s {- Looks up a backend in a list. May fail if unknown. -} -lookupBackendName :: [Backend] -> String -> Backend +lookupBackendName :: [Backend Annex] -> String -> Backend Annex lookupBackendName bs s = case maybeLookupBackendName bs s of Just b -> b Nothing -> error $ "unknown backend " ++ s -maybeLookupBackendName :: [Backend] -> String -> Maybe Backend +maybeLookupBackendName :: [Backend Annex] -> String -> Maybe (Backend Annex) maybeLookupBackendName bs s = if 1 /= length matches then Nothing @@ -77,14 +77,14 @@ maybeLookupBackendName bs s = where matches = filter (\b -> s == Internals.name b) bs {- 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 bs <- list let bs' = case trybackend of Nothing -> bs Just backend -> backend:bs storeFileKey' bs' file -storeFileKey' :: [Backend] -> FilePath -> Annex (Maybe (Key, Backend)) +storeFileKey' :: [Backend Annex] -> FilePath -> Annex (Maybe (Key, Backend Annex)) storeFileKey' [] _ = return Nothing storeFileKey' (b:bs) file = do 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 - 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 {- 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 {- Checks if a key is present in its backend. -} @@ -114,12 +114,12 @@ hasKey key = do (Internals.hasKey backend) key {- 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 {- Looks up the key and backend corresponding to an annexed file, - by examining what the file symlinks to. -} -lookupFile :: FilePath -> Annex (Maybe (Key, Backend)) +lookupFile :: FilePath -> Annex (Maybe (Key, Backend Annex)) lookupFile file = do bs <- Annex.supportedBackends 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. - 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 g <- Annex.gitRepo bs <- Annex.supportedBackends @@ -155,7 +155,7 @@ chooseBackends fs = do return $ map (\(f,b) -> (f, maybeLookupBackendName bs b)) pairs {- Returns the backend to use for a key. -} -keyBackend :: Key -> Annex Backend +keyBackend :: Key -> Annex (Backend Annex) keyBackend key = do bs <- Annex.supportedBackends return $ lookupBackendName bs $ backendName key diff --git a/Backend/File.hs b/Backend/File.hs index 27b2a6901..c8ddd5938 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -27,7 +27,7 @@ import qualified Annex import UUID import Messages -backend :: Backend +backend :: Backend Annex backend = Backend { name = mustProvide, getKey = mustProvide, diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs index 2f3e2cf53..e665e5da7 100644 --- a/Backend/SHA1.hs +++ b/Backend/SHA1.hs @@ -20,7 +20,7 @@ import qualified Annex import Locations import Content -backend :: Backend +backend :: Backend Annex backend = Backend.File.backend { name = "SHA1", getKey = keyValue, diff --git a/Backend/URL.hs b/Backend/URL.hs index 3eb7376e0..8ed354aed 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -14,7 +14,7 @@ import TypeInternals import Utility import Messages -backend :: Backend +backend :: Backend Annex backend = Backend { name = "URL", getKey = keyValue, diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 0c9301238..cd4254e2b 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -21,7 +21,7 @@ import qualified Annex import Content import Messages -backend :: Backend +backend :: Backend Annex backend = Backend.File.backend { name = "WORM", getKey = keyValue, diff --git a/BackendList.hs b/BackendList.hs index d1180d22f..5ae78bcc7 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -13,7 +13,7 @@ import qualified Backend.SHA1 import qualified Backend.URL import Types -allBackends :: [Backend] +allBackends :: [Backend Annex] allBackends = [ Backend.WORM.backend , Backend.SHA1.backend diff --git a/Command.hs b/Command.hs index 9fafb18ef..06fc704bd 100644 --- a/Command.hs +++ b/Command.hs @@ -43,7 +43,7 @@ type CommandCleanup = Annex Bool - functions. -} type CommandSeekStrings = CommandStartString -> CommandSeek type CommandStartString = String -> CommandStart -type BackendFile = (FilePath, Maybe Backend) +type BackendFile = (FilePath, Maybe (Backend Annex)) type CommandSeekBackendFiles = CommandStartBackendFile -> CommandSeek type CommandStartBackendFile = BackendFile -> CommandStart type AttrFile = (FilePath, String) @@ -95,7 +95,7 @@ notAnnexed file a = do Just _ -> return Nothing 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 r <- Backend.lookupFile file case r of diff --git a/Command/Drop.hs b/Command/Drop.hs index 065e1743a..fdc55969f 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -37,7 +37,7 @@ start (file, attr) = isAnnexed file $ \(key, backend) -> do where numcopies = readMaybe attr :: Maybe Int -perform :: Key -> Backend -> Maybe Int -> CommandPerform +perform :: Key -> Backend Annex -> Maybe Int -> CommandPerform perform key backend numcopies = do success <- Backend.removeKey backend key numcopies if success diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 662c281c2..fc9bd7f52 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -28,7 +28,7 @@ start (file, attr) = isAnnexed file $ \(key, backend) -> do where numcopies = readMaybe attr :: Maybe Int -perform :: Key -> Backend -> Maybe Int -> CommandPerform +perform :: Key -> Backend Annex -> Maybe Int -> CommandPerform perform key backend numcopies = do success <- Backend.fsckKey backend key numcopies if success diff --git a/Command/Get.hs b/Command/Get.hs index e0af6c407..2aa3c0c15 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -30,7 +30,7 @@ start file = isAnnexed file $ \(key, backend) -> do showStart "get" file return $ Just $ perform key backend -perform :: Key -> Backend -> CommandPerform +perform :: Key -> Backend Annex -> CommandPerform perform key backend = do ok <- getViaTmp key (Backend.retrieveKeyFile backend key) if ok diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 5bc54ceab..566b508c0 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -42,7 +42,7 @@ start (file, b) = isAnnexed file $ \(key, oldbackend) -> do return $ head backends choosebackend (Just backend) = return backend -perform :: FilePath -> Key -> Backend -> CommandPerform +perform :: FilePath -> Key -> Backend Annex -> CommandPerform perform file oldkey newbackend = do g <- Annex.gitRepo diff --git a/Command/Unannex.hs b/Command/Unannex.hs index cdd577ba8..413443969 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -36,7 +36,7 @@ start file = isAnnexed file $ \(key, backend) -> do return $ Just $ perform file key backend else return Nothing -perform :: FilePath -> Key -> Backend -> CommandPerform +perform :: FilePath -> Key -> Backend Annex -> CommandPerform perform file key backend = do -- force backend to always remove ok <- Backend.removeKey backend key (Just 0) diff --git a/TypeInternals.hs b/TypeInternals.hs index 44db743fa..99f304973 100644 --- a/TypeInternals.hs +++ b/TypeInternals.hs @@ -28,10 +28,11 @@ data Flag = -- but it uses Backend, so has to be here to avoid a depends loop. data AnnexState = AnnexState { repo :: Git.Repo, - backends :: [Backend], - supportedBackends :: [Backend], + backends :: [Backend Annex], + supportedBackends :: [Backend Annex], flags :: M.Map FlagName Flag, - repoqueue :: GitQueue.Queue + repoqueue :: GitQueue.Queue, + quiet :: Bool } deriving (Show) -- git-annex's monad @@ -43,7 +44,7 @@ type BackendName = String data Key = Key (BackendName, KeyName) deriving (Eq, Ord) -- constructs a key in a backend -genKey :: Backend -> KeyName -> Key +genKey :: Backend a -> KeyName -> Key genKey b f = Key (name b,f) -- show a key to convert it to a string; the string includes the @@ -77,28 +78,28 @@ keyName :: Key -> KeyName keyName (Key (_,k)) = k -- this structure represents a key-value backend -data Backend = Backend { +data Backend a = Backend { -- name of this backend name :: String, -- converts a filename to a key - getKey :: FilePath -> Annex (Maybe Key), + getKey :: FilePath -> a (Maybe 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 - retrieveKeyFile :: Key -> FilePath -> Annex Bool, + retrieveKeyFile :: Key -> FilePath -> a Bool, -- removes a key, optionally checking that enough copies are stored -- elsewhere - removeKey :: Key -> Maybe Int -> Annex Bool, + removeKey :: Key -> Maybe Int -> a Bool, -- 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 -- (second parameter may be the number of copies that there should -- 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 ++ "\" }" -instance Eq Backend where +instance Eq (Backend a) where a == b = name a == name b |