refactor

2 files changed, 27 insertions, 22 deletions

diff --git a/Database/Export.hs b/Database/Export.hs
index 322ab48fd..17755d86b 100644
--- a/Database/Export.hs
+++ b/Database/Export.hs
@@ -26,6 +26,7 @@ module Database.Export (
 	removeExportTree,
 	updateExportTree,
 	updateExportTree',
+	updateExportTreeFromLog,
 	ExportedId,
 	ExportedDirectoryId,
 	ExportTreeId,
@@ -39,6 +40,8 @@ import Annex.Locations
 import Annex.Common hiding (delete)
 import Types.Export
 import Annex.Export
+import qualified Logs.Export as Log
+import Annex.LockFile
 import Git.Types
 import Git.Sha
 import Git.FilePath
@@ -47,7 +50,7 @@ import qualified Git.DiffTree
 import Database.Persist.TH
 import Database.Esqueleto hiding (Key)
 
-newtype ExportHandle = ExportHandle H.DbQueue
+data ExportHandle = ExportHandle H.DbQueue UUID
 
 share [mkPersist sqlSettings, mkMigrate "migrateExport"] [persistLowerCase|
 -- Files that have been exported to the remote and are present on it.
@@ -85,13 +88,13 @@ openDb u = do
 		initDb db $ void $
 			runMigrationSilent migrateExport
 	h <- liftIO $ H.openDbQueue H.SingleWriter db "exported"
-	return $ ExportHandle h
+	return $ ExportHandle h u
 
 closeDb :: ExportHandle -> Annex ()
-closeDb (ExportHandle h) = liftIO $ H.closeDbQueue h
+closeDb (ExportHandle h _) = liftIO $ H.closeDbQueue h
 
 queueDb :: ExportHandle -> SqlPersistM () -> IO ()
-queueDb (ExportHandle h) = H.queueDb h checkcommit
+queueDb (ExportHandle h _) = H.queueDb h checkcommit
   where
 	-- commit queue after 1000 changes
 	checkcommit sz _lastcommittime
@@ -99,7 +102,7 @@ queueDb (ExportHandle h) = H.queueDb h checkcommit
 		| otherwise = return False
 
 flushDbQueue :: ExportHandle -> IO ()
-flushDbQueue (ExportHandle h) = H.flushDbQueue h
+flushDbQueue (ExportHandle h _) = H.flushDbQueue h
 
 recordExportTreeCurrent :: ExportHandle -> Sha -> IO ()
 recordExportTreeCurrent h s = queueDb h $ do
@@ -108,7 +111,7 @@ recordExportTreeCurrent h s = queueDb h $ do
 	void $ insertUnique $ ExportTreeCurrent $ toSRef s
 
 getExportTreeCurrent :: ExportHandle -> IO (Maybe Sha)
-getExportTreeCurrent (ExportHandle h) = H.queryDbQueue h $ do
+getExportTreeCurrent (ExportHandle h _) = H.queryDbQueue h $ do
 	l <- select $ from $ \r -> do
 		where_ (r ^. ExportTreeCurrentTree ==. r ^. ExportTreeCurrentTree)
 		return (r ^. ExportTreeCurrentTree)
@@ -141,7 +144,7 @@ removeExportedLocation h k el = queueDb h $ do
 
 {- Note that this does not see recently queued changes. -}
 getExportedLocation :: ExportHandle -> Key -> IO [ExportLocation]
-getExportedLocation (ExportHandle h) k = H.queryDbQueue h $ do
+getExportedLocation (ExportHandle h _) k = H.queryDbQueue h $ do
 	l <- select $ from $ \r -> do
 		where_ (r ^. ExportedKey ==. val ik)
 		return (r ^. ExportedFile)
@@ -151,7 +154,7 @@ getExportedLocation (ExportHandle h) k = H.queryDbQueue h $ do
 
 {- Note that this does not see recently queued changes. -}
 isExportDirectoryEmpty :: ExportHandle -> ExportDirectory -> IO Bool
-isExportDirectoryEmpty (ExportHandle h) 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)
@@ -161,7 +164,7 @@ isExportDirectoryEmpty (ExportHandle h) d = H.queryDbQueue h $ do
 
 {- Get locations in the export that might contain a key. -}
 getExportTree :: ExportHandle -> Key -> IO [ExportLocation]
-getExportTree (ExportHandle h) k = H.queryDbQueue h $ do
+getExportTree (ExportHandle h _) k = H.queryDbQueue h $ do
 	l <- select $ from $ \r -> do
 		where_ (r ^. ExportTreeKey ==. val ik)
 		return (r ^. ExportTreeFile)
@@ -209,3 +212,16 @@ updateExportTree' h srcek dstek i = do
 		Just k -> liftIO $ addExportTree h (asKey k) loc
   where
 	loc = mkExportLocation $ getTopFilePath $ Git.DiffTree.file i
+			
+updateExportTreeFromLog :: ExportHandle -> Annex ()
+updateExportTreeFromLog db@(ExportHandle _ u) = 
+	withExclusiveLock (gitAnnexExportLock u) $ do
+		old <- liftIO $ fromMaybe emptyTree
+			<$> getExportTreeCurrent db
+		l <- Log.getExport u
+		case map Log.exportedTreeish l of
+			(new:[]) | new /= old -> do
+				updateExportTree db old new
+				liftIO $ recordExportTreeCurrent db new
+				liftIO $ flushDbQueue db
+			_ -> return ()
diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs
index f5c3585c5..8fe4dc524 100644
--- a/Remote/Helper/Export.hs
+++ b/Remote/Helper/Export.hs
@@ -16,10 +16,7 @@ import Types.Key
 import Backend
 import Remote.Helper.Encryptable (isEncrypted)
 import Database.Export
-import Logs.Export
 import Annex.Export
-import Annex.LockFile
-import Git.Sha
 
 import qualified Data.Map as M
 import Control.Concurrent.STM
@@ -103,16 +100,8 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
 		-- updates the database, to notice when an export has been
 		-- updated from another repository.
 		let getexportlocs = \k -> do
-			whenM updateonce $ withExclusiveLock (gitAnnexExportLock (uuid r)) $ do
-				old <- liftIO $ fromMaybe emptyTree
-					<$> getExportTreeCurrent db
-				l <- getExport (uuid r)
-				case map exportedTreeish l of
-					(new:[]) | new /= old -> do
-						updateExportTree db old new
-						liftIO $ recordExportTreeCurrent db new
-						liftIO $ flushDbQueue db
-					_ -> return ()
+			whenM updateonce $
+				updateExportTreeFromLog db
 			liftIO $ getExportTree db k
 
 		return $ r