refactor

Remote/Glacier.hs

@@ -18,6 +18,7 @@ import qualified Git
 import Config
 import Config.Cost
 import Remote.Helper.Special
+import Remote.Helper.Messages
 import qualified Remote.Helper.AWS as AWS
 import Creds
 import Utility.Metered
@@ -176,7 +177,7 @@ remove r k = glacierAction r
 
 checkKey :: Remote -> CheckPresent
 checkKey r k = do
-	showAction $ "checking " ++ name r
+	showChecking r
 	go =<< glacierEnv (config r) (uuid r)
   where
 	go Nothing = error "cannot check glacier"

Remote/Helper/Messages.hs

@@ -5,15 +5,14 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+
 module Remote.Helper.Messages where
 
 import Common.Annex
 import qualified Git
 import qualified Types.Remote as Remote
 
-showChecking :: Git.Repo -> Annex ()
-showChecking r = showAction $ "checking " ++ Git.repoDescribe r
-
 class Checkable a where
 	descCheckable :: a -> String
 
@@ -23,5 +22,11 @@ instance Checkable Git.Repo where
 instance Checkable (Remote.RemoteA a) where
 	descCheckable = Remote.name
 
+instance Checkable String where
+	descCheckable = id
+
+showChecking :: Checkable a => a -> Annex ()
+showChecking v = showAction $ "checking " ++ descCheckable v
+
 cantCheck :: Checkable a => a -> e
 cantCheck v = error $ "unable to check " ++ descCheckable v

Remote/Hook.hs

@@ -16,6 +16,7 @@ import Config
 import Config.Cost
 import Annex.UUID
 import Remote.Helper.Special
+import Remote.Helper.Messages
 import Utility.Env
 import Messages.Progress
 
@@ -138,7 +139,7 @@ remove h k = runHook h "remove" k Nothing $ return True
 
 checkKey :: Git.Repo -> HookName -> CheckPresent
 checkKey r h k = do
-	showAction $ "checking " ++ Git.repoDescribe r
+	showChecking r
 	v <- lookupHook h action
 	liftIO $ check v
   where

Remote/Rsync.hs

@@ -27,6 +27,7 @@ import Annex.Content
 import Annex.UUID
 import Annex.Ssh
 import Remote.Helper.Special
+import Remote.Helper.Messages
 import Remote.Rsync.RsyncUrl
 import Crypto
 import Utility.Rsync
@@ -222,7 +223,7 @@ remove o k = do
 
 checkKey :: Git.Repo -> RsyncOpts -> CheckPresent
 checkKey r o k = do
-	showAction $ "checking " ++ Git.repoDescribe r
+	showChecking r
 	-- note: Does not currently differentiate between rsync failing
 	-- to connect, and the file not being present.
 	untilTrue (rsyncUrls o k) $ \u -> 

Remote/S3.hs

@@ -39,6 +39,7 @@ import Config
 import Config.Cost
 import Remote.Helper.Special
 import Remote.Helper.Http
+import Remote.Helper.Messages
 import qualified Remote.Helper.AWS as AWS
 import Creds
 import Annex.UUID
@@ -269,7 +270,7 @@ remove info h k
 
 checkKey :: Remote -> S3Info -> Maybe S3Handle -> CheckPresent
 checkKey r info (Just h) k = do
-	showAction $ "checking " ++ name r
+	showChecking r
 #if MIN_VERSION_aws(0,10,0)
 	rsp <- go
 	return (isJust $ S3.horMetadata rsp)
@@ -300,7 +301,7 @@ checkKey r info Nothing k = case getpublicurl info of
 		warnMissingCredPairFor "S3" (AWS.creds $ uuid r)
 		error "No S3 credentials configured"
 	Just geturl -> do
-		showAction $ "checking " ++ name r
+		showChecking r
 		withUrlOptions $ checkBoth (geturl k) (keySize k)
 
 {- Generate the bucket if it does not already exist, including creating the

Remote/Web.hs

@@ -11,6 +11,7 @@ module Remote.Web (remote) where
 
 import Common.Annex
 import Types.Remote
+import Remote.Helper.Messages
 import qualified Git
 import qualified Git.Construct
 import Annex.Content
@@ -112,7 +113,7 @@ checkKey key = do
 checkKey' :: Key -> [URLString] -> Annex (Either String Bool)
 checkKey' key us = firsthit us (Right False) $ \u -> do
 	let (u', downloader) = getDownloader u
-	showAction $ "checking " ++ u'
+	showChecking u'
 	case downloader of
 		QuviDownloader ->
 #ifdef WITH_QUVI

Remote/WebDAV.hs

@@ -25,6 +25,7 @@ import qualified Git
 import Config
 import Config.Cost
 import Remote.Helper.Special
+import Remote.Helper.Messages
 import Remote.Helper.Http
 import qualified Remote.Helper.Chunked.Legacy as Legacy
 import Creds
@@ -147,7 +148,7 @@ remove (Just dav) k = liftIO $ do
 checkKey :: Remote -> ChunkConfig -> Maybe DavHandle -> CheckPresent
 checkKey r _ Nothing _ = error $ name r ++ " not configured"
 checkKey r chunkconfig (Just dav) k = do
-	showAction $ "checking " ++ name r
+	showChecking r
 	case chunkconfig of
 		LegacyChunks _ -> checkKeyLegacyChunked dav k
 		_ -> do