summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-14 02:36:41 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-14 02:36:41 -0400
commit48643b68b3ff05399b72f44b8b02ff34d6de046c (patch)
tree530364b80bada325413dfa86f7b5e68ee007ee27
parenteda80e44c5fb399fa4e5625388d6e0f993b0f779 (diff)
convert GitRepo to qualified import
-rw-r--r--Annex.hs78
-rw-r--r--Backend.hs4
-rw-r--r--BackendFile.hs8
-rw-r--r--CmdLine.hs14
-rw-r--r--GitRepo.hs158
-rw-r--r--LocationLog.hs10
-rw-r--r--Locations.hs14
-rw-r--r--Remotes.hs34
-rw-r--r--Types.hs24
-rw-r--r--UUID.hs16
-rw-r--r--git-annex.hs2
11 files changed, 173 insertions, 189 deletions
diff --git a/Annex.hs b/Annex.hs
index 68bf0136a..54f9b9dff 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -2,14 +2,14 @@
-}
module Annex (
- startAnnex,
- annexFile,
- unannexFile,
- annexGetFile,
- annexWantFile,
- annexDropFile,
- annexPushRepo,
- annexPullRepo
+ start,
+ annexCmd,
+ unannexCmd,
+ getCmd,
+ wantCmd,
+ dropCmd,
+ pushCmd,
+ pullCmd
) where
import Control.Monad.State (liftIO)
@@ -17,7 +17,7 @@ import System.Posix.Files
import System.Directory
import Data.String.Utils
import List
-import GitRepo
+import qualified GitRepo as Git
import Utility
import Locations
import Backend
@@ -29,20 +29,20 @@ import AbstractTypes
{- Create and returns an Annex state object.
- Examines and prepares the git repo.
-}
-startAnnex :: IO AnnexState
-startAnnex = do
- g <- gitRepoFromCwd
+start :: IO AnnexState
+start = do
+ g <- Git.repoFromCwd
let s = makeAnnexState g
(_,s') <- runAnnexState s (prep g)
return s'
where
prep g = do
-- setup git and read its config; update state
- g' <- liftIO $ gitConfigRead g
+ g' <- liftIO $ Git.configRead g
gitAnnexChange g'
liftIO $ gitSetup g'
backendsAnnexChange $ parseBackendList $
- gitConfig g' "annex.backends" ""
+ Git.configGet g' "annex.backends" ""
prepUUID
inBackend file yes no = do
@@ -54,8 +54,8 @@ notinBackend file yes no = inBackend file no yes
{- Annexes a file, storing it in a backend, and then moving it into
- the annex directory and setting up the symlink pointing to its content. -}
-annexFile :: FilePath -> Annex ()
-annexFile file = inBackend file err $ do
+annexCmd :: FilePath -> Annex ()
+annexCmd file = inBackend file err $ do
liftIO $ checkLegal file
stored <- storeFile file
g <- gitAnnex
@@ -77,8 +77,8 @@ annexFile file = inBackend file err $ do
createDirectoryIfMissing True (parentDir dest)
renameFile file dest
createSymbolicLink ((linkTarget file) ++ reldest) file
- gitRun g ["add", file]
- gitRun g ["commit", "-m",
+ Git.run g ["add", file]
+ Git.run g ["commit", "-m",
("git-annex annexed " ++ file), file]
linkTarget file =
-- relies on file being relative to the top of the
@@ -90,9 +90,9 @@ annexFile file = inBackend file err $ do
subdirs = (length $ split "/" file) - 1
-{- Inverse of annexFile. -}
-unannexFile :: FilePath -> Annex ()
-unannexFile file = notinBackend file err $ \(key, backend) -> do
+{- Inverse of annexCmd. -}
+unannexCmd :: FilePath -> Annex ()
+unannexCmd file = notinBackend file err $ \(key, backend) -> do
dropFile backend key
logStatus key ValueMissing
g <- gitAnnex
@@ -102,8 +102,8 @@ unannexFile file = notinBackend file err $ \(key, backend) -> do
err = error $ "not annexed " ++ file
moveout g src = do
removeFile file
- gitRun g ["rm", file]
- gitRun g ["commit", "-m",
+ Git.run g ["rm", file]
+ Git.run g ["commit", "-m",
("git-annex unannexed " ++ file), file]
-- git rm deletes empty directories;
-- put them back
@@ -112,8 +112,8 @@ unannexFile file = notinBackend file err $ \(key, backend) -> do
return ()
{- Gets an annexed file from one of the backends. -}
-annexGetFile :: FilePath -> Annex ()
-annexGetFile file = notinBackend file err $ \(key, backend) -> do
+getCmd :: FilePath -> Annex ()
+getCmd file = notinBackend file err $ \(key, backend) -> do
inannex <- inAnnex backend key
if (inannex)
then return ()
@@ -131,23 +131,23 @@ annexGetFile file = notinBackend file err $ \(key, backend) -> do
err = error $ "not annexed " ++ file
{- Indicates a file is wanted. -}
-annexWantFile :: FilePath -> Annex ()
-annexWantFile file = do error "not implemented" -- TODO
+wantCmd :: FilePath -> Annex ()
+wantCmd file = do error "not implemented" -- TODO
{- Indicates a file is not wanted. -}
-annexDropFile :: FilePath -> Annex ()
-annexDropFile file = do error "not implemented" -- TODO
+dropCmd :: FilePath -> Annex ()
+dropCmd file = do error "not implemented" -- TODO
{- Pushes all files to a remote repository. -}
-annexPushRepo :: String -> Annex ()
-annexPushRepo reponame = do error "not implemented" -- TODO
+pushCmd :: String -> Annex ()
+pushCmd reponame = do error "not implemented" -- TODO
{- Pulls all files from a remote repository. -}
-annexPullRepo :: String -> Annex ()
-annexPullRepo reponame = do error "not implemented" -- TODO
+pullCmd :: String -> Annex ()
+pullCmd reponame = do error "not implemented" -- TODO
{- Sets up a git repo for git-annex. May be called repeatedly. -}
-gitSetup :: GitRepo -> IO ()
+gitSetup :: Git.Repo -> IO ()
gitSetup repo = do
-- configure git to use union merge driver on state files
exists <- doesFileExist attributes
@@ -164,10 +164,10 @@ gitSetup repo = do
else return ()
where
attrLine = stateLoc ++ "/*.log merge=union"
- attributes = gitAttributes repo
+ attributes = Git.attributes repo
commit = do
- gitRun repo ["add", attributes]
- gitRun repo ["commit", "-m", "git-annex setup",
+ Git.run repo ["add", attributes]
+ Git.run repo ["commit", "-m", "git-annex setup",
attributes]
{- Updates the LocationLog when a key's presence changes. -}
@@ -179,8 +179,8 @@ logStatus key status = do
liftIO $ commit g f
where
commit g f = do
- gitRun g ["add", f]
- gitRun g ["commit", "-m", "git-annex log update", f]
+ Git.run g ["add", f]
+ Git.run g ["commit", "-m", "git-annex log update", f]
{- Checks if a given key is currently present in the annexLocation -}
inAnnex :: Backend -> Key -> Annex Bool
diff --git a/Backend.hs b/Backend.hs
index 775c4a02f..1bd4efc1e 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -28,7 +28,7 @@ import Data.String.Utils
import System.Posix.Files
import BackendList
import Locations
-import GitRepo
+import qualified GitRepo as Git
import Utility
import Types
@@ -36,7 +36,7 @@ import Types
storeFile :: FilePath -> Annex (Maybe (Key, Backend))
storeFile file = do
g <- gitAnnex
- let relfile = gitRelative g file
+ let relfile = Git.relative g file
b <- backendsAnnex
storeFile' b file relfile
storeFile' [] _ _ = return Nothing
diff --git a/BackendFile.hs b/BackendFile.hs
index e821ac22b..6c1dc0623 100644
--- a/BackendFile.hs
+++ b/BackendFile.hs
@@ -11,7 +11,7 @@ import Types
import LocationLog
import Locations
import Remotes
-import GitRepo
+import qualified GitRepo as Git
backend = Backend {
name = "file",
@@ -58,11 +58,11 @@ copyKeyFile key file = do
Right succ -> return True
{- Tries to copy a file from a remote, exception on error. -}
-copyFromRemote :: GitRepo -> Key -> FilePath -> IO ()
+copyFromRemote :: Git.Repo -> Key -> FilePath -> IO ()
copyFromRemote r key file = do
- putStrLn $ "copy from " ++ (gitRepoDescribe r ) ++ " " ++ file
+ putStrLn $ "copy from " ++ (Git.repoDescribe r ) ++ " " ++ file
- if (gitRepoIsLocal r)
+ if (Git.repoIsLocal r)
then getlocal
else getremote
return ()
diff --git a/CmdLine.hs b/CmdLine.hs
index bb908a2e4..479be7e8b 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -43,10 +43,10 @@ argvToMode argv = do
dispatch :: Mode -> FilePath -> Annex ()
dispatch mode item = do
case (mode) of
- Add -> annexFile item
- Push -> annexPushRepo item
- Pull -> annexPullRepo item
- Want -> annexWantFile item
- Get -> annexGetFile item
- Drop -> annexDropFile item
- Unannex -> unannexFile item
+ Add -> annexCmd item
+ Push -> pushCmd item
+ Pull -> pullCmd item
+ Want -> wantCmd item
+ Get -> getCmd item
+ Drop -> dropCmd item
+ Unannex -> unannexCmd item
diff --git a/GitRepo.hs b/GitRepo.hs
index d22218219..f3bb5427a 100644
--- a/GitRepo.hs
+++ b/GitRepo.hs
@@ -3,27 +3,27 @@
- This is written to be completely independant of git-annex and should be
- suitable for other uses.
-
- - -}
+ -}
module GitRepo (
- GitRepo,
- gitRepoFromCwd,
- gitRepoFromPath,
- gitRepoFromUrl,
- gitRepoIsLocal,
- gitRepoIsRemote,
- gitRepoDescribe,
- gitWorkTree,
- gitDir,
- gitRelative,
- gitConfig,
- gitConfigMap,
- gitConfigRead,
- gitRun,
- gitAttributes,
- gitRepoRemotes,
- gitRepoRemotesAdd,
- gitRepoRemoteName
+ Repo,
+ repoFromCwd,
+ repoFromPath,
+ repoFromUrl,
+ repoIsLocal,
+ repoIsRemote,
+ repoDescribe,
+ workTree,
+ dir,
+ relative,
+ configGet,
+ configMap,
+ configRead,
+ run,
+ attributes,
+ remotes,
+ remotesAdd,
+ repoRemoteName
) where
import Directory
@@ -44,35 +44,35 @@ import Utility
{- A git repository can be on local disk or remote. Not to be confused
- with a git repo's configured remotes, some of which may be on local
- disk. -}
-data GitRepo =
- LocalGitRepo {
+data Repo =
+ LocalRepo {
top :: FilePath,
config :: Map String String,
- remotes :: [GitRepo],
+ remotes :: [Repo],
-- remoteName holds the name used for this repo in remotes
remoteName :: Maybe String
- } | RemoteGitRepo {
+ } | RemoteRepo {
url :: String,
top :: FilePath,
config :: Map String String,
- remotes :: [GitRepo],
+ remotes :: [Repo],
remoteName :: Maybe String
} deriving (Show, Read, Eq)
-{- Local GitRepo constructor. -}
-gitRepoFromPath :: FilePath -> GitRepo
-gitRepoFromPath dir =
- LocalGitRepo {
+{- Local Repo constructor. -}
+repoFromPath :: FilePath -> Repo
+repoFromPath dir =
+ LocalRepo {
top = dir,
config = Map.empty,
remotes = [],
remoteName = Nothing
}
-{- Remote GitRepo constructor. Throws exception on invalid url. -}
-gitRepoFromUrl :: String -> GitRepo
-gitRepoFromUrl url =
- RemoteGitRepo {
+{- Remote Repo constructor. Throws exception on invalid url. -}
+repoFromUrl :: String -> Repo
+repoFromUrl url =
+ RemoteRepo {
url = url,
top = path url,
config = Map.empty,
@@ -82,72 +82,68 @@ gitRepoFromUrl url =
where path url = uriPath $ fromJust $ parseURI url
{- User-visible description of a git repo. -}
-gitRepoDescribe repo =
+repoDescribe repo =
if (isJust $ remoteName repo)
then fromJust $ remoteName repo
- else if (gitRepoIsLocal repo)
+ else if (repoIsLocal repo)
then top repo
else url repo
-{- Returns the list of a repo's remotes. -}
-gitRepoRemotes :: GitRepo -> [GitRepo]
-gitRepoRemotes r = remotes r
-
{- Constructs and returns an updated version of a repo with
- different remotes list. -}
-gitRepoRemotesAdd :: GitRepo -> [GitRepo] -> GitRepo
-gitRepoRemotesAdd repo rs = repo { remotes = rs }
+remotesAdd :: Repo -> [Repo] -> Repo
+remotesAdd repo rs = repo { remotes = rs }
{- Returns the name of the remote that corresponds to the repo, if
- it is a remote. Otherwise, "" -}
-gitRepoRemoteName r =
+repoRemoteName r =
if (isJust $ remoteName r)
then fromJust $ remoteName r
else ""
{- Some code needs to vary between remote and local repos, or bare and
- non-bare, these functions help with that. -}
-gitRepoIsLocal repo = case (repo) of
- LocalGitRepo {} -> True
- RemoteGitRepo {} -> False
-gitRepoIsRemote repo = not $ gitRepoIsLocal repo
+repoIsLocal repo = case (repo) of
+ LocalRepo {} -> True
+ RemoteRepo {} -> False
+repoIsRemote repo = not $ repoIsLocal repo
assertlocal repo action =
- if (gitRepoIsLocal repo)
+ if (repoIsLocal repo)
then action
- else error $ "acting on remote git repo " ++ (gitRepoDescribe repo) ++
+ else error $ "acting on remote git repo " ++ (repoDescribe repo) ++
" not supported"
-bare :: GitRepo -> Bool
+bare :: Repo -> Bool
bare repo =
if (member b (config repo))
then ("true" == fromJust (Map.lookup b (config repo)))
- else error $ "it is not known if git repo " ++ (gitRepoDescribe repo) ++
+ else error $ "it is not known if git repo " ++ (repoDescribe repo) ++
" is a bare repository; config not read"
where
b = "core.bare"
{- Path to a repository's gitattributes file. -}
-gitAttributes :: GitRepo -> String
-gitAttributes repo = assertlocal repo $ do
+attributes :: Repo -> String
+attributes repo = assertlocal repo $ do
if (bare repo)
then (top repo) ++ "/info/.gitattributes"
else (top repo) ++ "/.gitattributes"
{- Path to a repository's .git directory, relative to its topdir. -}
-gitDir :: GitRepo -> String
-gitDir repo = assertlocal repo $
+dir :: Repo -> String
+dir repo = assertlocal repo $
if (bare repo)
then ""
else ".git"
{- Path to a repository's --work-tree. -}
-gitWorkTree :: GitRepo -> FilePath
-gitWorkTree repo = top repo
+workTree :: Repo -> FilePath
+workTree repo = top repo
{- Given a relative or absolute filename in a repository, calculates the
- name to use to refer to the file relative to a git repository's top.
- This is the same form displayed and used by git. -}
-gitRelative :: GitRepo -> String -> String
-gitRelative repo file = drop (length absrepo) absfile
+relative :: Repo -> String -> String
+relative repo file = drop (length absrepo) absfile
where
-- normalize both repo and file, so that repo
-- will be substring of file
@@ -159,27 +155,27 @@ gitRelative repo file = drop (length absrepo) absfile
Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo
{- Constructs a git command line operating on the specified repo. -}
-gitCommandLine :: GitRepo -> [String] -> [String]
+gitCommandLine :: Repo -> [String] -> [String]
gitCommandLine repo params = assertlocal repo $
-- force use of specified repo via --git-dir and --work-tree
- ["--git-dir="++(top repo)++"/"++(gitDir repo), "--work-tree="++(top repo)] ++ params
+ ["--git-dir="++(top repo)++"/"++(dir repo), "--work-tree="++(top repo)] ++ params
{- Runs git in the specified repo. -}
-gitRun :: GitRepo -> [String] -> IO ()
-gitRun repo params = assertlocal repo $ do
+run :: Repo -> [String] -> IO ()
+run repo params = assertlocal repo $ do
r <- rawSystem "git" (gitCommandLine repo params)
return ()
{- Runs a git subcommand and returns its output. -}
-gitPipeRead :: GitRepo -> [String] -> IO String
+gitPipeRead :: Repo -> [String] -> IO String
gitPipeRead repo params = assertlocal repo $ do
pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do
ret <- hGetContentsStrict h
return ret
{- Runs git config and populates a repo with its config. -}
-gitConfigRead :: GitRepo -> IO GitRepo
-gitConfigRead repo = assertlocal repo $ do
+configRead :: Repo -> IO Repo
+configRead repo = assertlocal repo $ do
{- Cannot use gitPipeRead because it relies on the config having
been already read. Instead, chdir to the repo. -}
cwd <- getCurrentDirectory
@@ -187,12 +183,12 @@ gitConfigRead repo = assertlocal repo $ do
(\_ -> changeWorkingDirectory cwd) $
pOpen ReadFromPipe "git" ["config", "--list"] $ \h -> do
val <- hGetContentsStrict h
- let r = repo { config = gitConfigParse val }
- return r { remotes = gitConfigRemotes r }
+ let r = repo { config = configParse val }
+ return r { remotes = configRemotes r }
{- Calculates a list of a repo's configured remotes, by parsing its config. -}
-gitConfigRemotes :: GitRepo -> [GitRepo]
-gitConfigRemotes repo = map construct remotes
+configRemotes :: Repo -> [Repo]
+configRemotes repo = map construct remotes
where
remotes = toList $ filter $ config repo
filter = filterWithKey (\k _ -> isremote k)
@@ -200,12 +196,12 @@ gitConfigRemotes repo = map construct remotes
remotename k = (split "." k) !! 1
construct (k,v) = (gen v) { remoteName = Just $ remotename k }
gen v = if (isURI v)
- then gitRepoFromUrl v
- else gitRepoFromPath v
+ then repoFromUrl v
+ else repoFromPath v
{- Parses git config --list output into a config map. -}
-gitConfigParse :: String -> Map.Map String String
-gitConfigParse s = Map.fromList $ map pair $ lines s
+configParse :: String -> Map.Map String String
+configParse s = Map.fromList $ map pair $ lines s
where
pair l = (key l, val l)
key l = (keyval l) !! 0
@@ -214,21 +210,21 @@ gitConfigParse s = Map.fromList $ map pair $ lines s
sep = "="
{- Returns a single git config setting, or a default value if not set. -}
-gitConfig :: GitRepo -> String -> String -> String
-gitConfig repo key defaultValue =
+configGet :: Repo -> String -> String -> String
+configGet repo key defaultValue =
Map.findWithDefault defaultValue key (config repo)
{- Access to raw config Map -}
-gitConfigMap :: GitRepo -> Map String String
-gitConfigMap repo = config repo
+configMap :: Repo -> Map String String
+configMap repo = config repo
{- Finds the current git repository, which may be in a parent directory. -}
-gitRepoFromCwd :: IO GitRepo
-gitRepoFromCwd = do
+repoFromCwd :: IO Repo
+repoFromCwd = do
cwd <- getCurrentDirectory
top <- seekUp cwd isRepoTop
case top of
- (Just dir) -> return $ gitRepoFromPath dir
+ (Just dir) -> return $ repoFromPath dir
Nothing -> error "Not in a git repository."
seekUp :: String -> (String -> IO Bool) -> IO (Maybe String)
@@ -241,11 +237,11 @@ seekUp dir want = do
d -> seekUp d want
isRepoTop dir = do
- r <- isGitRepo dir
+ r <- isRepo dir
b <- isBareRepo dir
return (r || b)
where
- isGitRepo dir = gitSignature dir ".git" ".git/config"
+ isRepo dir = gitSignature dir ".git" ".git/config"
isBareRepo dir = gitSignature dir "objects" "config"
gitSignature dir subdir file = do
s <- (doesDirectoryExist (dir ++ "/" ++ subdir))
diff --git a/LocationLog.hs b/LocationLog.hs
index a6d998e0a..7953b345f 100644
--- a/LocationLog.hs
+++ b/LocationLog.hs
@@ -29,7 +29,7 @@ import qualified Data.Map as Map
import System.IO
import System.Directory
import Data.Char
-import GitRepo
+import qualified GitRepo as Git
import Utility
import UUID
import AbstractTypes
@@ -81,7 +81,7 @@ instance Read LogLine where
{- Log a change in the presence of a key's value in a repository,
- and return the log filename. -}
-logChange :: GitRepo -> Key -> UUID -> LogStatus -> IO FilePath
+logChange :: Git.Repo -> Key -> UUID -> LogStatus -> IO FilePath
logChange repo key uuid status = do
log <- logNow status uuid
ls <- readLog logfile
@@ -127,13 +127,13 @@ logNow status uuid = do
return $ LogLine now status uuid
{- Returns the filename of the log file for a given key. -}
-logFile :: GitRepo -> Key -> String
+logFile :: Git.Repo -> Key -> String
logFile repo key =
- (gitStateDir repo) ++ (gitRelative repo (keyFile key)) ++ ".log"
+ (gitStateDir repo) ++ (Git.relative repo (keyFile key)) ++ ".log"
{- Returns a list of repository UUIDs that, according to the log, have
- the value of a key. -}
-keyLocations :: GitRepo -> Key -> IO [UUID]
+keyLocations :: Git.Repo -> Key -> IO [UUID]
keyLocations thisrepo key = do
lines <- readLog $ logFile thisrepo key
return $ map uuid (filterPresent lines)
diff --git a/Locations.hs b/Locations.hs
index 68a958192..5d701681c 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -12,27 +12,27 @@ module Locations (
import Data.String.Utils
import Types
-import GitRepo
+import qualified GitRepo as Git
{- Long-term, cross-repo state is stored in files inside the .git-annex
- directory, in the git repository's working tree. -}
stateLoc = ".git-annex"
-gitStateDir :: GitRepo -> FilePath
-gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/"
+gitStateDir :: Git.Repo -> FilePath
+gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc ++ "/"
{- An annexed file's content is stored in
- /path/to/repo/.git/annex/<backend>/<key>
-
- (That allows deriving the key and backend by looking at the symlink to it.)
-}
-annexLocation :: GitRepo -> Backend -> Key -> FilePath
+annexLocation :: Git.Repo -> Backend -> Key -> FilePath
annexLocation r backend key =
- (gitWorkTree r) ++ "/" ++ (annexLocationRelative r backend key)
+ (Git.workTree r) ++ "/" ++ (annexLocationRelative r backend key)
{- Annexed file's location relative to the gitWorkTree -}
-annexLocationRelative :: GitRepo -> Backend -> Key -> FilePath
+annexLocationRelative :: Git.Repo -> Backend -> Key -> FilePath
annexLocationRelative r backend key =
- gitDir r ++ "/annex/" ++ (name backend) ++ "/" ++ (keyFile key)
+ Git.dir r ++ "/annex/" ++ (name backend) ++ "/" ++ (keyFile key)
{- Converts a key into a filename fragment.
-
diff --git a/Remotes.hs b/Remotes.hs
index 711cd6c83..39404bf19 100644
--- a/Remotes.hs
+++ b/Remotes.hs
@@ -10,18 +10,18 @@ import Control.Monad.State (liftIO)
import qualified Data.Map as Map
import Data.String.Utils
import AbstractTypes
-import GitRepo
+import qualified GitRepo as Git
import LocationLog
import Locations
import UUID
import List
{- Human visible list of remotes. -}
-remotesList :: [GitRepo] -> String
-remotesList remotes = join " " $ map gitRepoDescribe remotes
+remotesList :: [Git.Repo] -> String
+remotesList remotes = join " " $ map Git.repoDescribe remotes
{- Cost ordered list of remotes that the LocationLog indicate may have a key. -}
-remotesWithKey :: Key -> Annex [GitRepo]
+remotesWithKey :: Key -> Annex [Git.Repo]
remotesWithKey key = do
g <- gitAnnex
uuids <- liftIO $ keyLocations g key
@@ -34,13 +34,13 @@ remotesWithKey key = do
else return remotes
{- Cost Ordered list of remotes. -}
-remotesByCost :: Annex [GitRepo]
+remotesByCost :: Annex [Git.Repo]
remotesByCost = do
g <- gitAnnex
- reposByCost $ gitRepoRemotes g
+ reposByCost $ Git.remotes g
{- Orders a list of git repos by cost. -}
-reposByCost :: [GitRepo] -> Annex [GitRepo]
+reposByCost :: [Git.Repo] -> Annex [Git.Repo]
reposByCost l = do
costpairs <- mapM costpair l
return $ fst $ unzip $ sortBy bycost $ costpairs
@@ -55,36 +55,36 @@ reposByCost l = do
- The default cost is 100 for local repositories, and 200 for remote
- repositories; it can also be configured by remote.<name>.annex-cost
-}
-repoCost :: GitRepo -> Annex Int
+repoCost :: Git.Repo -> Annex Int
repoCost r = do
g <- gitAnnex
if ((length $ config g r) > 0)
then return $ read $ config g r
- else if (gitRepoIsLocal r)
+ else if (Git.repoIsLocal r)
then return 100
else return 200
where
- config g r = gitConfig g (configkey r) ""
- configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-cost"
+ config g r = Git.configGet g (configkey r) ""
+ configkey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-cost"
{- The git configs for the git repo's remotes is not read on startup
- because reading it may be expensive. This function ensures that it is
- read for a specified remote, and updates state. It returns the
- updated git repo also. -}
-remoteEnsureGitConfigRead :: GitRepo -> Annex GitRepo
+remoteEnsureGitConfigRead :: Git.Repo -> Annex Git.Repo
remoteEnsureGitConfigRead r = do
- if (Map.null $ gitConfigMap r)
+ if (Map.null $ Git.configMap r)
then do
- r' <- liftIO $ gitConfigRead r
+ r' <- liftIO $ Git.configRead r
g <- gitAnnex
- let l = gitRepoRemotes g
- let g' = gitRepoRemotesAdd g $ exchange l r'
+ let l = Git.remotes g
+ let g' = Git.remotesAdd g $ exchange l r'
gitAnnexChange g'
return r'
else return r
where
exchange [] new = []
exchange (old:ls) new =
- if ((gitRepoRemoteName old) == (gitRepoRemoteName new))
+ if ((Git.repoRemoteName old) == (Git.repoRemoteName new))
then new:(exchange ls new)
else old:(exchange ls new)
diff --git a/Types.hs b/Types.hs
index ce377dda1..c9d33affd 100644
--- a/Types.hs
+++ b/Types.hs
@@ -1,26 +1,14 @@
{- git-annex core data types -}
-module Types (
- Annex,
- AnnexState,
- makeAnnexState,
- runAnnexState,
- gitAnnex,
- gitAnnexChange,
- backendsAnnex,
- backendsAnnexChange,
-
- Key(..),
- Backend(..)
-) where
+module Types where
import Control.Monad.State
import Data.String.Utils
-import GitRepo
+import qualified GitRepo as Git
-- git-annex's runtime state
data AnnexState = AnnexState {
- repo :: GitRepo,
+ repo :: Git.Repo,
backends :: [Backend]
} deriving (Show)
@@ -28,18 +16,18 @@ data AnnexState = AnnexState {
type Annex = StateT AnnexState IO
-- constructor
-makeAnnexState :: GitRepo -> AnnexState
+makeAnnexState :: Git.Repo -> AnnexState
makeAnnexState g = AnnexState { repo = g, backends = [] }
-- performs an action in the Annex monad
runAnnexState state action = runStateT (action) state
-- Annex monad state accessors
-gitAnnex :: Annex GitRepo
+gitAnnex :: Annex Git.Repo
gitAnnex = do
state <- get
return (repo state)
-gitAnnexChange :: GitRepo -> Annex ()
+gitAnnexChange :: Git.Repo -> Annex ()
gitAnnexChange r = do
state <- get
put state { repo = r }
diff --git a/UUID.hs b/UUID.hs
index f334afdc9..9c8b23a96 100644
--- a/UUID.hs
+++ b/UUID.hs
@@ -19,7 +19,7 @@ import Maybe
import List
import System.Cmd.Utils
import System.IO
-import GitRepo
+import qualified GitRepo as Git
import AbstractTypes
type UUID = String
@@ -37,17 +37,17 @@ genUUID = liftIO $ pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h
- remote.<name>.annex-uuid
-
- -}
-getUUID :: GitRepo -> Annex UUID
+getUUID :: Git.Repo -> Annex UUID
getUUID r = do
if ("" /= configured r)
then return $ configured r
else cached r
where
- configured r = gitConfig r "annex.uuid" ""
+ configured r = Git.configGet r "annex.uuid" ""
cached r = do
g <- gitAnnex
- return $ gitConfig g (configkey r) ""
- configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-uuid"
+ return $ Git.configGet g (configkey r) ""
+ configkey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid"
{- Make sure that the repo has an annex.uuid setting. -}
prepUUID :: Annex ()
@@ -57,15 +57,15 @@ prepUUID = do
if ("" == u)
then do
uuid <- genUUID
- liftIO $ gitRun g ["config", configkey, uuid]
+ liftIO $ Git.run g ["config", configkey, uuid]
-- re-read git config and update the repo's state
- u' <- liftIO $ gitConfigRead g
+ u' <- liftIO $ Git.configRead g
gitAnnexChange u'
return ()
else return ()
{- Filters a list of repos to ones that have listed UUIDs. -}
-reposByUUID :: [GitRepo] -> [UUID] -> Annex [GitRepo]
+reposByUUID :: [Git.Repo] -> [UUID] -> Annex [Git.Repo]
reposByUUID repos uuids = do
filterM match repos
where
diff --git a/git-annex.hs b/git-annex.hs
index be5168755..2cf1c5305 100644
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -12,7 +12,7 @@ import Annex
main = do
args <- getArgs
(mode, params) <- argvToMode args
- state <- startAnnex
+ state <- start
tryRun state mode 0 0 params
{- Processes each param in the list by dispatching the handler function