WIP

Added graftTree but it's buggy.

Should use graftTree in Annex.Branch.graftTreeish; it will be faster
than the current implementation there.

Started Annex.Import, but untested and it doesn't yet handle tree
grafting.

Annex/Branch.hs

@@ -51,6 +51,7 @@ import qualified Git.Branch
 import qualified Git.UnionMerge
 import qualified Git.UpdateIndex
 import qualified Git.Tree
+import qualified Git.LsTree
 import Git.LsTree (lsTreeParams)
 import qualified Git.HashObject
 import Annex.HashObject
@@ -366,7 +367,7 @@ branchFiles = withIndex $ inRepo branchFiles'
 
 branchFiles' :: Git.Repo -> IO [FilePath]
 branchFiles' = Git.Command.pipeNullSplitZombie
-	(lsTreeParams fullname [Param "--name-only"])
+	(lsTreeParams Git.LsTree.LsTreeRecursive fullname [Param "--name-only"])
 
 {- Populates the branch's index file with the current branch contents.
  - 
@@ -649,7 +650,8 @@ graftTreeish :: Git.Ref -> TopFilePath -> Annex ()
 graftTreeish treeish graftpoint = lockJournal $ \jl -> do
 	branchref <- getBranch
 	updateIndex jl branchref
-	Git.Tree.Tree t <- inRepo $ Git.Tree.getTree branchref
+	Git.Tree.Tree t <- inRepo $
+		Git.Tree.getTree Git.LsTree.LsTreeRecursive branchref
 	t' <- inRepo $ Git.Tree.recordTree $ Git.Tree.Tree $
 		Git.Tree.RecordedSubTree graftpoint treeish [] : t
 	c <- inRepo $ Git.Branch.commitTree Git.Branch.AutomaticCommit

Annex/Import.hs

@@ -0,0 +1,71 @@
+{- git-annex import from remotes
+ -
+ - Copyright 2019 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Annex.Import (buildImportCommit) where
+
+import Annex.Common
+import Types.Import
+import Git.Types
+import Git.Tree
+import Git.Branch
+import Git.FilePath
+import Annex.Link
+
+{- Builds a commit on top of a basecommit that reflects changes to the
+ - content of a remote. When there are no changes to commit, returns Nothing.
+ -
+ - When a remote provided a history of versions of files,
+ - builds a corresponding tree of git commits.
+ -
+ - After importing from a remote, exporting the same thing back to the
+ - remote should be a no-op. So, the export log is updated to reflect the
+ - imported tree.
+ -
+ - The files are imported to the top of the git repository, unless a
+ - subdir is specified, then the import will only affect the contents of
+ - the subdir.
+ -
+ - This does not import any content from a remote. But since it needs the
+ - Key of imported files to be known, its caller will have to download
+ - new files in order to generate keys for them.
+ -}
+buildImportCommit
+	:: Ref
+	-> Maybe FilePath
+	-> ImportableContents Key
+	-> CommitMode
+	-> String
+	-> Annex (Maybe Ref)
+buildImportCommit basecommit subdir importable commitmode commitmessage = do
+	go =<< buildImportTrees basetree importable
+  where
+	go (History importedtree hs) = do
+		parents <- mapM go hs
+		
+		inRepo $ commitTree commitmode commitmessage parents tree
+
+data History t = History t [History t]
+
+{- Builds a history of git trees reflecting the ImportableContents. -}
+buildImportTrees
+	:: Maybe FilePath
+	-> ImportableContents Key
+	-> Annex (History Sha)
+buildImportTrees subdir i = History
+	<$> go (importableContents i)
+	<*> mapM (buildImportTrees subdir basetree) (importableHistory i)
+  where
+	go ls = do
+		is <- mapM mktreeitem ls
+		inRepo $ recordTree (treeItemsToTree is)
+	mktreeitem (loc, k) = do
+		let lf = fromImportLocation loc
+		let topf = asTopFilePath $ maybe lf (</> lf) subdir
+		relf <- fromRepo $ fromTopFilePath topf
+		symlink <- calcRepo $ gitAnnexLink relf k
+		linksha <- hashSymlink symlink
+		return $ TreeItem topf (fromTreeItemType TreeSymlink) linksha

Annex/WorkTree.hs

@@ -83,7 +83,7 @@ scanUnlockedFiles = whenM (isJust <$> inRepo Git.Branch.current) $ do
 	showSideAction "scanning for unlocked files"
 	Database.Keys.runWriter $
 		liftIO . Database.Keys.SQL.dropAllAssociatedFiles
-	(l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.Ref.headRef
+	(l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.LsTree.LsTreeRecursive Git.Ref.headRef
 	forM_ l $ \i -> 
 		when (isregfile i) $
 			maybe noop (add i)