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 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

View file

@ -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. -}

View file

@ -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

View file

@ -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

View file

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

View file

@ -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

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>
-
- 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

View file

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

10
test.hs
View file

@ -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]