convert listImportableContents to throwing exceptions

Annex/Import.hs

@@ -658,14 +658,14 @@ makeImportMatcher r = load preferredContentKeylessTokens >>= \case
  - regardless. (Similar to how git add behaves on gitignored files.)
  - This avoids creating a remote tracking branch that, when merged,
  - would delete the files.
+ -
+ - Throws exception if unable to contact the remote.
  -}
-getImportableContents :: Remote -> ImportTreeConfig -> CheckGitIgnore -> FileMatcher Annex -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
-getImportableContents r importtreeconfig ci matcher = 
-	Remote.listImportableContents (Remote.importActions r) >>= \case
-		Nothing -> return Nothing
-		Just importable -> do
+getImportableContents :: Remote -> ImportTreeConfig -> CheckGitIgnore -> FileMatcher Annex -> Annex (ImportableContents (ContentIdentifier, ByteSize))
+getImportableContents r importtreeconfig ci matcher = do
+	importable <- Remote.listImportableContents (Remote.importActions r)
 	dbhandle <- Export.openDb (Remote.uuid r)
-			Just <$> filterunwanted dbhandle importable
+	filterunwanted dbhandle importable
   where
 	filterunwanted dbhandle ic = ImportableContents
 		<$> filterM (wanted dbhandle) (importableContents ic)

Command/Import.hs

@@ -334,9 +334,9 @@ listContents remote importtreeconfig ci tvar = starting "list" ai si $
 listContents' :: Remote -> ImportTreeConfig -> CheckGitIgnore -> (ImportableContents (ContentIdentifier, Remote.ByteSize) -> Annex a) -> Annex a
 listContents' remote importtreeconfig ci a = 
 	makeImportMatcher remote >>= \case
-		Right matcher -> getImportableContents remote importtreeconfig ci matcher >>= \case
-			Just importable -> a importable
-			Nothing -> giveup $ "Unable to list contents of " ++ Remote.name remote
+		Right matcher -> tryNonAsync (getImportableContents remote importtreeconfig ci matcher) >>= \case
+			Right importable -> a importable
+			Left e -> giveup $ "Unable to list contents of " ++ Remote.name remote ++ ": " ++ show e
 		Left err -> giveup $ unwords 
 			[ "Cannot import from"
 			, Remote.name remote

Remote/Adb.hs

@@ -286,9 +286,12 @@ renameExportM serial adir _k old new = do
 		, File newloc
 		]
 
-listImportableContentsM :: AndroidSerial -> AndroidPath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
-listImportableContentsM serial adir =
-	process <$> adbShell serial
+listImportableContentsM :: AndroidSerial -> AndroidPath -> Annex (ImportableContents (ContentIdentifier, ByteSize))
+listImportableContentsM serial adir = adbfind >>= \case
+	Just ls -> return $ ImportableContents (mapMaybe mk ls) []
+	Nothing -> giveup "adb find failed"
+  where
+	adbfind = adbShell serial
 		[ Param "find"
 		-- trailing slash is needed, or android's find command
 		-- won't recurse into the directory
@@ -298,9 +301,6 @@ listImportableContentsM serial adir =
 		, Param "-c", Param statformat
 		, Param "{}", Param "+"
 		]
-  where
-	process Nothing = Nothing
-	process (Just ls) = Just $ ImportableContents (mapMaybe mk ls) []
 
 	statformat = adbStatFormat ++ "\t%n"
 

Remote/Borg.hs

@@ -132,7 +132,7 @@ borgLocal = notElem ':'
 -- XXX the tree generated by using this does not seem to get grafted into
 -- the git-annex branch, so would be subject to being lost to GC.
 -- Is this a general problem affecting importtree too?
-listImportableContentsM :: UUID -> BorgRepo -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
+listImportableContentsM :: UUID -> BorgRepo -> Annex (ImportableContents (ContentIdentifier, ByteSize))
 listImportableContentsM u borgrepo = prompt $ do
 	imported <- getImported u
 	ls <- withborglist borgrepo "{barchive}{NUL}" $ \as ->
@@ -143,7 +143,7 @@ listImportableContentsM u borgrepo = prompt $ do
 					let archive = borgrepo ++ "::" ++ decodeBS' archivename
 					in withborglist archive "{size}{NUL}{path}{NUL}" $
 						liftIO . evaluate . force . parsefilelist archivename
-	return $ Just $ mkimportablecontents ls
+	return $ mkimportablecontents ls
   where
 	withborglist what format a = do
 		let p = (proc "borg" ["list", what, "--format", format])

Remote/Directory.hs

@@ -337,8 +337,8 @@ removeExportLocation topdir loc =
 			mkExportLocation loc'
 		in go (upFrom loc') =<< tryIO (removeDirectory p)
 
-listImportableContentsM :: RawFilePath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
-listImportableContentsM dir = catchMaybeIO $ liftIO $ do
+listImportableContentsM :: RawFilePath -> Annex (ImportableContents (ContentIdentifier, ByteSize))
+listImportableContentsM dir = liftIO $ do
 	l <- dirContentsRecursive (fromRawFilePath dir)
 	l' <- mapM (go . toRawFilePath) l
 	return $ ImportableContents (catMaybes l') []

Remote/Helper/ExportImport.hs

@@ -54,7 +54,7 @@ instance HasImportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex Bo
 
 instance HasImportUnsupported (ImportActions Annex) where
 	importUnsupported = ImportActions
-		{ listImportableContents = return Nothing
+		{ listImportableContents = nope
 		, importKey = Nothing
 		, retrieveExportWithContentIdentifier = nope
 		, storeExportWithContentIdentifier = nope

Remote/S3.hs

@@ -550,13 +550,11 @@ renameExportS3 hv r rs info k src dest = Just <$> go
 	srcobject = T.pack $ bucketExportLocation info src
 	dstobject = T.pack $ bucketExportLocation info dest
 
-listImportableContentsS3 :: S3HandleVar -> Remote -> S3Info -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
+listImportableContentsS3 :: S3HandleVar -> Remote -> S3Info -> Annex (ImportableContents (ContentIdentifier, ByteSize))
 listImportableContentsS3 hv r info =
 	withS3Handle hv $ \case
-		Nothing -> do
-			warning $ needS3Creds (uuid r)
-			return Nothing
-		Just h -> catchMaybeIO $ liftIO $ runResourceT $
+		Nothing -> giveup $ needS3Creds (uuid r)
+		Just h -> liftIO $ runResourceT $
 			extractFromResourceT =<< startlist h
   where
 	startlist h

Types/Remote.hs

@@ -281,7 +281,9 @@ data ImportActions a = ImportActions
 	--
 	-- May also find old versions of files that are still stored in the
 	-- remote.
-	{ listImportableContents :: a (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
+	--
+	-- Throws exception on failure to access the remote.
+	{ listImportableContents :: a (ImportableContents (ContentIdentifier, ByteSize))
 	-- Generates a Key (of any type) for the file stored on the
 	-- remote at the ImportLocation. Does not download the file
 	-- from the remote.