summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-09-27 19:52:36 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-09-27 19:52:36 -0400
commitcbf810a421901e76ee2d3e18592fb4d39de851a6 (patch)
tree222eb2bedae5ddd3703d611a5b31a5b396dca75f
parent7d1b396cc863fb93869b7358dcfe1908985a21b8 (diff)
clean up some ugly code
-rw-r--r--Common.hs1
-rw-r--r--Remote/GCrypt.hs37
-rw-r--r--Utility/Data.hs17
-rw-r--r--Utility/Exception.hs3
-rw-r--r--Utility/Misc.hs6
5 files changed, 40 insertions, 24 deletions
diff --git a/Common.hs b/Common.hs
index 5dc3cfbb2..a6203b9a6 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 5a66cbdeb..b09943052 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 000000000..359258296
--- /dev/null
+++ b/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
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
index 3835d741d..cf2c615c7 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 48ce4c929..804a9e487 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.
-