rename TypeInternals to BackendTypes
Now that it only contains types used by the backends
This commit is contained in:
parent
aa2ca533bc
commit
616d1d4a20
9 changed files with 58 additions and 59 deletions
10
Annex.hs
10
Annex.hs
|
@ -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
|
||||
|
|
16
Backend.hs
16
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. -}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -11,7 +11,7 @@ import Control.Monad.State (liftIO)
|
|||
import Data.String.Utils
|
||||
|
||||
import Types
|
||||
import TypeInternals
|
||||
import BackendTypes
|
||||
import Utility
|
||||
import Messages
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
2
Types.hs
2
Types.hs
|
@ -14,5 +14,5 @@ module Types (
|
|||
keyName
|
||||
) where
|
||||
|
||||
import TypeInternals
|
||||
import BackendTypes
|
||||
import Annex
|
||||
|
|
10
test.hs
10
test.hs
|
@ -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]
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue