diff options
author | Joey Hess <joey@kitenet.net> | 2011-01-26 00:37:50 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-01-26 00:37:50 -0400 |
commit | 616d1d4a208693c46f41781d9099c1f04ae067e6 (patch) | |
tree | 66e5fdfd24eb0f407ef491262e7798189e4821c2 | |
parent | aa2ca533bcef1848a9dc94bfea8d33a99e8f2df0 (diff) |
rename TypeInternals to BackendTypes
Now that it only contains types used by the backends
-rw-r--r-- | Annex.hs | 10 | ||||
-rw-r--r-- | Backend.hs | 16 | ||||
-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-- | BackendTypes.hs (renamed from TypeInternals.hs) | 71 | ||||
-rw-r--r-- | Types.hs | 2 | ||||
-rw-r--r-- | test.hs | 10 |
9 files changed, 58 insertions, 59 deletions
@@ -23,7 +23,7 @@ import Control.Monad.State import qualified GitRepo as Git import qualified GitQueue -import qualified TypeInternals +import qualified BackendTypes -- git-annex's monad type Annex = StateT AnnexState IO @@ -31,8 +31,8 @@ type Annex = StateT AnnexState IO -- internal state storage data AnnexState = AnnexState { repo :: Git.Repo - , backends :: [TypeInternals.Backend Annex] - , supportedBackends :: [TypeInternals.Backend Annex] + , backends :: [BackendTypes.Backend Annex] + , supportedBackends :: [BackendTypes.Backend Annex] , repoqueue :: GitQueue.Queue , quiet :: Bool , force :: Bool @@ -44,7 +44,7 @@ data AnnexState = AnnexState , remotesread :: Bool } deriving (Show) -newState :: Git.Repo -> [TypeInternals.Backend Annex] -> AnnexState +newState :: Git.Repo -> [BackendTypes.Backend Annex] -> AnnexState newState gitrepo allbackends = AnnexState { repo = gitrepo , backends = [] @@ -61,7 +61,7 @@ newState gitrepo allbackends = AnnexState } {- Create and returns an Annex state object for the specified git repo. -} -new :: Git.Repo -> [TypeInternals.Backend Annex] -> IO AnnexState +new :: Git.Repo -> [BackendTypes.Backend Annex] -> IO AnnexState new gitrepo allbackends = do gitrepo' <- liftIO $ Git.configRead gitrepo return $ newState gitrepo' allbackends diff --git a/Backend.hs b/Backend.hs index 055c5b8ab..d9bf35f0d 100644 --- a/Backend.hs +++ b/Backend.hs @@ -38,7 +38,7 @@ import Locations import qualified GitRepo as Git import qualified Annex import Types -import qualified TypeInternals as Internals +import qualified BackendTypes as B import Messages {- List of backends in the order to try them when storing a new key. -} @@ -78,7 +78,7 @@ maybeLookupBackendName bs s = if 1 /= length matches then Nothing else Just $ head matches - where matches = filter (\b -> s == Internals.name b) bs + where matches = filter (\b -> s == B.name b) bs {- Attempts to store a file in one of the backends. -} storeFileKey :: FilePath -> Maybe (Backend Annex) -> Annex (Maybe (Key, Backend Annex)) @@ -91,11 +91,11 @@ storeFileKey file trybackend = do storeFileKey' :: [Backend Annex] -> FilePath -> Annex (Maybe (Key, Backend Annex)) storeFileKey' [] _ = return Nothing storeFileKey' (b:bs) file = do - result <- (Internals.getKey b) file + result <- (B.getKey b) file case result of Nothing -> nextbackend Just key -> do - stored <- (Internals.storeFileKey b) file key + stored <- (B.storeFileKey b) file key if (not stored) then nextbackend else return $ Just (key, b) @@ -105,21 +105,21 @@ storeFileKey' (b:bs) file = do {- Attempts to retrieve an key from one of the backends, saving it to - a specified location. -} retrieveKeyFile :: Backend Annex -> Key -> FilePath -> Annex Bool -retrieveKeyFile backend key dest = (Internals.retrieveKeyFile backend) key dest +retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest {- Removes a key from a backend. -} removeKey :: Backend Annex -> Key -> Maybe Int -> Annex Bool -removeKey backend key numcopies = (Internals.removeKey backend) key numcopies +removeKey backend key numcopies = (B.removeKey backend) key numcopies {- Checks if a key is present in its backend. -} hasKey :: Key -> Annex Bool hasKey key = do backend <- keyBackend key - (Internals.hasKey backend) key + (B.hasKey backend) key {- Checks a key's backend for problems. -} fsckKey :: Backend Annex -> Key -> Maybe Int -> Annex Bool -fsckKey backend key numcopies = (Internals.fsckKey backend) key numcopies +fsckKey backend key numcopies = (B.fsckKey backend) key numcopies {- Looks up the key and backend corresponding to an annexed file, - by examining what the file symlinks to. -} diff --git a/Backend/File.hs b/Backend/File.hs index d0c1e0e22..ac6e4a910 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -17,7 +17,7 @@ module Backend.File (backend, checkKey) where import Control.Monad.State import System.Directory -import TypeInternals +import BackendTypes import LocationLog import Locations import qualified Remotes diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs index be41264b0..f8dbea4b0 100644 --- a/Backend/SHA1.hs +++ b/Backend/SHA1.hs @@ -14,7 +14,7 @@ import System.IO import System.Directory import qualified Backend.File -import TypeInternals +import BackendTypes import Messages import qualified Annex import Locations diff --git a/Backend/URL.hs b/Backend/URL.hs index d67b7db84..45a204b07 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -11,7 +11,7 @@ import Control.Monad.State (liftIO) import Data.String.Utils import Types -import TypeInternals +import BackendTypes import Utility import Messages diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 011018393..56f243396 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -15,7 +15,7 @@ import System.Directory import Data.String.Utils import qualified Backend.File -import TypeInternals +import BackendTypes import Locations import qualified Annex import Content diff --git a/TypeInternals.hs b/BackendTypes.hs index d3592f482..e4b155f98 100644 --- a/TypeInternals.hs +++ b/BackendTypes.hs @@ -1,22 +1,53 @@ -{- git-annex internal data types +{- git-annex key/value backend data types - - - Most things should not need this, using Types and/or Annex instead. + - Most things should not need this, using Types instead - - Copyright 2010 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} -module TypeInternals where +module BackendTypes where import Data.String.Utils import Test.QuickCheck --- annexed filenames are mapped through a backend into keys type KeyName = String type BackendName = String data Key = Key (BackendName, KeyName) deriving (Eq, Ord) +data Backend a = Backend { + -- name of this backend + name :: String, + -- converts a filename to a key + getKey :: FilePath -> a (Maybe Key), + -- stores a file's contents to a key + storeFileKey :: FilePath -> Key -> a Bool, + -- retrieves a key's contents to a file + retrieveKeyFile :: Key -> FilePath -> a Bool, + -- removes a key, optionally checking that enough copies are stored + -- elsewhere + removeKey :: Key -> Maybe Int -> a Bool, + -- checks if a backend is storing the content of a key + 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 -> a Bool +} + +instance Show (Backend a) where + show backend = "Backend { name =\"" ++ name backend ++ "\" }" + +instance Eq (Backend a) where + a == b = name a == name b + +-- accessors for the parts of a key +keyName :: Key -> KeyName +keyName (Key (_,k)) = k +backendName :: Key -> BackendName +backendName (Key (b,_)) = b + -- constructs a key in a backend genKey :: Backend a -> KeyName -> Key genKey b f = Key (name b,f) @@ -45,35 +76,3 @@ prop_idempotent_key_read_show k -- backend names will never contain colons | elem ':' (backendName k) = True | otherwise = k == (read $ show k) - -backendName :: Key -> BackendName -backendName (Key (b,_)) = b -keyName :: Key -> KeyName -keyName (Key (_,k)) = k - --- this structure represents a key-value backend -data Backend a = Backend { - -- name of this backend - name :: String, - -- converts a filename to a key - getKey :: FilePath -> a (Maybe Key), - -- stores a file's contents to a key - storeFileKey :: FilePath -> Key -> a Bool, - -- retrieves a key's contents to a file - retrieveKeyFile :: Key -> FilePath -> a Bool, - -- removes a key, optionally checking that enough copies are stored - -- elsewhere - removeKey :: Key -> Maybe Int -> a Bool, - -- checks if a backend is storing the content of a key - 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 -> a Bool -} - -instance Show (Backend a) where - show backend = "Backend { name =\"" ++ name backend ++ "\" }" - -instance Eq (Backend a) where - a == b = name a == name b @@ -14,5 +14,5 @@ module Types ( keyName ) where -import TypeInternals +import BackendTypes import Annex @@ -27,7 +27,7 @@ import qualified Backend import qualified GitRepo as Git import qualified Locations import qualified Utility -import qualified TypeInternals +import qualified BackendTypes import qualified Types import qualified GitAnnex import qualified LocationLog @@ -54,7 +54,7 @@ quickchecks :: Test quickchecks = TestLabel "quickchecks" $ TestList [ qctest "prop_idempotent_deencode" Git.prop_idempotent_deencode , qctest "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey - , qctest "prop_idempotent_key_read_show" TypeInternals.prop_idempotent_key_read_show + , qctest "prop_idempotent_key_read_show" BackendTypes.prop_idempotent_key_read_show , qctest "prop_idempotent_shellEscape" Utility.prop_idempotent_shellEscape , qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword , qctest "prop_parentDir_basics" Utility.prop_parentDir_basics @@ -106,8 +106,8 @@ test_add = "git-annex add" ~: TestCase $ inmainrepo $ do test_setkey :: Test test_setkey = "git-annex setkey/fromkey" ~: TestCase $ inmainrepo $ do writeFile tmp $ content sha1annexedfile - r <- annexeval $ TypeInternals.getKey Backend.SHA1.backend tmp - let sha1 = TypeInternals.keyName $ fromJust r + r <- annexeval $ BackendTypes.getKey Backend.SHA1.backend tmp + let sha1 = BackendTypes.keyName $ fromJust r git_annex "setkey" ["-q", "--backend", "SHA1", "--key", sha1, tmp] @? "setkey failed" git_annex "fromkey" ["-q", "--backend", "SHA1", "--key", sha1, sha1annexedfile] @? "fromkey failed" Utility.boolSystem "git" ["commit", "-q", "-a", "-m", "commit"] @? "git commit failed" @@ -384,7 +384,7 @@ test_unused = "git-annex unused/dropunused" ~: intmpclonerepo $ do checkunused [annexedfilekey, sha1annexedfilekey] -- good opportunity to test dropkey also - git_annex "dropkey" ["-q", "--force", TypeInternals.keyName annexedfilekey] + git_annex "dropkey" ["-q", "--force", BackendTypes.keyName annexedfilekey] @? "dropkey failed" checkunused [sha1annexedfilekey] |