avoid a second traversal of the ImportableContents

Do all filtering in one pass.

Annex/Import.hs

@@ -14,9 +14,8 @@ module Annex.Import (
 	buildImportTrees,
 	canImportKeys,
 	importKeys,
-	filterImportableContents,
 	makeImportMatcher,
-	listImportableContents,
+	getImportableContents,
 ) where
 
 import Annex.Common
@@ -58,7 +57,7 @@ import Backend.Utilities
 import Control.Concurrent.STM
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
-import qualified System.FilePath.Posix as Posix
+import qualified System.FilePath.Posix.ByteString as Posix
 import qualified System.FilePath.ByteString as P
 
 {- Configures how to build an import tree. -}
@@ -617,16 +616,31 @@ makeImportMatcher r = load preferredContentKeylessTokens >>= \case
   where
 	load t = M.lookup (Remote.uuid r) . fst <$> preferredRequiredMapsLoad' t
 
-wantImport :: FileMatcher Annex -> ImportLocation -> ByteSize -> Annex Bool
+{- Gets the ImportableContents from the remote.
-wantImport matcher loc sz = checkMatcher' matcher mi mempty
+ -
+ - Filters out any paths that include a ".git" component, because git does
+ - not allow storing ".git" in a git repository. While it is possible to
+ - write a git tree that contains that, git will complain and refuse to
+ - check it out.
+ -
+ - Filters out things not matching the FileMatcher.
+ -}
+getImportableContents :: Remote -> FileMatcher Annex -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
+getImportableContents r matcher = 
+	Remote.listImportableContents (Remote.importActions r) >>= \case
+		Nothing -> return Nothing
+		Just importable -> do
+			dbhandle <- Export.openDb (Remote.uuid r)
+			Just <$> filterunwanted dbhandle importable
   where
-	mi = MatchingInfo $ ProvidedInfo
+	filterunwanted dbhandle ic = ImportableContents
-		{ providedFilePath = fromImportLocation loc
+		<$> filterM (wanted dbhandle) (importableContents ic)
-		, providedKey = Nothing
+		<*> mapM (filterunwanted dbhandle) (importableHistory ic)
-		, providedFileSize = sz
+	
-		, providedMimeType = Nothing
+	wanted dbhandle (loc, (_cid, sz))
-		, providedMimeEncoding = Nothing
+		| ".git" `elem` Posix.splitDirectories (fromImportLocation loc) =
-		}
+			pure False
+		| otherwise = shouldImport dbhandle matcher loc sz
 
 {- If a file is not preferred content, but it was previously exported or
  - imported to the remote, not importing it would result in a remote
@@ -641,34 +655,13 @@ shouldImport dbhandle matcher loc sz =
 		<||>
 	liftIO (not . null <$> Export.getExportTreeKey dbhandle loc)
 
-filterImportableContents :: Remote -> FileMatcher Annex -> ImportableContents (ContentIdentifier, ByteSize) -> Annex (ImportableContents (ContentIdentifier, ByteSize))
+wantImport :: FileMatcher Annex -> ImportLocation -> ByteSize -> Annex Bool
-filterImportableContents r matcher importable
+wantImport matcher loc sz = checkMatcher' matcher mi mempty
-	| Utility.Matcher.isEmpty matcher = return importable
-	| otherwise = do
-		dbhandle <- Export.openDb (Remote.uuid r)
-		go dbhandle importable
   where
-	go dbhandle ic = ImportableContents
+	mi = MatchingInfo $ ProvidedInfo
-		<$> filterM (match dbhandle) (importableContents ic)
+		{ providedFilePath = fromImportLocation loc
-		<*> mapM (go dbhandle) (importableHistory ic)
+		, providedKey = Nothing
-	
+		, providedFileSize = sz
-	match dbhandle (loc, (_cid, sz)) = shouldImport dbhandle matcher loc sz
+		, providedMimeType = Nothing
-	
+		, providedMimeEncoding = Nothing
-{- Gets the ImportableContents from the remote.
- -
- - Filters out any paths that include a ".git" component, because git does
- - not allow storing ".git" in a git repository. While it is possible to
- - write a git tree that contains that, git will complain and refuse to
- - check it out.
- -}
-listImportableContents :: Remote -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
-listImportableContents r = fmap removegitspecial
-	<$> Remote.listImportableContents (Remote.importActions r)
-  where
-	removegitspecial ic = ImportableContents
-		{ importableContents = 
-			filter (not . gitspecial . fst) (importableContents ic)
-		, importableHistory =
-			map removegitspecial (importableHistory ic)
 		}
-	gitspecial l = ".git" `elem` Posix.splitDirectories (fromRawFilePath (fromImportLocation l))

Command/Import.hs

@@ -307,15 +307,18 @@ seekRemote remote branch msubdir importcontent = do
 
 listContents :: Remote -> TVar (Maybe (ImportableContents (ContentIdentifier, Remote.ByteSize))) -> CommandStart
 listContents remote tvar = starting "list" ai si $
-	listImportableContents remote >>= \case
+	makeImportMatcher remote >>= \case
-		Nothing -> giveup $ "Unable to list contents of " ++ Remote.name remote
+		Right matcher -> getImportableContents remote matcher >>= \case
-		Just importable -> do
+			Just importable -> next $ do
-			importable' <- makeImportMatcher remote >>= \case
+				liftIO $ atomically $ writeTVar tvar (Just importable)
-				Right matcher -> filterImportableContents remote matcher importable
-				Left err -> giveup $ "Cannot import from " ++ Remote.name remote ++ " because of a problem with its configuration: " ++ err
-			next $ do
-				liftIO $ atomically $ writeTVar tvar (Just importable')
 				return True
+			Nothing -> giveup $ "Unable to list contents of " ++ Remote.name remote
+		Left err -> giveup $ unwords 
+			[ "Cannot import from"
+			, Remote.name remote
+			, "because of a problem with its configuration:"
+			, err
+			]
   where
 	ai = ActionItemOther (Just (Remote.name remote))
 	si = SeekInput []