change Remote.repo to Remote.getRepo

This is groundwork for letting a repo be instantiated the first time
it's actually used, instead of at startup.

The only behavior change is that some old special cases for xmpp remotes
were removed. Where before git-annex silently did nothing with those
no-longer supported remotes, it may now fail in some way.

The additional IO action should have no performance impact as long as
it's simply return.

This commit was sponsored by Boyd Stephen Smith Jr. on Patreon
This commit is contained in:
Joey Hess 2018-06-04 14:31:55 -04:00
parent dc5550a54e
commit 67e46229a5
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
36 changed files with 266 additions and 191 deletions

View file

@ -51,7 +51,6 @@ module Remote (
forceTrust,
logStatus,
checkAvailable,
isXMPPRemote,
claimingUrl,
isExportSupported,
) where
@ -72,21 +71,20 @@ import Remote.List
import Config
import Config.DynamicConfig
import Git.Types (RemoteName)
import qualified Git
import Utility.Aeson
{- Map from UUIDs of Remotes to a calculated value. -}
remoteMap :: (Remote -> v) -> Annex (M.Map UUID v)
remoteMap mkv = remoteMap' mkv mkk
remoteMap mkv = remoteMap' mkv (pure . mkk)
where
mkk r = case uuid r of
NoUUID -> Nothing
u -> Just u
remoteMap' :: Ord k => (Remote -> v) -> (Remote -> Maybe k) -> Annex (M.Map k v)
remoteMap' mkv mkk = M.fromList . mapMaybe mk <$> remoteList
remoteMap' :: Ord k => (Remote -> v) -> (Remote -> Annex (Maybe k)) -> Annex (M.Map k v)
remoteMap' mkv mkk = M.fromList . catMaybes <$> (mapM mk =<< remoteList)
where
mk r = case mkk r of
mk r = mkk r >>= return . \case
Nothing -> Nothing
Just k -> Just (k, mkv r)
@ -122,10 +120,11 @@ byNameWithUUID = checkuuid <=< byName
where
checkuuid Nothing = return Nothing
checkuuid (Just r)
| uuid r == NoUUID =
| uuid r == NoUUID = do
repo <- getRepo r
ifM (liftIO $ getDynamicConfig $ remoteAnnexIgnore (gitconfig r))
( giveup $ noRemoteUUIDMsg r ++
" (" ++ show (remoteConfig (repo r) "ignore") ++
" (" ++ show (remoteConfig repo "ignore") ++
" is set)"
, giveup $ noRemoteUUIDMsg r
)
@ -357,12 +356,6 @@ checkAvailable :: Bool -> Remote -> IO Bool
checkAvailable assumenetworkavailable =
maybe (return assumenetworkavailable) doesDirectoryExist . localpath
{- Old remotes using the XMPP transport have urls like xmpp::user@host -}
isXMPPRemote :: Remote -> Bool
isXMPPRemote remote = Git.repoIsUrl r && "xmpp::" `isPrefixOf` Git.repoLocation r
where
r = repo remote
hasKey :: Remote -> Key -> Annex (Either String Bool)
hasKey r k = either (Left . show) Right <$> tryNonAsync (checkPresent r k)