add a path field to remotes

Also broke out some helper functions around constructing remotes,
to be used later.

Remote/Bup.hs

@@ -46,21 +46,24 @@ gen r u c = do
 	return $ encryptableRemote c
 		(storeEncrypted r buprepo)
 		(retrieveEncrypted buprepo)
-		Remote {
+		Remote
-			uuid = u',
+			{ uuid = u'
-			cost = cst,
+			, cost = cst
-			name = Git.repoDescribe r,
+			, name = Git.repoDescribe r
- 			storeKey = store r buprepo,
+ 			, storeKey = store r buprepo
-			retrieveKeyFile = retrieve buprepo,
+			, retrieveKeyFile = retrieve buprepo
-			retrieveKeyFileCheap = retrieveCheap buprepo,
+			, retrieveKeyFileCheap = retrieveCheap buprepo
-			removeKey = remove,
+			, removeKey = remove
-			hasKey = checkPresent r bupr',
+			, hasKey = checkPresent r bupr'
-			hasKeyCheap = bupLocal buprepo,
+			, hasKeyCheap = bupLocal buprepo
-			whereisKey = Nothing,
+			, whereisKey = Nothing
-			config = c,
+			, config = c
-			repo = r,
+			, repo = r
-			remotetype = remote
+			, path = if bupLocal buprepo && not (null buprepo)
-		}
+				then Just buprepo
+				else Nothing
+			, remotetype = remote
+			}
 
 bupSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
 bupSetup u c = do

Remote/Directory.hs

@@ -53,6 +53,7 @@ gen r u c = do
 			whereisKey = Nothing,
 			config = Nothing,
 			repo = r,
+			path = Just dir,
 			remotetype = remote
 		}
 	where

Remote/Git.hs

@@ -5,7 +5,11 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Remote.Git (remote, repoAvail) where
+module Remote.Git (
+	remote,
+	configRead,
+	repoAvail,
+) where
 
 import qualified Data.Map as M
 import Control.Exception.Extensible
@@ -45,7 +49,7 @@ list :: Annex [Git.Repo]
 list = do
 	c <- fromRepo Git.config
 	rs <- mapM (tweakurl c) =<< fromRepo Git.remotes
-	mapM configread rs
+	mapM configRead rs
 	where
 		annexurl n = "remote." ++ n ++ ".annexurl"
 		tweakurl c r = do
@@ -55,19 +59,21 @@ list = do
 				Just url -> inRepo $ \g ->
 					Git.Construct.remoteNamed n $
 						Git.Construct.fromRemoteLocation url g
-		{- It's assumed to be cheap to read the config of non-URL
+
-		 - remotes, so this is done each time git-annex is run
+{- It's assumed to be cheap to read the config of non-URL remotes, so this is
-		 - in a way that uses remotes.
+ - done each time git-annex is run in a way that uses remotes.
-		 - Conversely, the config of an URL remote is only read
+ -
-		 - when there is no cached UUID value. -}
+ - Conversely, the config of an URL remote is only read when there is no
-		configread r = do
+ - cached UUID value. -}
-			notignored <- repoNotIgnored r
+configRead :: Git.Repo -> Annex Git.Repo
-			u <- getRepoUUID r
+configRead r = do
-			case (repoCheap r, notignored, u) of
+	notignored <- repoNotIgnored r
-				(_, False, _) -> return r
+	u <- getRepoUUID r
-				(True, _, _) -> tryGitConfigRead r
+	case (repoCheap r, notignored, u) of
-				(False, _, NoUUID) -> tryGitConfigRead r
+		(_, False, _) -> return r
-				_ -> return r
+		(True, _, _) -> tryGitConfigRead r
+		(False, _, NoUUID) -> tryGitConfigRead r
+		_ -> return r
 
 repoCheap :: Git.Repo -> Bool
 repoCheap = not . Git.repoIsUrl
@@ -76,21 +82,25 @@ gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
 gen r u _ = new <$> remoteCost r defcst
 	where
 		defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
-		new cst = Remote {
+		new cst = Remote 
-			uuid = u,
+			{ uuid = u
-			cost = cst,
+			, cost = cst
-			name = Git.repoDescribe r,
+			, name = Git.repoDescribe r
-			storeKey = copyToRemote r,
+			, storeKey = copyToRemote r
-			retrieveKeyFile = copyFromRemote r,
+			, retrieveKeyFile = copyFromRemote r
-			retrieveKeyFileCheap = copyFromRemoteCheap r,
+			, retrieveKeyFileCheap = copyFromRemoteCheap r
-			removeKey = dropKey r,
+			, removeKey = dropKey r
-			hasKey = inAnnex r,
+			, hasKey = inAnnex r
-			hasKeyCheap = repoCheap r,
+			, hasKeyCheap = repoCheap r
-			whereisKey = Nothing,
+			, whereisKey = Nothing
-			config = Nothing,
+			, config = Nothing
-			repo = r,
+			, path = if Git.repoIsLocal r || Git.repoIsLocalUnknown r
-			remotetype = remote
+				then Just $ Git.repoPath r
-		}
+				else Nothing
+			, repo = r
+			, remotetype = remote
+			}
+		
 
 {- Checks relatively inexpensively if a repository is available for use. -}
 repoAvail :: Git.Repo -> Annex Bool

Remote/Hook.hs

@@ -47,6 +47,7 @@ gen r u c = do
 			hasKeyCheap = False,
 			whereisKey = Nothing,
 			config = Nothing,
+			path = Nothing,
 			repo = r,
 			remotetype = remote
 		}

Remote/List.hs

@@ -2,7 +2,7 @@
 
 {- git-annex remote list
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011,2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -18,6 +18,7 @@ import Types.Remote
 import Annex.UUID
 import Config
 import Remote.Helper.Hooks
+import qualified Git
 
 import qualified Remote.Git
 #ifdef WITH_S3
@@ -55,10 +56,13 @@ remoteList = do
 			return rs'
 		else return rs
 	where
-		process m t = enumerate t >>= mapM (gen m t)
+		process m t = enumerate t >>= mapM (remoteGen m t)
-		gen m t r = do
+
-			u <- getRepoUUID r
+{- Generates a Remote. -}
-			addHooks =<< generate t r u (M.lookup u m)
+remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex Remote
+remoteGen m t r = do
+	u <- getRepoUUID r
+	addHooks =<< generate t r u (M.lookup u m)
 
 {- All remotes that are not ignored. -}
 enabledRemoteList :: Annex [Remote]

Remote/Rsync.hs

@@ -45,21 +45,24 @@ gen r u c = do
 	return $ encryptableRemote c
 		(storeEncrypted o)
 		(retrieveEncrypted o)
-		Remote {
+		Remote
-			uuid = u,
+			{ uuid = u
-			cost = cst,
+			, cost = cst
-			name = Git.repoDescribe r,
+			, name = Git.repoDescribe r
- 			storeKey = store o,
+ 			, storeKey = store o
-			retrieveKeyFile = retrieve o,
+			, retrieveKeyFile = retrieve o
-			retrieveKeyFileCheap = retrieveCheap o,
+			, retrieveKeyFileCheap = retrieveCheap o
-			removeKey = remove o,
+			, removeKey = remove o
-			hasKey = checkPresent r o,
+			, hasKey = checkPresent r o
-			hasKeyCheap = False,
+			, hasKeyCheap = False
-			whereisKey = Nothing,
+			, whereisKey = Nothing
-			config = Nothing,
+			, config = Nothing
-			repo = r,
+			, repo = r
-			remotetype = remote
+			, path = if rsyncUrlIsPath $ rsyncUrl o
-		}
+				then Just $ rsyncUrl o
+				else Nothing
+			, remotetype = remote
+			}
 
 genRsyncOpts :: Git.Repo -> Maybe RemoteConfig -> Annex RsyncOpts
 genRsyncOpts r c = do

Remote/S3.hs

@@ -60,6 +60,7 @@ gen' r u c cst =
 			whereisKey = Nothing,
 			config = c,
 			repo = r,
+			path = Nothing,
 			remotetype = remote
 		}
 

Remote/Web.hs

@@ -47,6 +47,7 @@ gen r _ _ =
 		hasKeyCheap = False,
 		whereisKey = Just getUrls,
 		config = Nothing,
+		path = Nothing,
 		repo = r,
 		remotetype = remote
 	}

Types/Remote.hs

@@ -64,6 +64,8 @@ data RemoteA a = Remote {
 	config :: Maybe RemoteConfig,
 	-- git configuration for the remote
 	repo :: Git.Repo,
+	-- a Remote can be assocated with a specific filesystem path
+	path :: Maybe FilePath,
 	-- the type of the remote
 	remotetype :: RemoteTypeA a
 }

Utility/RsyncFile.hs

@@ -61,3 +61,9 @@ rsyncUrlIsShell s
 			| c == '/' = False -- got to directory with no colon
 			| c == ':' = not $ ":" `isPrefixOf` cs
 			| otherwise = go cs
+
+{- Checks if a rsync url is really just a local path. -}
+rsyncUrlIsPath :: String -> Bool
+rsyncUrlIsPath s
+	| rsyncUrlIsShell s = False
+	| otherwise = ':' `notElem` s