rename TypeInternals to BackendTypes

Now that it only contains types used by the backends
This commit is contained in:
Joey Hess 2011-01-26 00:37:50 -04:00
parent aa2ca533bc
commit 616d1d4a20
9 changed files with 58 additions and 59 deletions

View file

@ -23,7 +23,7 @@ import Control.Monad.State
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified GitQueue import qualified GitQueue
import qualified TypeInternals import qualified BackendTypes
-- git-annex's monad -- git-annex's monad
type Annex = StateT AnnexState IO type Annex = StateT AnnexState IO
@ -31,8 +31,8 @@ type Annex = StateT AnnexState IO
-- internal state storage -- internal state storage
data AnnexState = AnnexState data AnnexState = AnnexState
{ repo :: Git.Repo { repo :: Git.Repo
, backends :: [TypeInternals.Backend Annex] , backends :: [BackendTypes.Backend Annex]
, supportedBackends :: [TypeInternals.Backend Annex] , supportedBackends :: [BackendTypes.Backend Annex]
, repoqueue :: GitQueue.Queue , repoqueue :: GitQueue.Queue
, quiet :: Bool , quiet :: Bool
, force :: Bool , force :: Bool
@ -44,7 +44,7 @@ data AnnexState = AnnexState
, remotesread :: Bool , remotesread :: Bool
} deriving (Show) } deriving (Show)
newState :: Git.Repo -> [TypeInternals.Backend Annex] -> AnnexState newState :: Git.Repo -> [BackendTypes.Backend Annex] -> AnnexState
newState gitrepo allbackends = AnnexState newState gitrepo allbackends = AnnexState
{ repo = gitrepo { repo = gitrepo
, backends = [] , backends = []
@ -61,7 +61,7 @@ newState gitrepo allbackends = AnnexState
} }
{- 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 -> [TypeInternals.Backend Annex] -> IO AnnexState new :: Git.Repo -> [BackendTypes.Backend Annex] -> IO AnnexState
new gitrepo allbackends = do new gitrepo allbackends = do
gitrepo' <- liftIO $ Git.configRead gitrepo gitrepo' <- liftIO $ Git.configRead gitrepo
return $ newState gitrepo' allbackends return $ newState gitrepo' allbackends

View file

@ -38,7 +38,7 @@ import Locations
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified Annex import qualified Annex
import Types import Types
import qualified TypeInternals as Internals import qualified BackendTypes as B
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. -}
@ -78,7 +78,7 @@ maybeLookupBackendName bs s =
if 1 /= length matches if 1 /= length matches
then Nothing then Nothing
else Just $ head matches 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. -} {- Attempts to store a file in one of the backends. -}
storeFileKey :: FilePath -> Maybe (Backend Annex) -> Annex (Maybe (Key, Backend Annex)) 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' :: [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 <- (B.getKey b) file
case result of case result of
Nothing -> nextbackend Nothing -> nextbackend
Just key -> do Just key -> do
stored <- (Internals.storeFileKey b) file key stored <- (B.storeFileKey b) file key
if (not stored) if (not stored)
then nextbackend then nextbackend
else return $ Just (key, b) 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 {- Attempts to retrieve an key from one of the backends, saving it to
- a specified location. -} - a specified location. -}
retrieveKeyFile :: Backend Annex -> Key -> FilePath -> Annex Bool 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. -} {- Removes a key from a backend. -}
removeKey :: Backend Annex -> 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 = (B.removeKey backend) key numcopies
{- Checks if a key is present in its backend. -} {- Checks if a key is present in its backend. -}
hasKey :: Key -> Annex Bool hasKey :: Key -> Annex Bool
hasKey key = do hasKey key = do
backend <- keyBackend key backend <- keyBackend key
(Internals.hasKey backend) key (B.hasKey backend) key
{- Checks a key's backend for problems. -} {- Checks a key's backend for problems. -}
fsckKey :: Backend Annex -> 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 = (B.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. -}

View file

@ -17,7 +17,7 @@ module Backend.File (backend, checkKey) where
import Control.Monad.State import Control.Monad.State
import System.Directory import System.Directory
import TypeInternals import BackendTypes
import LocationLog import LocationLog
import Locations import Locations
import qualified Remotes import qualified Remotes

View file

@ -14,7 +14,7 @@ import System.IO
import System.Directory import System.Directory
import qualified Backend.File import qualified Backend.File
import TypeInternals import BackendTypes
import Messages import Messages
import qualified Annex import qualified Annex
import Locations import Locations

View file

@ -11,7 +11,7 @@ import Control.Monad.State (liftIO)
import Data.String.Utils import Data.String.Utils
import Types import Types
import TypeInternals import BackendTypes
import Utility import Utility
import Messages import Messages

View file

@ -15,7 +15,7 @@ import System.Directory
import Data.String.Utils import Data.String.Utils
import qualified Backend.File import qualified Backend.File
import TypeInternals import BackendTypes
import Locations import Locations
import qualified Annex import qualified Annex
import Content import Content

View file

@ -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> - Copyright 2010 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
module TypeInternals where module BackendTypes where
import Data.String.Utils import Data.String.Utils
import Test.QuickCheck import Test.QuickCheck
-- annexed filenames are mapped through a backend into keys
type KeyName = String type KeyName = String
type BackendName = String type BackendName = String
data Key = Key (BackendName, KeyName) deriving (Eq, Ord) 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 -- constructs a key in a backend
genKey :: Backend a -> KeyName -> Key genKey :: Backend a -> KeyName -> Key
genKey b f = Key (name b,f) genKey b f = Key (name b,f)
@ -45,35 +76,3 @@ prop_idempotent_key_read_show k
-- backend names will never contain colons -- backend names will never contain colons
| elem ':' (backendName k) = True | elem ':' (backendName k) = True
| otherwise = k == (read $ show k) | 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

View file

@ -14,5 +14,5 @@ module Types (
keyName keyName
) where ) where
import TypeInternals import BackendTypes
import Annex import Annex

10
test.hs
View file

@ -27,7 +27,7 @@ import qualified Backend
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified Locations import qualified Locations
import qualified Utility import qualified Utility
import qualified TypeInternals import qualified BackendTypes
import qualified Types import qualified Types
import qualified GitAnnex import qualified GitAnnex
import qualified LocationLog import qualified LocationLog
@ -54,7 +54,7 @@ quickchecks :: Test
quickchecks = TestLabel "quickchecks" $ TestList quickchecks = TestLabel "quickchecks" $ TestList
[ qctest "prop_idempotent_deencode" Git.prop_idempotent_deencode [ qctest "prop_idempotent_deencode" Git.prop_idempotent_deencode
, qctest "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey , 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" Utility.prop_idempotent_shellEscape
, qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword , qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword
, qctest "prop_parentDir_basics" Utility.prop_parentDir_basics , 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 :: Test
test_setkey = "git-annex setkey/fromkey" ~: TestCase $ inmainrepo $ do test_setkey = "git-annex setkey/fromkey" ~: TestCase $ inmainrepo $ do
writeFile tmp $ content sha1annexedfile writeFile tmp $ content sha1annexedfile
r <- annexeval $ TypeInternals.getKey Backend.SHA1.backend tmp r <- annexeval $ BackendTypes.getKey Backend.SHA1.backend tmp
let sha1 = TypeInternals.keyName $ fromJust r let sha1 = BackendTypes.keyName $ fromJust r
git_annex "setkey" ["-q", "--backend", "SHA1", "--key", sha1, tmp] @? "setkey failed" git_annex "setkey" ["-q", "--backend", "SHA1", "--key", sha1, tmp] @? "setkey failed"
git_annex "fromkey" ["-q", "--backend", "SHA1", "--key", sha1, sha1annexedfile] @? "fromkey failed" git_annex "fromkey" ["-q", "--backend", "SHA1", "--key", sha1, sha1annexedfile] @? "fromkey failed"
Utility.boolSystem "git" ["commit", "-q", "-a", "-m", "commit"] @? "git commit 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] checkunused [annexedfilekey, sha1annexedfilekey]
-- good opportunity to test dropkey also -- good opportunity to test dropkey also
git_annex "dropkey" ["-q", "--force", TypeInternals.keyName annexedfilekey] git_annex "dropkey" ["-q", "--force", BackendTypes.keyName annexedfilekey]
@? "dropkey failed" @? "dropkey failed"
checkunused [sha1annexedfilekey] checkunused [sha1annexedfilekey]