1 files changed, 106 insertions, 21 deletions

diff --git a/Database/Export.hs b/Database/Export.hs
index df3d92300..7dae408fa 100644
--- a/Database/Export.hs
+++ b/Database/Export.hs
@@ -14,13 +14,19 @@ module Database.Export (
 	ExportHandle,
 	openDb,
 	closeDb,
-	addExportLocation,
-	removeExportLocation,
 	flushDbQueue,
-	getExportLocation,
+	recordDataSource,
+	getDataSource,
+	addExportedLocation,
+	removeExportedLocation,
+	getExportedLocation,
 	isExportDirectoryEmpty,
+	getExportTree,
+	updateExportTree,
 	ExportedId,
+	ExportTreeId,
 	ExportedDirectoryId,
+	DataSourceId,
 ) where
 
 import Database.Types
@@ -29,6 +35,11 @@ import Database.Init
 import Annex.Locations
 import Annex.Common hiding (delete)
 import Types.Export
+import Annex.Export
+import Git.Types
+import Git.Sha
+import Git.FilePath
+import qualified Git.DiffTree
 
 import Database.Persist.TH
 import Database.Esqueleto hiding (Key)
@@ -36,14 +47,26 @@ import Database.Esqueleto hiding (Key)
 newtype ExportHandle = ExportHandle H.DbQueue
 
 share [mkPersist sqlSettings, mkMigrate "migrateExport"] [persistLowerCase|
+-- Files that have been exported to the remote.
 Exported
   key IKey
   file SFilePath
-  KeyFileIndex key file
+  ExportedIndex key file
+-- The tree that has been exported to the remote. 
+-- Not all of these files are necessarily present on the remote yet.
+ExportTree
+  key IKey
+  file SFilePath
+  ExportTreeIndex key file
+-- Directories that exist on the remote, and the files that are in them.
 ExportedDirectory
   subdir SFilePath
   file SFilePath
-  SubdirFileIndex subdir file
+  ExportedDirectoryIndex subdir file
+-- Record of what tree the current database content comes from.
+DataSource
+  tree SRef
+  UniqueTree tree
 |]
 
 {- Opens the database, creating it if it doesn't exist yet. -}
@@ -68,48 +91,110 @@ queueDb (ExportHandle h) = H.queueDb h checkcommit
 		| sz > 1000 = return True
 		| otherwise = return False
 
-addExportLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
-addExportLocation h k el@(ExportLocation f) = queueDb h $ do
+flushDbQueue :: ExportHandle -> IO ()
+flushDbQueue (ExportHandle h) = H.flushDbQueue h
+
+recordDataSource :: ExportHandle -> Sha -> IO ()
+recordDataSource h s = queueDb h $ do
+	delete $ from $ \r -> do
+		where_ (r ^. DataSourceTree ==. r ^. DataSourceTree)
+	void $ insertUnique $ DataSource (toSRef s)
+
+getDataSource :: ExportHandle -> IO (Maybe Sha)
+getDataSource (ExportHandle h) = H.queryDbQueue h $ do
+	l <- select $ from $ \r -> do
+		where_ (r ^. DataSourceTree ==. r ^. DataSourceTree)
+		return (r ^. DataSourceTree)
+	case l of
+		(s:[]) -> return (Just (fromSRef (unValue s)))
+		_ -> return Nothing
+
+addExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
+addExportedLocation h k el = queueDb h $ do
 	void $ insertUnique $ Exported ik ef
 	insertMany_ $ map
-		(\(ExportDirectory d) -> ExportedDirectory (toSFilePath d) ef)
+		(\ed -> ExportedDirectory (toSFilePath (fromExportDirectory ed)) ef)
 		(exportDirectories el)
   where
 	ik = toIKey k
-	ef = toSFilePath f
+	ef = toSFilePath (fromExportLocation el)
 
-removeExportLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
-removeExportLocation h k el@(ExportLocation f) = queueDb h $ do
+removeExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
+removeExportedLocation h k el = queueDb h $ do
 	delete $ from $ \r -> do
 		where_ (r ^. ExportedKey ==. val ik &&. r ^. ExportedFile ==. val ef)
-	let subdirs = map (\(ExportDirectory d) -> toSFilePath d)
+	let subdirs = map (toSFilePath . fromExportDirectory)
 		(exportDirectories el)
 	delete $ from $ \r -> do
 		where_ (r ^. ExportedDirectoryFile ==. val ef
 			&&. r ^. ExportedDirectorySubdir `in_` valList subdirs)
   where
 	ik = toIKey k
-	ef = toSFilePath f
-
-flushDbQueue :: ExportHandle -> IO ()
-flushDbQueue (ExportHandle h) = H.flushDbQueue h
+	ef = toSFilePath (fromExportLocation el)
 
 {- Note that this does not see recently queued changes. -}
-getExportLocation :: ExportHandle -> Key -> IO [ExportLocation]
-getExportLocation (ExportHandle h) k = H.queryDbQueue h $ do
+getExportedLocation :: ExportHandle -> Key -> IO [ExportLocation]
+getExportedLocation (ExportHandle h) k = H.queryDbQueue h $ do
 	l <- select $ from $ \r -> do
 		where_ (r ^. ExportedKey ==. val ik)
 		return (r ^. ExportedFile)
-	return $ map (ExportLocation . fromSFilePath . unValue) l
+	return $ map (mkExportLocation . fromSFilePath . unValue) l
   where
 	ik = toIKey k
 
 {- Note that this does not see recently queued changes. -}
 isExportDirectoryEmpty :: ExportHandle -> ExportDirectory -> IO Bool
-isExportDirectoryEmpty (ExportHandle h) (ExportDirectory d) = H.queryDbQueue h $ do
+isExportDirectoryEmpty (ExportHandle h) d = H.queryDbQueue h $ do
 	l <- select $ from $ \r -> do
 		where_ (r ^. ExportedDirectorySubdir ==. val ed)
 		return (r ^. ExportedDirectoryFile)
 	return $ null l
   where
-	ed = toSFilePath d
+	ed = toSFilePath $ fromExportDirectory d
+
+{- Get locations in the export that might contain a key. -}
+getExportTree :: ExportHandle -> Key -> IO [ExportLocation]
+getExportTree (ExportHandle h) k = H.queryDbQueue h $ do
+	l <- select $ from $ \r -> do
+		where_ (r ^. ExportTreeKey ==. val ik)
+		return (r ^. ExportTreeFile)
+	return $ map (mkExportLocation . fromSFilePath . unValue) l
+  where
+	ik = toIKey k
+
+addExportTree :: ExportHandle -> Key -> ExportLocation -> IO ()
+addExportTree h k loc = queueDb h $
+	void $ insertUnique $ Exported ik ef
+  where
+	ik = toIKey k
+	ef = toSFilePath (fromExportLocation loc)
+
+removeExportTree :: ExportHandle -> Key -> ExportLocation -> IO ()
+removeExportTree h k loc = queueDb h $ 
+	delete $ from $ \r ->
+		where_ (r ^. ExportTreeKey ==. val ik &&. r ^. ExportTreeFile ==. val ef)
+  where
+	ik = toIKey k
+	ef = toSFilePath (fromExportLocation loc)
+
+{- Diff from the old to the new tree and update the ExportTree table. -}
+updateExportTree :: ExportHandle -> Sha -> Sha -> Annex ()
+updateExportTree h old new = do
+	(diff, cleanup) <- inRepo $
+		Git.DiffTree.diffTreeRecursive old new
+	forM_ diff $ \i -> do
+		let loc = mkExportLocation $ getTopFilePath $
+			Git.DiffTree.file i
+		srcek <- getek (Git.DiffTree.srcsha i)
+		case srcek of
+			Nothing -> return ()
+			Just k -> liftIO $ removeExportTree h (asKey k) loc
+		dstek <- getek (Git.DiffTree.dstsha i)
+		case dstek of
+			Nothing -> return ()
+			Just k -> liftIO $ addExportTree h (asKey k) loc
+	void $ liftIO cleanup
+  where
+	getek sha
+		| sha == nullSha = return Nothing
+		| otherwise = Just <$> exportKey sha