split out three modules from Git
Constructors and configuration make sense in separate modules. A separate Git.Types is needed to avoid cycles.
This commit is contained in:
parent
46588674b0
commit
13fff71f20
20 changed files with 349 additions and 285 deletions
|
@ -15,6 +15,8 @@ import System.Process
|
|||
import Common.Annex
|
||||
import Types.Remote
|
||||
import qualified Git
|
||||
import qualified Git.Config
|
||||
import qualified Git.Construct
|
||||
import Config
|
||||
import Annex.Ssh
|
||||
import Remote.Helper.Special
|
||||
|
@ -163,8 +165,8 @@ storeBupUUID u buprepo = do
|
|||
[Params $ "config annex.uuid " ++ v]
|
||||
>>! error "ssh failed"
|
||||
else liftIO $ do
|
||||
r' <- Git.configRead r
|
||||
let olduuid = Git.configGet "annex.uuid" "" r'
|
||||
r' <- Git.Config.read r
|
||||
let olduuid = Git.Config.get "annex.uuid" "" r'
|
||||
when (olduuid == "") $
|
||||
Git.run "config"
|
||||
[Param "annex.uuid", Param v] r'
|
||||
|
@ -192,9 +194,9 @@ getBupUUID :: Git.Repo -> UUID -> Annex (UUID, Git.Repo)
|
|||
getBupUUID r u
|
||||
| Git.repoIsUrl r = return (u, r)
|
||||
| otherwise = liftIO $ do
|
||||
ret <- try $ Git.configRead r
|
||||
ret <- try $ Git.Config.read r
|
||||
case ret of
|
||||
Right r' -> return (toUUID $ Git.configGet "annex.uuid" "" r', r')
|
||||
Right r' -> return (toUUID $ Git.Config.get "annex.uuid" "" r', r')
|
||||
Left _ -> return (NoUUID, r)
|
||||
|
||||
{- Converts a bup remote path spec into a Git.Repo. There are some
|
||||
|
@ -203,13 +205,13 @@ bup2GitRemote :: BupRepo -> IO Git.Repo
|
|||
bup2GitRemote "" = do
|
||||
-- bup -r "" operates on ~/.bup
|
||||
h <- myHomeDir
|
||||
Git.repoFromAbsPath $ h </> ".bup"
|
||||
Git.Construct.fromAbsPath $ h </> ".bup"
|
||||
bup2GitRemote r
|
||||
| bupLocal r =
|
||||
if head r == '/'
|
||||
then Git.repoFromAbsPath r
|
||||
then Git.Construct.fromAbsPath r
|
||||
else error "please specify an absolute path"
|
||||
| otherwise = Git.repoFromUrl $ "ssh://" ++ host ++ slash dir
|
||||
| otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir
|
||||
where
|
||||
bits = split ":" r
|
||||
host = head bits
|
||||
|
|
|
@ -16,6 +16,8 @@ import Utility.RsyncFile
|
|||
import Annex.Ssh
|
||||
import Types.Remote
|
||||
import qualified Git
|
||||
import qualified Git.Config
|
||||
import qualified Git.Construct
|
||||
import qualified Annex
|
||||
import Annex.UUID
|
||||
import qualified Annex.Content
|
||||
|
@ -44,7 +46,7 @@ list = do
|
|||
case M.lookup (annexurl n) c of
|
||||
Nothing -> return r
|
||||
Just url -> Git.repoRemoteNameSet n <$>
|
||||
inRepo (Git.genRemote url)
|
||||
inRepo (Git.Construct.fromRemoteLocation url)
|
||||
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
||||
gen r u _ = do
|
||||
|
@ -100,7 +102,7 @@ tryGitConfigRead r
|
|||
|
||||
pipedconfig cmd params = safely $
|
||||
pOpen ReadFromPipe cmd (toCommand params) $
|
||||
Git.hConfigRead r
|
||||
Git.Config.hRead r
|
||||
|
||||
geturlconfig = do
|
||||
s <- Url.get (Git.repoLocation r ++ "/config")
|
||||
|
@ -108,7 +110,7 @@ tryGitConfigRead r
|
|||
hPutStr h s
|
||||
hClose h
|
||||
pOpen ReadFromPipe "git" ["config", "--list", "--file", tmpfile] $
|
||||
Git.hConfigRead r
|
||||
Git.Config.hRead r
|
||||
|
||||
store a = do
|
||||
r' <- a
|
||||
|
|
|
@ -12,6 +12,7 @@ import qualified Data.Map as M
|
|||
import Common.Annex
|
||||
import Types.Remote
|
||||
import qualified Git
|
||||
import qualified Git.Construct
|
||||
|
||||
{- Special remotes don't have a configured url, so Git.Repo does not
|
||||
- automatically generate remotes for them. This looks for a different
|
||||
|
@ -23,7 +24,7 @@ findSpecialRemotes s = do
|
|||
return $ map construct $ remotepairs m
|
||||
where
|
||||
remotepairs = M.toList . M.filterWithKey match
|
||||
construct (k,_) = Git.repoRemoteNameFromKey k Git.repoFromUnknown
|
||||
construct (k,_) = Git.repoRemoteNameFromKey k Git.Construct.fromUnknown
|
||||
match k _ = startswith "remote." k && endswith (".annex-"++s) k
|
||||
|
||||
{- Sets up configuration for a special remote in .git/config. -}
|
||||
|
|
|
@ -10,6 +10,7 @@ module Remote.Web (remote) where
|
|||
import Common.Annex
|
||||
import Types.Remote
|
||||
import qualified Git
|
||||
import qualified Git.Construct
|
||||
import Config
|
||||
import Logs.Web
|
||||
import qualified Utility.Url as Url
|
||||
|
@ -26,7 +27,7 @@ remote = RemoteType {
|
|||
-- (If the web should cease to exist, remove this module and redistribute
|
||||
-- a new release to the survivors by carrier pigeon.)
|
||||
list :: Annex [Git.Repo]
|
||||
list = return [Git.repoRemoteNameSet "web" Git.repoFromUnknown]
|
||||
list = return [Git.repoRemoteNameSet "web" Git.Construct.fromUnknown]
|
||||
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
||||
gen r _ _ =
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue