diff --git a/Common.hs b/Common.hs index 5dc3cfbb23..a6203b9a69 100644 --- a/Common.hs +++ b/Common.hs @@ -28,6 +28,7 @@ import Utility.Process as X import Utility.Path as X import Utility.Directory as X import Utility.Monad as X +import Utility.Data as X import Utility.Applicative as X import Utility.FileSystemEncoding as X diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 5a66cbdebf..b099430523 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -14,6 +14,7 @@ module Remote.GCrypt ( import qualified Data.Map as M import qualified Data.ByteString.Lazy as L +import Control.Exception.Extensible import Common.Annex import Types.Remote @@ -374,22 +375,24 @@ coreGCryptId = "core.gcrypt-id" - (Also returns a version of input repo with its config read.) -} getGCryptId :: Bool -> Git.Repo -> Annex (Maybe Git.GCrypt.GCryptId, Git.Repo) getGCryptId fast r - | Git.repoIsLocal r = extract - =<< liftIO (catchDefaultIO r $ Git.Config.read r) - | not fast = do - fromshell <- Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] [] - case fromshell of - Right (r', _) -> extract r' - Left _ -> do - (rsynctransport, rsyncurl, _) <- rsyncTransport r - fromrsync <- liftIO $ do - withTmpFile "tmpconfig" $ \tmpconfig _ -> do - void $ rsync $ rsynctransport ++ - [ Param $ rsyncurl ++ "/config" - , Param tmpconfig - ] - Git.Config.fromFile r tmpconfig - extract $ either (const r) fst fromrsync + | Git.repoIsLocal r = extract <$> + liftIO (catchMaybeIO $ Git.Config.read r) + | not fast = extract . liftM fst <$> getM (eitherToMaybe <$>) + [ Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] [] + , getConfigViaRsync r + ] | otherwise = return (Nothing, r) where - extract r' = return (Git.Config.getMaybe coreGCryptId r', r') + extract Nothing = (Nothing, r) + extract (Just r') = (Git.Config.getMaybe coreGCryptId r', r') + +getConfigViaRsync :: Git.Repo -> Annex (Either SomeException (Git.Repo, String)) +getConfigViaRsync r = do + (rsynctransport, rsyncurl, _) <- rsyncTransport r + liftIO $ do + withTmpFile "tmpconfig" $ \tmpconfig _ -> do + void $ rsync $ rsynctransport ++ + [ Param $ rsyncurl ++ "/config" + , Param tmpconfig + ] + Git.Config.fromFile r tmpconfig diff --git a/Utility/Data.hs b/Utility/Data.hs new file mode 100644 index 0000000000..3592582967 --- /dev/null +++ b/Utility/Data.hs @@ -0,0 +1,17 @@ +{- utilities for simple data types + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.Data where + +{- First item in the list that is not Nothing. -} +firstJust :: Eq a => [Maybe a] -> Maybe a +firstJust ms = case dropWhile (== Nothing) ms of + [] -> Nothing + (md:_) -> md + +eitherToMaybe :: Either a b -> Maybe b +eitherToMaybe = either (const Nothing) Just diff --git a/Utility/Exception.hs b/Utility/Exception.hs index 3835d741dd..cf2c615c7e 100644 --- a/Utility/Exception.hs +++ b/Utility/Exception.hs @@ -14,6 +14,7 @@ import qualified Control.Exception as E import Control.Applicative import Control.Monad import System.IO.Error (isDoesNotExistError) +import Utility.Data {- Catches IO errors and returns a Bool -} catchBoolIO :: IO Bool -> IO Bool @@ -54,5 +55,5 @@ tryNonAsync a = (Right <$> a) `catchNonAsync` (return . Left) {- Catches only DoesNotExist exceptions, and lets all others through. -} tryWhenExists :: IO a -> IO (Maybe a) -tryWhenExists a = either (const Nothing) Just <$> +tryWhenExists a = eitherToMaybe <$> tryJust (guard . isDoesNotExistError) a diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 48ce4c9294..804a9e4872 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -91,12 +91,6 @@ massReplace vs = go [] vs go (replacement:acc) vs (drop (length val) s) | otherwise = go acc rest s -{- First item in the list that is not Nothing. -} -firstJust :: Eq a => [Maybe a] -> Maybe a -firstJust ms = case dropWhile (== Nothing) ms of - [] -> Nothing - (md:_) -> md - {- Given two orderings, returns the second if the first is EQ and returns - the first otherwise. -