prevent exporttree=yes on remotes that don't support exports

Don't allow "exporttree=yes" to be set when the special remote
does not support exports. That would be confusing since the user would
set up a special remote for exports, but `git annex export` to it would
later fail.

This commit was supported by the NSF-funded DataLad project.

1 files changed, 16 insertions, 11 deletions

diff --git a/Types/Remote.hs b/Types/Remote.hs
index 6f0a312f4..e2f36a55b 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -19,6 +19,7 @@ module Types.Remote
 	, Verification(..)
 	, unVerified
 	, ExportLocation(..)
+	, isExportSupported
 	, ExportActions(..)
 	)
 	where
@@ -36,7 +37,7 @@ import Types.UrlContents
 import Types.NumCopies
 import Config.Cost
 import Utility.Metered
-import Git.Types
+import Git.Types (RemoteName)
 import Utility.SafeCommand
 import Utility.Url
 
@@ -47,17 +48,19 @@ type RemoteConfig = M.Map RemoteConfigKey String
 data SetupStage = Init | Enable RemoteConfig
 
 {- There are different types of remotes. -}
-data RemoteTypeA a = RemoteType {
+data RemoteTypeA a = RemoteType
 	-- human visible type name
-	typename :: String,
+	{ typename :: String
 	-- enumerates remotes of this type
 	-- The Bool is True if automatic initialization of remotes is desired
-	enumerate :: Bool -> a [Git.Repo],
-	-- generates a remote of this type
-	generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (Maybe (RemoteA a)),
+	, enumerate :: Bool -> a [Git.Repo]
+	-- generates a remote of this type from the current git config
+	, generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (Maybe (RemoteA a))
 	-- initializes or enables a remote
-	setup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> a (RemoteConfig, UUID)
-}
+	, setup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> a (RemoteConfig, UUID)
+	-- check if a remote of this type is able to support export
+	, exportSupported :: RemoteConfig -> RemoteGitConfig -> a Bool
+	}
 
 instance Eq (RemoteTypeA a) where
 	x == y = typename x == typename y
@@ -161,12 +164,14 @@ unVerified a = do
 newtype ExportLocation = ExportLocation FilePath
 	deriving (Show, Eq)
 
-data ExportActions a = ExportActions
-	{ exportSupported :: a Bool
+isExportSupported :: RemoteA a -> a Bool
+isExportSupported r = exportSupported (remotetype r) (config r) (gitconfig r)
+
+data ExportActions a = ExportActions 
 	-- Exports content to an ExportLocation.
 	-- The exported file should not appear to be present on the remote
 	-- until all of its contents have been transferred.
-	, storeExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> a Bool
+	{ storeExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> a Bool
 	-- Retrieves exported content to a file.
 	-- (The MeterUpdate does not need to be used if it writes
 	-- sequentially to the file.)