clean up some ugly code

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
 

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
+	| Git.repoIsLocal r = extract <$>
-		=<< liftIO (catchDefaultIO r $ Git.Config.read r)
+		liftIO (catchMaybeIO $ Git.Config.read r)
-	| not fast = do
+	| not fast = extract . liftM fst <$> getM (eitherToMaybe <$>)
-		fromshell <- Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] []
+		[ Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] []
-		case fromshell of
+		, getConfigViaRsync r
-			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
 	| 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

Utility/Data.hs

@@ -0,0 +1,17 @@
+{- utilities for simple data types
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - 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

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

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.
  -