diff options
| -rw-r--r-- | Command/Sync.hs | 5 | ||||
| -rw-r--r-- | Git/Config.hs | 3 | ||||
| -rw-r--r-- | Remote/Git.hs | 9 |
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 |