summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Command/Sync.hs5
-rw-r--r--Git/Config.hs3
-rw-r--r--Remote/Git.hs9
3 files changed, 13 insertions, 4 deletions
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 759df36ea..445a37137 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -57,12 +57,13 @@ syncRemotes rs = do
then nub <$> pickfast
else wanted
where
- pickfast = (++) <$> listed <*> (fastest <$> available)
+ pickfast = (++) <$> listed <*> (good =<< fastest <$> available)
wanted
- | null rs = available
+ | null rs = good =<< available
| otherwise = listed
listed = mapM Remote.byName rs
available = filter nonspecial <$> Remote.enabledRemoteList
+ good = filterM $ Remote.Git.repoAvail . Types.Remote.repo
nonspecial r = Types.Remote.remotetype r == Remote.Git.remote
fastest = fromMaybe [] . headMaybe .
map snd . sort . M.toList . costmap
diff --git a/Git/Config.hs b/Git/Config.hs
index b2587aa44..d9109548b 100644
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -29,7 +29,8 @@ read repo@(Repo { location = Dir d }) = do
bracket_ (changeWorkingDirectory d) (changeWorkingDirectory cwd) $
pOpen ReadFromPipe "git" ["config", "--null", "--list"] $
hRead repo
-read r = assertLocal r $ error "internal"
+read r = assertLocal r $
+ error $ "internal error; trying to read config of " ++ show r
{- Reads git config from a handle and populates a repo with it. -}
hRead :: Repo -> Handle -> IO Repo
diff --git a/Remote/Git.hs b/Remote/Git.hs
index e790d01a7..b9d9966a4 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-module Remote.Git (remote) where
+module Remote.Git (remote, repoAvail) where
import Control.Exception.Extensible
import qualified Data.Map as M
@@ -164,6 +164,13 @@ inAnnex r key
dispatch (Right Nothing) = unknown
unknown = Left $ "unable to check " ++ Git.repoDescribe r
+{- Checks inexpensively if a repository is available for use. -}
+repoAvail :: Git.Repo -> Annex Bool
+repoAvail r
+ | Git.repoIsHttp r = return True
+ | Git.repoIsUrl r = return True
+ | otherwise = liftIO $ catchBoolIO $ onLocal r $ return True
+
{- Runs an action on a local repository inexpensively, by making an annex
- monad using that repository. -}
onLocal :: Git.Repo -> Annex a -> IO a